{-|
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)
Constr
DataType
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 -> Constr
List a -> DataType
(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 -> Constr
forall a. Data a => List a -> DataType
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
(<>) a :: List a
a b :: List a
b = case List a
b of
    Nil -> List a
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 f :: 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 step :: a -> b -> b
step init :: b
init = let
    loop :: List a -> b
loop = \ case
      Cons head :: a
head tail :: List a
tail -> a -> b -> b
step a
head (List a -> b
loop List a
tail)
      _ -> b
init
    in List a -> b
loop
  foldl' :: (b -> a -> b) -> b -> List a -> b
foldl' step :: b -> a -> b
step init :: b
init = let
    loop :: b -> List a -> b
loop !b
acc = \ case
      Cons head :: a
head tail :: List a
tail -> b -> List a -> b
loop (b -> a -> b
step b
acc a
head) List a
tail
      _ -> 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
(<.>) fList :: List (a -> b)
fList aList :: 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 = 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
(>>-) ma :: List a
ma amb :: 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)

{-|
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 amount :: 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
> 0
    then \ case
      Cons head :: a
head tail :: 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
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 amount :: Int
amount = if Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
  then \ case
    Cons _ tail :: 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
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 predicate :: 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 predicate :: a -> Bool
predicate = let
  loop :: List a -> List a -> List a
loop !List a
newList = \ case
    Cons head :: a
head tail :: 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
    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 predicate :: 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 predicate :: a -> Bool
predicate = let
  loop :: List a -> List a -> List a
loop !List a
newList = \ case
    Cons head :: a
head tail :: 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
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 predicate :: a -> Bool
predicate = \ case
  Cons head :: a
head tail :: 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
  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 predicate :: 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 predicate :: a -> Bool
predicate = let
  buildPrefix :: List a -> List a -> (List a, List a)
buildPrefix !List a
prefix = \ case
    Cons head :: a
head tail :: 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
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 predicate :: 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 predicate :: a -> Bool
predicate = let
  buildPrefix :: List a -> List a -> (List a, List a)
buildPrefix !List a
prefix = \ case
    Cons head :: a
head tail :: 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
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 predicate :: 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'
  (\ newList :: List a
newList a :: 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 predicate :: a -> Bool
predicate = let
  loop :: List a -> List a -> List a -> List a
loop confirmed :: List a
confirmed unconfirmed :: List a
unconfirmed = \ case
    Cons head :: a
head tail :: 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
    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 predicate :: 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 head :: a
head tail :: 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
    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 nil :: result
nil cons :: element -> List element -> result
cons = \ case
  Cons head :: element
head tail :: List element
tail -> element -> List element -> result
cons element
head List element
tail
  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 head :: a
head tail :: List a
tail -> (a, List a) -> Maybe (a, List a)
forall a. a -> Maybe a
Just (a
head, List a
tail)
  _ -> 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 head :: a
head _ -> a -> Maybe a
forall a. a -> Maybe a
Just a
head
  _ -> 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 head :: a
head tail :: List a
tail -> Maybe a -> List a -> Maybe a
loop (a -> Maybe a
forall a. a -> Maybe a
Just a
head) List a
tail
    _ -> 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 _ tail :: List a
tail -> List a
tail
  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 head :: a
head tail :: 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
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 left :: List (a -> b)
left right :: 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 bList :: List a
bList = \ case
    Cons f :: t -> a
f fTail :: List (t -> a)
fTail -> \ case
      Cons a :: t
a aTail :: 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 a
bList
    _ -> 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 head :: a
head tail :: 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
  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 f :: a -> b
f = let
  loop :: List b -> List a -> List b
loop !List b
newList = \ case
    Cons head :: a
head tail :: 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 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 fList :: List (a -> b)
fList aList :: 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' (\ z :: List b
z f :: 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' (\ z :: List b
z a :: 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 amb :: 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' (\ z :: 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