(original) (raw)

{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-}

module Data.List.NonEmpty (

 [NonEmpty](GHC.Base.html#NonEmpty)(..)

, map
, intersperse , scanl
, scanr
, scanl1
, scanr1
, transpose
, sortBy
, sortWith

, length
, head
, tail
, last
, init
, (<|), cons
, uncons
, unfoldr
, sort
, reverse
, inits
, tails

, iterate
, repeat
, cycle
, unfold
, insert
, some1

, take
, drop
, splitAt
, takeWhile
, dropWhile
, span
, break
, filter
, partition
, group
, groupBy
, groupWith
, groupAllWith
, group1
, groupBy1
, groupWith1
, groupAllWith1

, isPrefixOf

, nub
, nubBy

, (!!)

, zip
, zipWith
, unzip

, fromList
, toList
, nonEmpty
, xor
) where

import Prelude hiding (break, cycle, drop, dropWhile, filter, foldl, foldr, head, init, iterate, last, length, map, repeat, reverse, scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile, unzip, zip, zipWith, (!!)) import qualified Prelude

import Control.Applicative (Applicative (..), Alternative (many)) import Data.Foldable hiding (length, toList) import qualified Data.Foldable as Foldable import Data.Function (on) import qualified Data.List as List import Data.Ord (comparing) import GHC.Base (NonEmpty(..))

infixr 5 <|

length :: NonEmpty a -> Int length (_ :| xs) = 1 + Prelude.length xs

xor :: NonEmpty Bool -> Bool xor (x :| xs) = foldr xor' x xs where xor' True y = not y xor' False y = y

unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfold f a = case f a of (b, Nothing) -> b :| [] (b, Just c) -> b <| unfold f c {-# DEPRECATED unfold "Use unfoldr" #-}

nonEmpty :: [a] -> Maybe (NonEmpty a) nonEmpty [] = Nothing nonEmpty (a:as) = Just (a :| as)

uncons :: NonEmpty a -> (a, Maybe (NonEmpty a)) uncons ~(a :| as) = (a, nonEmpty as)

unfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfoldr f a = case f a of (b, mc) -> b :| maybe [] go mc where go c = case f c of (d, me) -> d : maybe [] go me

head :: NonEmpty a -> a head ~(a :| _) = a

tail :: NonEmpty a -> [a] tail ~(_ :| as) = as

last :: NonEmpty a -> a last ~(a :| as) = List.last (a : as)

init :: NonEmpty a -> [a] init ~(a :| as) = List.init (a : as)

(<|) :: a -> NonEmpty a -> NonEmpty a a <| ~(b :| bs) = a :| b : bs

cons :: a -> NonEmpty a -> NonEmpty a cons = (<|)

sort :: Ord a => NonEmpty a -> NonEmpty a sort = lift List.sort

fromList :: [a] -> NonEmpty a fromList (a:as) = a :| as fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"

toList :: NonEmpty a -> [a] toList ~(a :| as) = a : as

lift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b lift f = fromList . f . Foldable.toList

map :: (a -> b) -> NonEmpty a -> NonEmpty b map f ~(a :| as) = f a :| fmap f as

inits :: Foldable f => f a -> NonEmpty [a] inits = fromList . List.inits . Foldable.toList

tails :: Foldable f => f a -> NonEmpty [a] tails = fromList . List.tails . Foldable.toList

insert :: (Foldable f, Ord a) => a -> f a -> NonEmpty a insert a = fromList . List.insert a . Foldable.toList

some1 :: Alternative f => f a -> f (NonEmpty a) some1 x = liftA2 (:|) x (many x)

scanl :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b scanl f z = fromList . List.scanl f z . Foldable.toList

scanr :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b scanr f z = fromList . List.scanr f z . Foldable.toList

scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanl1 f ~(a :| as) = fromList (List.scanl f a as)

scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as))

intersperse :: a -> NonEmpty a -> NonEmpty a intersperse a ~(b :| bs) = b :| case bs of [] -> [] _ -> a : List.intersperse a bs

iterate :: (a -> a) -> a -> NonEmpty a iterate f a = a :| List.iterate f (f a)

cycle :: NonEmpty a -> NonEmpty a cycle = fromList . List.cycle . toList

reverse :: NonEmpty a -> NonEmpty a reverse = lift List.reverse

repeat :: a -> NonEmpty a repeat a = a :| List.repeat a

take :: Int -> NonEmpty a -> [a] take n = List.take n . toList

drop :: Int -> NonEmpty a -> [a] drop n = List.drop n . toList

splitAt :: Int -> NonEmpty a -> ([a],[a]) splitAt n = List.splitAt n . toList

takeWhile :: (a -> Bool) -> NonEmpty a -> [a] takeWhile p = List.takeWhile p . toList

dropWhile :: (a -> Bool) -> NonEmpty a -> [a] dropWhile p = List.dropWhile p . toList

span :: (a -> Bool) -> NonEmpty a -> ([a], [a]) span p = List.span p . toList

break :: (a -> Bool) -> NonEmpty a -> ([a], [a]) break p = span (not . p)

filter :: (a -> Bool) -> NonEmpty a -> [a] filter p = List.filter p . toList

partition :: (a -> Bool) -> NonEmpty a -> ([a], [a]) partition p = List.partition p . toList

group :: (Foldable f, Eq a) => f a -> [NonEmpty a] group = groupBy (==)

groupBy :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a] groupBy eq0 = go eq0 . Foldable.toList where go _ [] = [] go eq (x : xs) = (x :| ys) : groupBy eq zs where (ys, zs) = List.span (eq x) xs

groupWith :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a] groupWith f = groupBy ((==) [on](Data.Function.html#on) f)

groupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] groupAllWith f = groupWith f . List.sortBy (compare [on](Data.Function.html#on) f)

group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a) group1 = groupBy1 (==)

groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a) groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs where (ys, zs) = List.span (eq x) xs

groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupWith1 f = groupBy1 ((==) [on](Data.Function.html#on) f)

groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupAllWith1 f = groupWith1 f . sortWith f

isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool isPrefixOf [] _ = True isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs

(!!) :: NonEmpty a -> Int -> a (!!) ~(x :| xs) n | n == 0 = x | n > 0 = xs List.!! (n - 1) | otherwise = errorWithoutStackTrace "NonEmpty.!! negative argument" infixl 9 !!

zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b) zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys

zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys

unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs)

nub :: Eq a => NonEmpty a -> NonEmpty a nub = nubBy (==)

nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| List.nubBy eq (List.filter ([b](#local-6989586621679418071) -> not (eq a b)) as)

transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a) transpose = fmap fromList . fromList . List.transpose . toList . fmap toList

sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a sortBy f = lift (List.sortBy f)

sortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a sortWith = sortBy . comparing