-- |
-- 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 (drop, dropWhile, reverse, take, takeWhile)

-- |
-- 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

-- |
-- Convert to lazy list in normal form (with all elements and spine evaluated).
toListReversed :: List a -> [a]
toListReversed :: List a -> [a]
toListReversed = [a] -> List a -> [a]
forall a. [a] -> List a -> [a]
go []
  where
    go :: [a] -> List a -> [a]
go ![a]
outputList = \case
      Cons a
element List a
list -> [a] -> List a -> [a]
go (a
element a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
outputList) List a
list
      List a
Nil -> [a]
outputList

-- |
-- Reverse the list.
{-# INLINE reverse #-}
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.
{-# INLINE take #-}
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.
{-# INLINE filter #-}
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.
{-# INLINE takeWhile #-}
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)
{-# INLINE span #-}
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)
{-# INLINE break #-}
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]
{-# INLINE takeWhileFromEnding #-}
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`.
{-# INLINE match #-}
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.
{-# INLINE uncons #-}
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.
{-# INLINE head #-}
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.
{-# INLINE last #-}
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.
{-# INLINE tail #-}
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.
{-# INLINE init #-}
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.
{-# INLINE apZipping #-}
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.
{-# INLINE fromListReversed #-}
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.
{-# INLINE prependReversed #-}
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.
{-# INLINE apReversed #-}
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.
{-# INLINE explodeReversed #-}
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.
{-# INLINE joinReversed #-}
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

-- |
-- Map and filter elements producing results in reversed order.
{-# INLINE mapMaybeReversed #-}
mapMaybeReversed :: (a -> Maybe b) -> List a -> List b
mapMaybeReversed :: (a -> Maybe b) -> List a -> List b
mapMaybeReversed a -> Maybe b
f = List b -> List a -> List b
go List b
forall a. List a
Nil
  where
    go :: List b -> List a -> List b
go !List b
outputList = \case
      Cons a
inputElement List a
inputTail -> case a -> Maybe b
f a
inputElement of
        Just b
outputElement -> List b -> List a -> List b
go (b -> List b -> List b
forall a. a -> List a -> List a
Cons b
outputElement List b
outputList) List a
inputTail
        Maybe b
Nothing -> List b -> List a -> List b
go List b
outputList List a
inputTail
      List a
Nil -> List b
outputList

-- |
-- Keep only the present values, reversing the order.
catMaybesReversed :: List (Maybe a) -> List a
catMaybesReversed :: List (Maybe a) -> List a
catMaybesReversed = List a -> List (Maybe a) -> List a
forall a. List a -> List (Maybe a) -> List a
go List a
forall a. List a
Nil
  where
    go :: List a -> List (Maybe a) -> List a
go !List a
outputList = \case
      Cons Maybe a
inputElement List (Maybe a)
inputTail -> case Maybe a
inputElement of
        Just a
outputElement -> List a -> List (Maybe a) -> List a
go (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
outputElement List a
outputList) List (Maybe a)
inputTail
        Maybe a
Nothing -> List a -> List (Maybe a) -> List a
go List a
outputList List (Maybe a)
inputTail
      List (Maybe a)
Nil -> List a
outputList