{-# OPTIONS_GHC -Wno-dodgy-imports #-}

module ListT
  ( ListT (..),

    -- * Execution utilities
    uncons,
    head,
    tail,
    null,
    alternate,
    alternateHoisting,
    fold,
    foldMaybe,
    applyFoldM,
    toList,
    toReverseList,
    traverse_,
    splitAt,

    -- * Construction utilities
    cons,
    fromFoldable,
    fromMVar,
    unfold,
    unfoldM,
    repeat,

    -- * Transformation utilities

    -- |
    -- These utilities only accumulate the transformations
    -- without actually traversing the stream.
    -- They only get applied in a single traversal,
    -- which only happens at the execution.
    traverse,
    take,
    drop,
    slice,
  )
where

import ListT.Prelude hiding (drop, fold, head, null, repeat, splitAt, tail, take, toList, traverse, traverse_, uncons, yield)

-- |
-- A proper implementation of the list monad-transformer.
-- Useful for streaming of monadic data structures.
--
-- Since it has instances of 'MonadPlus' and 'Alternative',
-- you can use general utilities packages like
-- <http://hackage.haskell.org/package/monadplus "monadplus">
-- with it.
newtype ListT m a
  = ListT (m (Maybe (a, ListT m a)))
  deriving (forall a. ListT m a -> Bool
forall m a. Monoid m => (a -> m) -> ListT m a -> m
forall a b. (a -> b -> b) -> b -> ListT m a -> b
forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ListT m a -> Bool
forall (m :: * -> *) a. (Foldable m, Num a) => ListT m a -> a
forall (m :: * -> *) a. (Foldable m, Ord a) => ListT m a -> a
forall (m :: * -> *) m. (Foldable m, Monoid m) => ListT m m -> m
forall (m :: * -> *) a. Foldable m => ListT m a -> Bool
forall (m :: * -> *) a. Foldable m => ListT m a -> Int
forall (m :: * -> *) a. Foldable m => ListT m a -> [a]
forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ListT m a -> a
forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ListT m a -> m
forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ListT m a -> b
forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ListT m a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ListT m a -> a
$cproduct :: forall (m :: * -> *) a. (Foldable m, Num a) => ListT m a -> a
sum :: forall a. Num a => ListT m a -> a
$csum :: forall (m :: * -> *) a. (Foldable m, Num a) => ListT m a -> a
minimum :: forall a. Ord a => ListT m a -> a
$cminimum :: forall (m :: * -> *) a. (Foldable m, Ord a) => ListT m a -> a
maximum :: forall a. Ord a => ListT m a -> a
$cmaximum :: forall (m :: * -> *) a. (Foldable m, Ord a) => ListT m a -> a
elem :: forall a. Eq a => a -> ListT m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> ListT m a -> Bool
length :: forall a. ListT m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => ListT m a -> Int
null :: forall a. ListT m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => ListT m a -> Bool
toList :: forall a. ListT m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => ListT m a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ListT m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ListT m a -> a
foldr1 :: forall a. (a -> a -> a) -> ListT m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> ListT m a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ListT m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ListT m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ListT m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> ListT m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ListT m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ListT m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ListT m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> ListT m a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ListT m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ListT m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ListT m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> ListT m a -> m
fold :: forall m. Monoid m => ListT m m -> m
$cfold :: forall (m :: * -> *) m. (Foldable m, Monoid m) => ListT m m -> m
Foldable, forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {m :: * -> *}. Traversable m => Functor (ListT m)
forall {m :: * -> *}. Traversable m => Foldable (ListT m)
forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
ListT m (m a) -> m (ListT m a)
forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
ListT m (f a) -> f (ListT m a)
forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> ListT m a -> m (ListT m b)
forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> ListT m a -> f (ListT m b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ListT m a -> f (ListT m b)
sequence :: forall (m :: * -> *) a. Monad m => ListT m (m a) -> m (ListT m a)
$csequence :: forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
ListT m (m a) -> m (ListT m a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ListT m a -> m (ListT m b)
$cmapM :: forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> ListT m a -> m (ListT m b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ListT m (f a) -> f (ListT m a)
$csequenceA :: forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
ListT m (f a) -> f (ListT m a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ListT m a -> f (ListT m b)
$ctraverse :: forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> ListT m a -> f (ListT m b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) a x. Rep (ListT m a) x -> ListT m a
forall (m :: * -> *) a x. ListT m a -> Rep (ListT m a) x
$cto :: forall (m :: * -> *) a x. Rep (ListT m a) x -> ListT m a
$cfrom :: forall (m :: * -> *) a x. ListT m a -> Rep (ListT m a) x
Generic)

deriving instance (Show (m (Maybe (a, ListT m a)))) => Show (ListT m a)

deriving instance (Read (m (Maybe (a, ListT m a)))) => Read (ListT m a)

deriving instance (Eq (m (Maybe (a, ListT m a)))) => Eq (ListT m a)

deriving instance (Ord (m (Maybe (a, ListT m a)))) => Ord (ListT m a)

deriving instance (Typeable m, Typeable a, Data (m (Maybe (a, ListT m a)))) => Data (ListT m a)

instance (Eq1 m) => Eq1 (ListT m) where
  liftEq :: forall a b. (a -> b -> Bool) -> ListT m a -> ListT m b -> Bool
liftEq a -> b -> Bool
eq = ListT m a -> ListT m b -> Bool
go
    where
      go :: ListT m a -> ListT m b -> Bool
go (ListT m (Maybe (a, ListT m a))
m) (ListT m (Maybe (b, ListT m b))
n) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (\(a
a, ListT m a
as) (b
b, ListT m b
bs) -> a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& ListT m a -> ListT m b -> Bool
go ListT m a
as ListT m b
bs)) m (Maybe (a, ListT m a))
m m (Maybe (b, ListT m b))
n

instance (Ord1 m) => Ord1 (ListT m) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> ListT m a -> ListT m b -> Ordering
liftCompare a -> b -> Ordering
cmp = ListT m a -> ListT m b -> Ordering
go
    where
      go :: ListT m a -> ListT m b -> Ordering
go (ListT m (Maybe (a, ListT m a))
m) (ListT m (Maybe (b, ListT m b))
n) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\(a
a, ListT m a
as) (b
b, ListT m b
bs) -> a -> b -> Ordering
cmp a
a b
b forall a. Semigroup a => a -> a -> a
<> ListT m a -> ListT m b -> Ordering
go ListT m a
as ListT m b
bs)) m (Maybe (a, ListT m a))
m m (Maybe (b, ListT m b))
n

instance (Show1 m) => Show1 (ListT m) where
  -- I wish I were joking.
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> ListT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp ([a] -> ShowS
sl :: [a] -> ShowS) = Int -> ListT m a -> ShowS
mark
    where
      bob :: Int -> m (Maybe (a, ListT m a)) -> ShowS
      bob :: Int -> m (Maybe (a, ListT m a)) -> ShowS
bob = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Maybe (a, ListT m a) -> ShowS
jill [Maybe (a, ListT m a)] -> ShowS
edith

      edith :: [Maybe (a, ListT m a)] -> ShowS
      edith :: [Maybe (a, ListT m a)] -> ShowS
edith = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> (a, ListT m a) -> ShowS
jack [(a, ListT m a)] -> ShowS
martha

      jill :: Int -> Maybe (a, ListT m a) -> ShowS
      jill :: Int -> Maybe (a, ListT m a) -> ShowS
jill = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> (a, ListT m a) -> ShowS
jack [(a, ListT m a)] -> ShowS
martha

      martha :: [(a, ListT m a)] -> ShowS
      martha :: [(a, ListT m a)] -> ShowS
martha = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> ListT m a -> ShowS
mark [ListT m a] -> ShowS
juan

      mark :: Int -> ListT m a -> ShowS
      mark :: Int -> ListT m a -> ShowS
mark Int
d (ListT m (Maybe (a, ListT m a))
m) = forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> m (Maybe (a, ListT m a)) -> ShowS
bob String
"ListT" Int
d m (Maybe (a, ListT m a))
m

      juan :: [ListT m a] -> ShowS
      juan :: [ListT m a] -> ShowS
juan = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl

      jack :: Int -> (a, ListT m a) -> ShowS
      jack :: Int -> (a, ListT m a) -> ShowS
jack = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> ListT m a -> ShowS
mark [ListT m a] -> ShowS
juan

instance (Monad m) => Semigroup (ListT m a) where
  <> :: ListT m a -> ListT m a -> ListT m a
(<>) (ListT m (Maybe (a, ListT m a))
m1) (ListT m (Maybe (a, ListT m a))
m2) =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      m (Maybe (a, ListT m a))
m1
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, ListT m a)
Nothing ->
            m (Maybe (a, ListT m a))
m2
          Just (a
h1, ListT m a
s1') ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
h1, (forall a. Semigroup a => a -> a -> a
(<>) ListT m a
s1' (forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT m (Maybe (a, ListT m a))
m2))))

instance (Monad m) => Monoid (ListT m a) where
  mempty :: ListT m a
mempty =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  mappend :: ListT m a -> ListT m a -> ListT m a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance (Functor m) => Functor (ListT m) where
  fmap :: forall a b. (a -> b) -> ListT m a -> ListT m b
fmap a -> b
f = ListT m a -> ListT m b
go
    where
      go :: ListT m a -> ListT m b
go =
        forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimapPair' a -> b
f ListT m a -> ListT m b
go) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons

instance (Monad m, Functor m) => Applicative (ListT m) where
  pure :: forall a. a -> ListT m a
pure a
a =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
a, (forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing))))
  <*> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m b
(<*>) =
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

  -- This is just like liftM2, but it uses fmap over the second
  -- action. liftM2 can't do that, because it has to deal with
  -- the possibility that someone defines liftA2 = liftM2 and
  -- fmap f = (pure f <*>) (leaving (<*>) to the default).
  liftA2 :: forall a b c. (a -> b -> c) -> ListT m a -> ListT m b -> ListT m c
liftA2 a -> b -> c
f ListT m a
m1 ListT m b
m2 = do
    a
x1 <- ListT m a
m1
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x1) ListT m b
m2

instance (Monad m, Functor m) => Alternative (ListT m) where
  empty :: forall a. ListT m a
empty =
    forall a. a -> a
inline forall a. Monoid a => a
mempty
  <|> :: forall a. ListT m a -> ListT m a -> ListT m a
(<|>) =
    forall a. a -> a
inline forall a. Monoid a => a -> a -> a
mappend

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

  -- We use a go function so GHC can inline k2
  -- if it likes.
  >>= :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
(>>=) ListT m a
s10 a -> ListT m b
k2 = ListT m a -> ListT m b
go ListT m a
s10
    where
      go :: ListT m a -> ListT m b
go ListT m a
s1 =
        forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
s1
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe (a, ListT m a)
Nothing ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Just (a
h1, ListT m a
t1) ->
                forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall a b. (a -> b) -> a -> b
$ a -> ListT m b
k2 a
h1 forall a. Semigroup a => a -> a -> a
<> ListT m a -> ListT m b
go ListT m a
t1

instance (Monad m) => MonadFail (ListT m) where
  fail :: forall a. String -> ListT m a
fail String
_ =
    forall a. a -> a
inline forall a. Monoid a => a
mempty

instance (Monad m) => MonadPlus (ListT m) where
  mzero :: forall a. ListT m a
mzero =
    forall a. a -> a
inline forall a. Monoid a => a
mempty
  mplus :: forall a. ListT m a -> ListT m a -> ListT m a
mplus =
    forall a. a -> a
inline forall a. Monoid a => a -> a -> a
mappend

instance MonadTrans ListT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ListT m a
lift =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> forall a. a -> Maybe a
Just (a
a, forall a. Monoid a => a
mempty))

instance (MonadIO m) => MonadIO (ListT m) where
  liftIO :: forall a. IO a -> ListT m a
liftIO =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MFunctor ListT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ListT m b -> ListT n b
hoist forall a. m a -> n a
f = ListT m b -> ListT n b
go
    where
      go :: ListT m b -> ListT n b
go (ListT m (Maybe (b, ListT m b))
run) =
        forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. m a -> n a
f forall a b. (a -> b) -> a -> b
$
          m (Maybe (b, ListT m b))
run forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (b
elem, ListT m b
next) -> forall a. a -> Maybe a
Just (b
elem, ListT m b -> ListT n b
go ListT m b
next)
            Maybe (b, ListT m b)
Nothing -> forall a. Maybe a
Nothing

instance MMonad ListT where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> ListT n a) -> ListT m b -> ListT n b
embed forall a. m a -> ListT n a
f (ListT m (Maybe (b, ListT m b))
m) =
    forall a. m a -> ListT n a
f m (Maybe (b, ListT m b))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (b, ListT m b)
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      Just (b
h, ListT m b
t) -> forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (b
h, forall (t :: (* -> *) -> * -> *) (n :: * -> *) (m :: * -> *) b.
(MMonad t, Monad n) =>
(forall a. m a -> t n a) -> t m b -> t n b
embed forall a. m a -> ListT n a
f ListT m b
t)

instance (MonadBase b m) => MonadBase b (ListT m) where
  liftBase :: forall α. b α -> ListT m α
liftBase =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance (MonadBaseControl b m) => MonadBaseControl b (ListT m) where
  type
    StM (ListT m) a =
      StM m (Maybe (a, ListT m a))
  liftBaseWith :: forall a. (RunInBase (ListT m) b -> b a) -> ListT m a
liftBaseWith RunInBase (ListT m) b -> b a
runToBase =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
      forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInner ->
        RunInBase (ListT m) b -> b a
runToBase forall a b. (a -> b) -> a -> b
$ RunInBase m b
runInner forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons
  restoreM :: forall a. StM (ListT m) a -> ListT m a
restoreM StM (ListT m) a
inner =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM (ListT m) a
inner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      Just (a
h, ListT m a
t) -> forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons a
h ListT m a
t

instance (MonadError e m) => MonadError e (ListT m) where
  throwError :: forall a. e -> ListT m a
throwError = forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. ListT m a -> (e -> ListT m a) -> ListT m a
catchError ListT m a
m e -> ListT m a
handler = forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
m) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> ListT m a
handler

instance (MonadReader e m) => MonadReader e (ListT m) where
  ask :: ListT m e
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  reader :: forall a. (e -> a) -> ListT m a
reader = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
  local :: forall a. (e -> e) -> ListT m a -> ListT m a
local e -> e
r = ListT m a -> ListT m a
go
    where
      go :: ListT m a -> ListT m a
go (ListT m (Maybe (a, ListT m a))
m) = forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
r (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a, b) -> (a, c)
secondPair' ListT m a -> ListT m a
go)) m (Maybe (a, ListT m a))
m)

instance (MonadState e m) => MonadState e (ListT m) where
  get :: ListT m e
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: e -> ListT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (e -> (a, e)) -> ListT m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance (Monad m) => MonadLogic (ListT m) where
  msplit :: forall a. ListT m a -> ListT m (Maybe (a, ListT m a))
msplit (ListT m (Maybe (a, ListT m a))
m) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe (a, ListT m a))
m

  interleave :: forall a. ListT m a -> ListT m a -> ListT m a
interleave ListT m a
m1 ListT m a
m2 =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
m1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
m2
        Just (a
a, ListT m a
m1') -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons a
a (forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
interleave ListT m a
m2 ListT m a
m1')

  ListT m a
m >>- :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
>>- a -> ListT m b
f =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall (f :: * -> *) a. Alternative f => f a
empty
        Just (a
a, ListT m a
m') -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
interleave (a -> ListT m b
f a
a) (ListT m a
m' forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- a -> ListT m b
f)

  ifte :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b -> ListT m b
ifte ListT m a
t a -> ListT m b
th ListT m b
el =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m b
el
        Just (a
a, ListT m a
m) -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall a b. (a -> b) -> a -> b
$ a -> ListT m b
th a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ListT m b
th)

  once :: forall a. ListT m a -> ListT m a
once (ListT m (Maybe (a, ListT m a))
m) =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      m (Maybe (a, ListT m a))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall (f :: * -> *) a. Alternative f => f a
empty
        Just (a
a, ListT m a
_) -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons (forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

  lnot :: forall a. ListT m a -> ListT m ()
lnot (ListT m (Maybe (a, ListT m a))
m) =
    forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
      m (Maybe (a, ListT m a))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        Just (a, ListT m a)
_ -> forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall (f :: * -> *) a. Alternative f => f a
empty

instance (MonadZip m) => MonadZip (ListT m) where
  mzipWith :: forall a b c. (a -> b -> c) -> ListT m a -> ListT m b -> ListT m c
mzipWith a -> b -> c
f = ListT m a -> ListT m b -> ListT m c
go
    where
      go :: ListT m a -> ListT m b -> ListT m c
go (ListT m (Maybe (a, ListT m a))
m1) (ListT m (Maybe (b, ListT m b))
m2) =
        forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith
            ( forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith forall a b. (a -> b) -> a -> b
$
                \(a
a, ListT m a
as) (b
b, ListT m b
bs) -> (a -> b -> c
f a
a b
b, ListT m a -> ListT m b -> ListT m c
go ListT m a
as ListT m b
bs)
            )
            m (Maybe (a, ListT m a))
m1
            m (Maybe (b, ListT m b))
m2

  munzip :: forall a b. ListT m (a, b) -> (ListT m a, ListT m b)
munzip (ListT m (Maybe ((a, b), ListT m (a, b)))
m)
    | (m (Maybe (a, ListT m a))
l, m (Maybe (b, ListT m b))
r) <- forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {m :: * -> *} {a} {a} {a} {b}.
MonadZip m =>
Maybe ((a, a), m (a, b)) -> (Maybe (a, m a), Maybe (a, m b))
go m (Maybe ((a, b), ListT m (a, b)))
m) =
        (forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT m (Maybe (a, ListT m a))
l, forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT m (Maybe (b, ListT m b))
r)
    where
      go :: Maybe ((a, a), m (a, b)) -> (Maybe (a, m a), Maybe (a, m b))
go Maybe ((a, a), m (a, b))
Nothing = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
      go (Just ((a
a, a
b), m (a, b)
listab)) =
        (forall a. a -> Maybe a
Just (a
a, m a
la), forall a. a -> Maybe a
Just (a
b, m b
lb))
        where
          -- If the underlying munzip is careful not to leak memory, then we
          -- don't want to defeat it.  We need to be sure that la and lb are
          -- realized as selector thunks.
          {-# NOINLINE remains #-}
          {-# NOINLINE la #-}
          {-# NOINLINE lb #-}
          remains :: (m a, m b)
remains = forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip m (a, b)
listab
          (m a
la, m b
lb) = (m a, m b)
remains

-- * Execution in the inner monad

-------------------------

-- |
-- Execute in the inner monad,
-- getting the head and the tail.
-- Returns nothing if it's empty.
uncons :: ListT m a -> m (Maybe (a, ListT m a))
uncons :: forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons (ListT m (Maybe (a, ListT m a))
m) =
  m (Maybe (a, ListT m a))
m

-- |
-- Execute, getting the head. Returns nothing if it's empty.
{-# INLINEABLE head #-}
head :: (Monad m) => ListT m a -> m (Maybe a)
head :: forall (m :: * -> *) a. Monad m => ListT m a -> m (Maybe a)
head =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons

-- |
-- Execute, getting the tail. Returns nothing if it's empty.
{-# INLINEABLE tail #-}
tail :: (Monad m) => ListT m a -> m (Maybe (ListT m a))
tail :: forall (m :: * -> *) a.
Monad m =>
ListT m a -> m (Maybe (ListT m a))
tail =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons

-- |
-- Execute, checking whether it's empty.
{-# INLINEABLE null #-}
null :: (Monad m) => ListT m a -> m Bool
null :: forall (m :: * -> *) a. Monad m => ListT m a -> m Bool
null =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a b. a -> b -> a
const Bool
False)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons

-- |
-- Execute in the inner monad,
-- using its '(<|>)' function on each entry.
{-# INLINEABLE alternate #-}
alternate :: (Alternative m, Monad m) => ListT m a -> m a
alternate :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
ListT m a -> m a
alternate (ListT m (Maybe (a, ListT m a))
m) =
  m (Maybe (a, ListT m a))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (a, ListT m a)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty
    Just (a
a, ListT m a
as) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a.
(Alternative m, Monad m) =>
ListT m a -> m a
alternate ListT m a
as

-- |
-- Use a monad morphism to convert a 'ListT' to a similar
-- monad, such as '[]'.
--
-- A more efficient alternative to @'alternate' . 'hoist' f@.
{-# INLINEABLE alternateHoisting #-}
alternateHoisting :: (Monad n, Alternative n) => (forall a. m a -> n a) -> ListT m a -> n a
alternateHoisting :: forall (n :: * -> *) (m :: * -> *) a.
(Monad n, Alternative n) =>
(forall a. m a -> n a) -> ListT m a -> n a
alternateHoisting forall a. m a -> n a
f = ListT m a -> n a
go
  where
    go :: ListT m a -> n a
go (ListT m (Maybe (a, ListT m a))
m) =
      forall a. m a -> n a
f m (Maybe (a, ListT m a))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty
        Just (a
a, ListT m a
as) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ListT m a -> n a
go ListT m a
as

-- |
-- Execute, applying a strict left fold.
{-# INLINEABLE fold #-}
fold :: (Monad m) => (b -> a -> m b) -> b -> ListT m a -> m b
fold :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> b -> ListT m a -> m b
fold b -> a -> m b
step = b -> ListT m a -> m b
go
  where
    go :: b -> ListT m a -> m b
go !b
acc (ListT m (Maybe (a, ListT m a))
run) =
      m (Maybe (a, ListT m a))
run forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (a
element, ListT m a
next) -> do
          b
acc' <- b -> a -> m b
step b
acc a
element
          b -> ListT m a -> m b
go b
acc' ListT m a
next
        Maybe (a, ListT m a)
Nothing ->
          forall (m :: * -> *) a. Monad m => a -> m a
return b
acc

-- |
-- A version of 'fold', which allows early termination.
{-# INLINEABLE foldMaybe #-}
foldMaybe :: (Monad m) => (b -> a -> m (Maybe b)) -> b -> ListT m a -> m b
foldMaybe :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m (Maybe b)) -> b -> ListT m a -> m b
foldMaybe b -> a -> m (Maybe b)
s b
r ListT m a
l =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
r forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
      (a
h, ListT m a
t) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
l
      b
r' <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ b -> a -> m (Maybe b)
s b
r a
h
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m (Maybe b)) -> b -> ListT m a -> m b
foldMaybe b -> a -> m (Maybe b)
s b
r' ListT m a
t

-- |
-- Apply the left fold abstraction from the \"foldl\" package.
applyFoldM :: (Monad m) => FoldM m i o -> ListT m i -> m o
applyFoldM :: forall (m :: * -> *) i o.
Monad m =>
FoldM m i o -> ListT m i -> m o
applyFoldM (FoldM x -> i -> m x
step m x
init x -> m o
extract) ListT m i
lt = do
  x
a <- m x
init
  x
b <- forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> b -> ListT m a -> m b
fold x -> i -> m x
step x
a ListT m i
lt
  x -> m o
extract x
b

-- |
-- Execute, folding to a list.
{-# INLINEABLE toList #-}
toList :: (Monad m) => ListT m a -> m [a]
toList :: forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
toList =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
toReverseList

-- |
-- Execute, folding to a list in the reverse order.
-- Performs more efficiently than 'toList'.
{-# INLINEABLE toReverseList #-}
toReverseList :: (Monad m) => ListT m a -> m [a]
toReverseList :: forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
toReverseList =
  forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> b -> ListT m a -> m b
fold (\[a]
list a
element -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
element forall a. a -> [a] -> [a]
: [a]
list)) []

-- |
-- Execute, traversing the stream with a side effect in the inner monad.
{-# INLINEABLE traverse_ #-}
traverse_ :: (Monad m) => (a -> m ()) -> ListT m a -> m ()
traverse_ :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> ListT m a -> m ()
traverse_ a -> m ()
f =
  forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> b -> ListT m a -> m b
fold (forall a b. a -> b -> a
const a -> m ()
f) ()

-- |
-- Execute, consuming a list of the specified length and returning the remainder stream.
{-# INLINEABLE splitAt #-}
splitAt :: (Monad m) => Int -> ListT m a -> m ([a], ListT m a)
splitAt :: forall (m :: * -> *) a.
Monad m =>
Int -> ListT m a -> m ([a], ListT m a)
splitAt =
  \case
    Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> \ListT m a
l ->
      forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall (m :: * -> *) a. MonadPlus m => m a
mzero)
        Just (a
h, ListT m a
t) -> do
          ([a]
r1, ListT m a
r2) <- forall (m :: * -> *) a.
Monad m =>
Int -> ListT m a -> m ([a], ListT m a)
splitAt (forall a. Enum a => a -> a
pred Int
n) ListT m a
t
          forall (m :: * -> *) a. Monad m => a -> m a
return (a
h forall a. a -> [a] -> [a]
: [a]
r1, ListT m a
r2)
    Int
_ -> \ListT m a
l ->
      forall (m :: * -> *) a. Monad m => a -> m a
return ([], ListT m a
l)

-- * Construction

-------------------------

-- |
-- Prepend an element.
cons :: (Monad m) => a -> ListT m a -> ListT m a
cons :: forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons a
h ListT m a
t =
  forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
h, ListT m a
t))

-- |
-- Construct from any foldable.
{-# INLINEABLE fromFoldable #-}
fromFoldable :: (Monad m, Foldable f) => f a -> ListT m a
fromFoldable :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
fromFoldable =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- |
-- Construct from an MVar, interpreting the value of Nothing as the end.
fromMVar :: (MonadIO m) => MVar (Maybe a) -> ListT m a
fromMVar :: forall (m :: * -> *) a. MonadIO m => MVar (Maybe a) -> ListT m a
fromMVar MVar (Maybe a)
v =
  forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \ListT m a
loop -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. MVar a -> IO a
takeMVar MVar (Maybe a)
v) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons ListT m a
loop)

-- |
-- Construct by unfolding a pure data structure.
{-# INLINEABLE unfold #-}
unfold :: (Monad m) => (b -> Maybe (a, b)) -> b -> ListT m a
unfold :: forall (m :: * -> *) b a.
Monad m =>
(b -> Maybe (a, b)) -> b -> ListT m a
unfold b -> Maybe (a, b)
f b
s =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero (\(a
h, b
t) -> forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons a
h (forall (m :: * -> *) b a.
Monad m =>
(b -> Maybe (a, b)) -> b -> ListT m a
unfold b -> Maybe (a, b)
f b
t)) (b -> Maybe (a, b)
f b
s)

-- |
-- Construct by unfolding a monadic data structure
--
-- This is the most memory-efficient way to construct ListT where
-- the length depends on the inner monad.
{-# INLINEABLE unfoldM #-}
unfoldM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> ListT m a
unfoldM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> ListT m a
unfoldM b -> m (Maybe (a, b))
f = b -> ListT m a
go
  where
    go :: b -> ListT m a
go b
s =
      forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
        b -> m (Maybe (a, b))
f b
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, b)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          Just (a
a, b
r) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
a, b -> ListT m a
go b
r))

-- |
-- Produce an infinite stream.
{-# INLINEABLE repeat #-}
repeat :: (Monad m) => a -> ListT m a
repeat :: forall (m :: * -> *) a. Monad m => a -> ListT m a
repeat =
  forall a. (a -> a) -> a
fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons

-- * Transformation

-------------------------

-- |
-- A transformation,
-- which traverses the stream with an action in the inner monad.
{-# INLINEABLE traverse #-}
traverse :: (Monad m) => (a -> m b) -> ListT m a -> ListT m b
traverse :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ListT m a -> ListT m b
traverse a -> m b
f =
  ListT m a -> ListT m b
go
  where
    go :: ListT m a -> ListT m b
go (ListT m (Maybe (a, ListT m a))
run) =
      forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$
        m (Maybe (a, ListT m a))
run forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, ListT m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          Just (a
a, ListT m a
next) -> a -> m b
f a
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \b
b -> forall a. a -> Maybe a
Just (b
b, ListT m a -> ListT m b
go ListT m a
next)

-- |
-- A transformation,
-- reproducing the behaviour of @Data.List.'Data.List.take'@.
{-# INLINEABLE take #-}
take :: (Monad m) => Int -> ListT m a -> ListT m a
take :: forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
take =
  \case
    Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> \ListT m a
t ->
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons ListT m a
t)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, ListT m a)
Nothing -> ListT m a
t
          Just (a
h, ListT m a
t) -> forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons a
h (forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
take (forall a. Enum a => a -> a
pred Int
n) ListT m a
t)
    Int
_ ->
      forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- |
-- A transformation,
-- reproducing the behaviour of @Data.List.'Data.List.drop'@.
{-# INLINEABLE drop #-}
drop :: (Monad m) => Int -> ListT m a -> ListT m a
drop :: forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
drop =
  \case
    Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 ->
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
uncons forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero (forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
drop (forall a. Enum a => a -> a
pred Int
n) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> b
snd)
    Int
_ ->
      forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- |
-- A transformation,
-- which slices a list into chunks of the specified length.
{-# INLINEABLE slice #-}
slice :: (Monad m) => Int -> ListT m a -> ListT m [a]
slice :: forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m [a]
slice Int
n ListT m a
l =
  do
    ([a]
h, ListT m a
t) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> ListT m a -> m ([a], ListT m a)
splitAt Int
n ListT m a
l
    case [a]
h of
      [] -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      [a]
_ -> forall (m :: * -> *) a. Monad m => a -> ListT m a -> ListT m a
cons [a]
h (forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m [a]
slice Int
n ListT m a
t)