{-|
Definitions of strict linked list.

Most basic operations like `fmap`, `filter`, `<*>`
can only be implemented efficiently by producing an intermediate list in reversed order
and then reversing it to the original order.
These intermediate reversed functions are exposed by the API,
because they very well may be useful for efficient implementations of data-structures built on top of list.
E.g., the <http://hackage.haskell.org/package/deque "deque"> package exploits them heavily.

One useful rule of thumb would be that
whenever you see that a function has a reversed counterpart,
that counterpart is faster and hence if you don't care about the order or
intend to reverse the list further down the line, you should give preference to that counterpart.

The typical `toList` and `fromList` conversions are provided by means of
the `Foldable` and `IsList` instances.
-}
module StrictList where

import StrictList.Prelude hiding (take, drop, takeWhile, dropWhile, reverse)

{-|
Strict linked list.
-}
data List a = Cons !a !(List a) | Nil deriving
  (List a -> List a -> Bool
(List a -> List a -> Bool)
-> (List a -> List a -> Bool) -> Eq (List a)
forall a. Eq a => List a -> List a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List a -> List a -> Bool
$c/= :: forall a. Eq a => List a -> List a -> Bool
== :: List a -> List a -> Bool
$c== :: forall a. Eq a => List a -> List a -> Bool
Eq, Eq (List a)
Eq (List a)
-> (List a -> List a -> Ordering)
-> (List a -> List a -> Bool)
-> (List a -> List a -> Bool)
-> (List a -> List a -> Bool)
-> (List a -> List a -> Bool)
-> (List a -> List a -> List a)
-> (List a -> List a -> List a)
-> Ord (List a)
List a -> List a -> Bool
List a -> List a -> Ordering
List a -> List a -> List a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (List a)
forall a. Ord a => List a -> List a -> Bool
forall a. Ord a => List a -> List a -> Ordering
forall a. Ord a => List a -> List a -> List a
min :: List a -> List a -> List a
$cmin :: forall a. Ord a => List a -> List a -> List a
max :: List a -> List a -> List a
$cmax :: forall a. Ord a => List a -> List a -> List a
>= :: List a -> List a -> Bool
$c>= :: forall a. Ord a => List a -> List a -> Bool
> :: List a -> List a -> Bool
$c> :: forall a. Ord a => List a -> List a -> Bool
<= :: List a -> List a -> Bool
$c<= :: forall a. Ord a => List a -> List a -> Bool
< :: List a -> List a -> Bool
$c< :: forall a. Ord a => List a -> List a -> Bool
compare :: List a -> List a -> Ordering
$ccompare :: forall a. Ord a => List a -> List a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (List a)
Ord, Int -> List a -> ShowS
[List a] -> ShowS
List a -> String
(Int -> List a -> ShowS)
-> (List a -> String) -> ([List a] -> ShowS) -> Show (List a)
forall a. Show a => Int -> List a -> ShowS
forall a. Show a => [List a] -> ShowS
forall a. Show a => List a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List a] -> ShowS
$cshowList :: forall a. Show a => [List a] -> ShowS
show :: List a -> String
$cshow :: forall a. Show a => List a -> String
showsPrec :: Int -> List a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List a -> ShowS
Show, ReadPrec [List a]
ReadPrec (List a)
Int -> ReadS (List a)
ReadS [List a]
(Int -> ReadS (List a))
-> ReadS [List a]
-> ReadPrec (List a)
-> ReadPrec [List a]
-> Read (List a)
forall a. Read a => ReadPrec [List a]
forall a. Read a => ReadPrec (List a)
forall a. Read a => Int -> ReadS (List a)
forall a. Read a => ReadS [List a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [List a]
$creadListPrec :: forall a. Read a => ReadPrec [List a]
readPrec :: ReadPrec (List a)
$creadPrec :: forall a. Read a => ReadPrec (List a)
readList :: ReadS [List a]
$creadList :: forall a. Read a => ReadS [List a]
readsPrec :: Int -> ReadS (List a)
$creadsPrec :: forall a. Read a => Int -> ReadS (List a)
Read, (forall x. List a -> Rep (List a) x)
-> (forall x. Rep (List a) x -> List a) -> Generic (List a)
forall x. Rep (List a) x -> List a
forall x. List a -> Rep (List a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (List a) x -> List a
forall a x. List a -> Rep (List a) x
$cto :: forall a x. Rep (List a) x -> List a
$cfrom :: forall a x. List a -> Rep (List a) x
Generic, (forall a. List a -> Rep1 List a)
-> (forall a. Rep1 List a -> List a) -> Generic1 List
forall a. Rep1 List a -> List a
forall a. List a -> Rep1 List a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 List a -> List a
$cfrom1 :: forall a. List a -> Rep1 List a
Generic1, Typeable (List a)
DataType
Constr
Typeable (List a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> List a -> c (List a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (List a))
-> (List a -> Constr)
-> (List a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (List a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (List a)))
-> ((forall b. Data b => b -> b) -> List a -> List a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> List a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> List a -> r)
-> (forall u. (forall d. Data d => d -> u) -> List a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> List a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> List a -> m (List a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> List a -> m (List a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> List a -> m (List a))
-> Data (List a)
List a -> DataType
List a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (List a))
(forall b. Data b => b -> b) -> List a -> List a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List a -> c (List a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (List a)
forall a. Data a => Typeable (List a)
forall a. Data a => List a -> DataType
forall a. Data a => List a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> List a -> List a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> List a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> List a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (List a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List a -> c (List a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (List a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (List a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> List a -> u
forall u. (forall d. Data d => d -> u) -> List a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (List a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List a -> c (List a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (List a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (List a))
$cNil :: Constr
$cCons :: Constr
$tList :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> List a -> m (List a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
gmapMp :: (forall d. Data d => d -> m d) -> List a -> m (List a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
gmapM :: (forall d. Data d => d -> m d) -> List a -> m (List a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> List a -> m (List a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> List a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> List a -> u
gmapQ :: (forall d. Data d => d -> u) -> List a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> List a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List a -> r
gmapT :: (forall b. Data b => b -> b) -> List a -> List a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> List a -> List a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (List a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (List a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (List a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (List a))
dataTypeOf :: List a -> DataType
$cdataTypeOf :: forall a. Data a => List a -> DataType
toConstr :: List a -> Constr
$ctoConstr :: forall a. Data a => List a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (List a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (List a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List a -> c (List a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List a -> c (List a)
$cp1Data :: forall a. Data a => Typeable (List a)
Data, Typeable)

instance IsList (List a) where
  type Item (List a) = a
  fromList :: [Item (List a)] -> List a
fromList = List a -> List a
forall a. List a -> List a
reverse (List a -> List a) -> ([a] -> List a) -> [a] -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> List a
forall a. [a] -> List a
fromListReversed
  toList :: List a -> [Item (List a)]
toList = (a -> [a] -> [a]) -> [a] -> List a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []

instance Semigroup (List a) where
  <> :: List a -> List a -> List a
(<>) List a
a List a
b = case List a
b of
    List a
Nil -> List a
a
    List a
_ -> List a -> List a -> List a
forall a. List a -> List a -> List a
prependReversed (List a -> List a
forall a. List a -> List a
reverse List a
a) List a
b

instance Monoid (List a) where
  mempty :: List a
mempty = List a
forall a. List a
Nil
  mappend :: List a -> List a -> List a
mappend = List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
(<>)

instance Functor List where
  fmap :: (a -> b) -> List a -> List b
fmap a -> b
f = List b -> List b
forall a. List a -> List a
reverse (List b -> List b) -> (List a -> List b) -> List a -> List b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
mapReversed a -> b
f

instance Foldable List where
  foldr :: (a -> b -> b) -> b -> List a -> b
foldr a -> b -> b
step b
init = let
    loop :: List a -> b
loop = \ case
      Cons a
head List a
tail -> a -> b -> b
step a
head (List a -> b
loop List a
tail)
      List a
_ -> b
init
    in List a -> b
loop
  foldl' :: (b -> a -> b) -> b -> List a -> b
foldl' b -> a -> b
step b
init = let
    loop :: b -> List a -> b
loop !b
acc = \ case
      Cons a
head List a
tail -> b -> List a -> b
loop (b -> a -> b
step b
acc a
head) List a
tail
      List a
_ -> b
acc
    in b -> List a -> b
loop b
init

instance Traversable List where
  sequenceA :: List (f a) -> f (List a)
sequenceA = (f a -> f (List a) -> f (List a))
-> f (List a) -> List (f a) -> f (List a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> List a -> List a) -> f a -> f (List a) -> f (List a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> List a -> List a
forall a. a -> List a -> List a
Cons) (List a -> f (List a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure List a
forall a. List a
Nil)

instance Apply List where
  <.> :: List (a -> b) -> List a -> List b
(<.>) List (a -> b)
fList List a
aList = List (a -> b) -> List a -> List b
forall a b. List (a -> b) -> List a -> List b
apReversed (List (a -> b) -> List (a -> b)
forall a. List a -> List a
reverse List (a -> b)
fList) (List a -> List a
forall a. List a -> List a
reverse List a
aList)

instance Applicative List where
  pure :: a -> List a
pure a
a = a -> List a -> List a
forall a. a -> List a -> List a
Cons a
a List a
forall a. List a
Nil
  <*> :: List (a -> b) -> List a -> List b
(<*>) = List (a -> b) -> List a -> List b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)

instance Alt List where
  <!> :: List a -> List a -> List a
(<!>) = List a -> List a -> List a
forall a. Monoid a => a -> a -> a
mappend

instance Plus List where
  zero :: List a
zero = List a
forall a. Monoid a => a
mempty

instance Alternative List where
  empty :: List a
empty = List a
forall (f :: * -> *) a. Plus f => f a
zero
  <|> :: List a -> List a -> List a
(<|>) = List a -> List a -> List a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>)

instance Bind List where
  >>- :: List a -> (a -> List b) -> List b
(>>-) List a
ma a -> List b
amb = List b -> List b
forall a. List a -> List a
reverse ((a -> List b) -> List a -> List b
forall a b. (a -> List b) -> List a -> List b
explodeReversed a -> List b
amb List a
ma)
  join :: List (List a) -> List a
join = List a -> List a
forall a. List a -> List a
reverse (List a -> List a)
-> (List (List a) -> List a) -> List (List a) -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. List (List a) -> List a
forall a. List (List a) -> List a
joinReversed

instance Monad List where
  return :: a -> List a
return = a -> List a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: List a -> (a -> List b) -> List b
(>>=) = List a -> (a -> List b) -> List b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)

instance MonadPlus List where
  mzero :: List a
mzero = List a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: List a -> List a -> List a
mplus = List a -> List a -> List a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Hashable a => Hashable (List a)

instance NFData a => NFData (List a)

instance NFData1 List

{-|
Reverse the list.
-}
reverse :: List a -> List a
reverse :: List a -> List a
reverse = (List a -> a -> List a) -> List a -> List a -> List a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> List a -> List a) -> List a -> a -> List a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> List a -> List a
forall a. a -> List a -> List a
Cons) List a
forall a. List a
Nil

{-|
Leave only the specified amount of elements.
-}
take :: Int -> List a -> List a
take :: Int -> List a -> List a
take Int
amount = List a -> List a
forall a. List a -> List a
reverse (List a -> List a) -> (List a -> List a) -> List a -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> List a -> List a
forall a. Int -> List a -> List a
takeReversed Int
amount

{-|
Leave only the specified amount of elements, in reverse order.
-}
takeReversed :: Int -> List a -> List a
takeReversed :: Int -> List a -> List a
takeReversed = let
  loop :: List a -> t -> List a -> List a
loop !List a
output !t
amount = if t
amount t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0
    then \ case
      Cons a
head List a
tail -> List a -> t -> List a -> List a
loop (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
output) (t -> t
forall a. Enum a => a -> a
pred t
amount) List a
tail
      List a
_ -> List a
output
    else List a -> List a -> List a
forall a b. a -> b -> a
const List a
output
  in List a -> Int -> List a -> List a
forall t a.
(Ord t, Num t, Enum t) =>
List a -> t -> List a -> List a
loop List a
forall a. List a
Nil

{-|
Leave only the elements after the specified amount of first elements.
-}
drop :: Int -> List a -> List a
drop :: Int -> List a -> List a
drop Int
amount = if Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  then \ case
    Cons a
_ List a
tail -> Int -> List a -> List a
forall a. Int -> List a -> List a
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
amount) List a
tail
    List a
_ -> List a
forall a. List a
Nil
  else List a -> List a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-|
Leave only the elements satisfying the predicate.
-}
filter :: (a -> Bool) -> List a -> List a
filter :: (a -> Bool) -> List a -> List a
filter a -> Bool
predicate = List a -> List a
forall a. List a -> List a
reverse (List a -> List a) -> (List a -> List a) -> List a -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
filterReversed a -> Bool
predicate

{-|
Leave only the elements satisfying the predicate,
producing a list in reversed order.
-}
filterReversed :: (a -> Bool) -> List a -> List a
filterReversed :: (a -> Bool) -> List a -> List a
filterReversed a -> Bool
predicate = let
  loop :: List a -> List a -> List a
loop !List a
newList = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then List a -> List a -> List a
loop (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
newList) List a
tail
      else List a -> List a -> List a
loop List a
newList List a
tail
    List a
Nil -> List a
newList
  in List a -> List a -> List a
loop List a
forall a. List a
Nil

{-|
Leave only the first elements satisfying the predicate.
-}
takeWhile :: (a -> Bool) -> List a -> List a
takeWhile :: (a -> Bool) -> List a -> List a
takeWhile a -> Bool
predicate = List a -> List a
forall a. List a -> List a
reverse (List a -> List a) -> (List a -> List a) -> List a -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
takeWhileReversed a -> Bool
predicate

{-|
Leave only the first elements satisfying the predicate,
producing a list in reversed order.
-}
takeWhileReversed :: (a -> Bool) -> List a -> List a
takeWhileReversed :: (a -> Bool) -> List a -> List a
takeWhileReversed a -> Bool
predicate = let
  loop :: List a -> List a -> List a
loop !List a
newList = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then List a -> List a -> List a
loop (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
newList) List a
tail
      else List a
newList
    List a
_ -> List a
newList
  in List a -> List a -> List a
loop List a
forall a. List a
Nil

{-|
Drop the first elements satisfying the predicate.
-}
dropWhile :: (a -> Bool) -> List a -> List a
dropWhile :: (a -> Bool) -> List a -> List a
dropWhile a -> Bool
predicate = \ case
  Cons a
head List a
tail -> if a -> Bool
predicate a
head
    then (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
dropWhile a -> Bool
predicate List a
tail
    else a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
tail
  List a
Nil -> List a
forall a. List a
Nil

{-|
An optimized version of the same predicate applied to `takeWhile` and `dropWhile`.
IOW,

>span predicate list = (takeWhile predicate list, dropWhile predicate list)
-}
span :: (a -> Bool) -> List a -> (List a, List a)
span :: (a -> Bool) -> List a -> (List a, List a)
span a -> Bool
predicate = (List a -> List a) -> (List a, List a) -> (List a, List a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first List a -> List a
forall a. List a -> List a
reverse ((List a, List a) -> (List a, List a))
-> (List a -> (List a, List a)) -> List a -> (List a, List a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Bool) -> List a -> (List a, List a)
forall a. (a -> Bool) -> List a -> (List a, List a)
spanReversed a -> Bool
predicate

{-|
Same as `span`, only with the first list in reverse order.
-}
spanReversed :: (a -> Bool) -> List a -> (List a, List a)
spanReversed :: (a -> Bool) -> List a -> (List a, List a)
spanReversed a -> Bool
predicate = let
  buildPrefix :: List a -> List a -> (List a, List a)
buildPrefix !List a
prefix = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then List a -> List a -> (List a, List a)
buildPrefix (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
prefix) List a
tail
      else (List a
prefix, a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
tail)
    List a
_ -> (List a
prefix, List a
forall a. List a
Nil)
  in List a -> List a -> (List a, List a)
buildPrefix List a
forall a. List a
Nil

{-|
An opposite version of `span`. I.e.,

>break predicate = span (not . predicate)
-}
break :: (a -> Bool) -> List a -> (List a, List a)
break :: (a -> Bool) -> List a -> (List a, List a)
break a -> Bool
predicate = (List a -> List a) -> (List a, List a) -> (List a, List a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first List a -> List a
forall a. List a -> List a
reverse ((List a, List a) -> (List a, List a))
-> (List a -> (List a, List a)) -> List a -> (List a, List a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Bool) -> List a -> (List a, List a)
forall a. (a -> Bool) -> List a -> (List a, List a)
breakReversed a -> Bool
predicate

{-|
Same as `break`, only with the first list in reverse order.
-}
breakReversed :: (a -> Bool) -> List a -> (List a, List a)
breakReversed :: (a -> Bool) -> List a -> (List a, List a)
breakReversed a -> Bool
predicate = let
  buildPrefix :: List a -> List a -> (List a, List a)
buildPrefix !List a
prefix = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then (List a
prefix, a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
tail)
      else List a -> List a -> (List a, List a)
buildPrefix (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
prefix) List a
tail
    List a
_ -> (List a
prefix, List a
forall a. List a
Nil)
  in List a -> List a -> (List a, List a)
buildPrefix List a
forall a. List a
Nil

{-|
Same as @(`takeWhile` predicate . `reverse`)@.
E.g., 

>>> takeWhileFromEnding (> 2) (fromList [1,4,2,3,4,5])
fromList [5,4,3]
-}
takeWhileFromEnding :: (a -> Bool) -> List a -> List a
takeWhileFromEnding :: (a -> Bool) -> List a -> List a
takeWhileFromEnding a -> Bool
predicate = (List a -> a -> List a) -> List a -> List a -> List a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
  (\ List a
newList a
a -> if a -> Bool
predicate a
a
    then a -> List a -> List a
forall a. a -> List a -> List a
Cons a
a List a
newList
    else List a
forall a. List a
Nil)
  List a
forall a. List a
Nil

{-|
Same as @(`dropWhile` predicate . `reverse`)@.
E.g., 

>>> dropWhileFromEnding (> 2) (fromList [1,4,2,3,4,5])
fromList [2,4,1]
-}
dropWhileFromEnding :: (a -> Bool) -> List a -> List a
dropWhileFromEnding :: (a -> Bool) -> List a -> List a
dropWhileFromEnding a -> Bool
predicate = let
  loop :: List a -> List a -> List a -> List a
loop List a
confirmed List a
unconfirmed = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then List a -> List a -> List a -> List a
loop List a
confirmed (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
unconfirmed) List a
tail
      else let
        !newConfirmed :: List a
newConfirmed = a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
unconfirmed
        in List a -> List a -> List a -> List a
loop List a
newConfirmed List a
newConfirmed List a
tail
    List a
Nil -> List a
confirmed
  in List a -> List a -> List a -> List a
loop List a
forall a. List a
Nil List a
forall a. List a
Nil

{-|
Same as @(`span` predicate . `reverse`)@.
-}
spanFromEnding :: (a -> Bool) -> List a -> (List a, List a)
spanFromEnding :: (a -> Bool) -> List a -> (List a, List a)
spanFromEnding a -> Bool
predicate = let
  loop :: List a -> List a -> List a -> List a -> (List a, List a)
loop !List a
confirmedPrefix !List a
unconfirmedPrefix !List a
suffix = \ case
    Cons a
head List a
tail -> if a -> Bool
predicate a
head
      then List a -> List a -> List a -> List a -> (List a, List a)
loop List a
confirmedPrefix (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
unconfirmedPrefix) (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
suffix) List a
tail
      else let
        !prefix :: List a
prefix = a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
unconfirmedPrefix
        in List a -> List a -> List a -> List a -> (List a, List a)
loop List a
prefix List a
prefix List a
forall a. List a
Nil List a
tail
    List a
Nil -> (List a
suffix, List a
confirmedPrefix)
  in List a -> List a -> List a -> List a -> (List a, List a)
loop List a
forall a. List a
Nil List a
forall a. List a
Nil List a
forall a. List a
Nil

{-|
Pattern match on list using functions.

Allows to achieve all the same as `uncons` only without intermediate `Maybe`.

Essentially provides the same functionality as `either` for `Either` and `maybe` for `Maybe`.
-}
match :: result -> (element -> List element -> result) -> List element -> result
match :: result
-> (element -> List element -> result) -> List element -> result
match result
nil element -> List element -> result
cons = \ case
  Cons element
head List element
tail -> element -> List element -> result
cons element
head List element
tail
  List element
Nil -> result
nil

{-|
Get the first element and the remainder of the list if it's not empty.
-}
uncons :: List a -> Maybe (a, List a)
uncons :: List a -> Maybe (a, List a)
uncons = \ case
  Cons a
head List a
tail -> (a, List a) -> Maybe (a, List a)
forall a. a -> Maybe a
Just (a
head, List a
tail)
  List a
_ -> Maybe (a, List a)
forall a. Maybe a
Nothing

{-|
Get the first element, if list is not empty.
-}
head :: List a -> Maybe a
head :: List a -> Maybe a
head = \ case
  Cons a
head List a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
head
  List a
_ -> Maybe a
forall a. Maybe a
Nothing

{-|
Get the last element, if list is not empty.
-}
last :: List a -> Maybe a
last :: List a -> Maybe a
last = let
  loop :: Maybe a -> List a -> Maybe a
loop !Maybe a
previous = \ case
    Cons a
head List a
tail -> Maybe a -> List a -> Maybe a
loop (a -> Maybe a
forall a. a -> Maybe a
Just a
head) List a
tail
    List a
_ -> Maybe a
previous
  in Maybe a -> List a -> Maybe a
forall a. Maybe a -> List a -> Maybe a
loop Maybe a
forall a. Maybe a
Nothing

{-|
Get all elements of the list but the first one.
-}
tail :: List a -> List a
tail :: List a -> List a
tail = \ case
  Cons a
_ List a
tail -> List a
tail
  List a
Nil -> List a
forall a. List a
Nil

{-|
Get all elements but the last one.
-}
init :: List a -> List a
init :: List a -> List a
init = List a -> List a
forall a. List a -> List a
reverse (List a -> List a) -> (List a -> List a) -> List a -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. List a -> List a
forall a. List a -> List a
initReversed

{-|
Get all elements but the last one, producing the results in reverse order.
-}
initReversed :: List a -> List a
initReversed :: List a -> List a
initReversed = let
  loop :: List a -> List a -> List a -> List a
loop !List a
confirmed !List a
unconfirmed = \ case
    Cons a
head List a
tail -> List a -> List a -> List a -> List a
loop List a
unconfirmed (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head List a
unconfirmed) List a
tail
    List a
_ -> List a
confirmed
  in List a -> List a -> List a -> List a
forall a. List a -> List a -> List a -> List a
loop List a
forall a. List a
Nil List a
forall a. List a
Nil

{-|
Apply the functions in the left list to elements in the right one.
-}
apZipping :: List (a -> b) -> List a -> List b
apZipping :: List (a -> b) -> List a -> List b
apZipping List (a -> b)
left List a
right = List (a -> b) -> List a -> List b
forall a b. List (a -> b) -> List a -> List b
apZippingReversed (List (a -> b) -> List (a -> b)
forall a. List a -> List a
reverse List (a -> b)
left) (List a -> List a
forall a. List a -> List a
reverse List a
right)

{-|
Apply the functions in the left list to elements in the right one,
producing a list of results in reversed order.
-}
apZippingReversed :: List (a -> b) -> List a -> List b
apZippingReversed :: List (a -> b) -> List a -> List b
apZippingReversed = let
  loop :: List a -> List (t -> a) -> List t -> List a
loop List a
bList = \ case
    Cons t -> a
f List (t -> a)
fTail -> \ case
      Cons t
a List t
aTail -> List a -> List (t -> a) -> List t -> List a
loop (a -> List a -> List a
forall a. a -> List a -> List a
Cons (t -> a
f t
a) List a
bList) List (t -> a)
fTail List t
aTail
      List t
_ -> List a
bList
    List (t -> a)
_ -> List a -> List t -> List a
forall a b. a -> b -> a
const List a
bList
  in List b -> List (a -> b) -> List a -> List b
forall a t. List a -> List (t -> a) -> List t -> List a
loop List b
forall a. List a
Nil


-- ** Reversed intermediate functions used in instances
-------------------------

{-|
Construct from a lazy list in reversed order.
-}
fromListReversed :: [a] -> List a
fromListReversed :: [a] -> List a
fromListReversed = (List a -> a -> List a) -> List a -> [a] -> List a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> List a -> List a) -> List a -> a -> List a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> List a -> List a
forall a. a -> List a -> List a
Cons) List a
forall a. List a
Nil

{-|
Add elements of the left list in reverse order
in the beginning of the right list.
 -}
prependReversed :: List a -> List a -> List a
prependReversed :: List a -> List a -> List a
prependReversed = \ case
  Cons a
head List a
tail -> List a -> List a -> List a
forall a. List a -> List a -> List a
prependReversed List a
tail (List a -> List a) -> (List a -> List a) -> List a -> List a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> List a -> List a
forall a. a -> List a -> List a
Cons a
head
  List a
Nil -> List a -> List a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-|
Map producing a list in reversed order.
-}
mapReversed :: (a -> b) -> List a -> List b
mapReversed :: (a -> b) -> List a -> List b
mapReversed a -> b
f = let
  loop :: List b -> List a -> List b
loop !List b
newList = \ case
    Cons a
head List a
tail -> List b -> List a -> List b
loop (b -> List b -> List b
forall a. a -> List a -> List a
Cons (a -> b
f a
head) List b
newList) List a
tail
    List a
_ -> List b
newList
  in List b -> List a -> List b
loop List b
forall a. List a
Nil

{-|
Apply the functions in the left list to every element in the right one,
producing a list of results in reversed order.
-}
apReversed :: List (a -> b) -> List a -> List b
apReversed :: List (a -> b) -> List a -> List b
apReversed List (a -> b)
fList List a
aList = (List b -> (a -> b) -> List b) -> List b -> List (a -> b) -> List b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ List b
z a -> b
f -> (List b -> a -> List b) -> List b -> List a -> List b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ List b
z a
a -> b -> List b -> List b
forall a. a -> List a -> List a
Cons (a -> b
f a
a) List b
z) List b
z List a
aList) List b
forall a. List a
Nil List (a -> b)
fList

{-|
Use a function to produce a list of lists and then concat them sequentially,
producing the results in reversed order.
-}
explodeReversed :: (a -> List b) -> List a -> List b
explodeReversed :: (a -> List b) -> List a -> List b
explodeReversed a -> List b
amb = (List b -> a -> List b) -> List b -> List a -> List b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ List b
z -> (List b -> b -> List b) -> List b -> List b -> List b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> List b -> List b) -> List b -> b -> List b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> List b -> List b
forall a. a -> List a -> List a
Cons) List b
z (List b -> List b) -> (a -> List b) -> a -> List b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> List b
amb) List b
forall a. List a
Nil

{-|
Join (concat) producing results in reversed order.
-}
joinReversed :: List (List a) -> List a
joinReversed :: List (List a) -> List a
joinReversed = (List a -> List a -> List a) -> List a -> List (List a) -> List a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((List a -> a -> List a) -> List a -> List a -> List a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> List a -> List a) -> List a -> a -> List a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> List a -> List a
forall a. a -> List a -> List a
Cons)) List a
forall a. List a
Nil