module Control.Monad.Trans.List.Church where

import Control.Applicative
import Control.Monad.Base
import Control.Monad.Trans
import qualified Control.Monad.Catch as C
import qualified Control.Monad.Fail as Fail

import Control.Effect.Carrier

import Control.Effect.Type.ListenPrim
import Control.Effect.Type.WriterPrim
import Control.Effect.Type.Regional
import Control.Effect.Type.Optional
import Control.Effect.Type.Unravel
import Control.Effect.Type.ReaderPrim

newtype ListT m a = ListT {
  ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT :: forall r
             . (forall x. m x -> (x -> r) -> r)
            -> (a -> r -> r)
            -> r -- lose
            -> r -- cutfail
            -> r
  }

cons :: a -> ListT m a -> ListT m a
cons :: a -> ListT m a -> ListT m a
cons a
a ListT m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t -> a -> r -> r
c a
a (ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t)

instance ThreadsEff ListT (Regional s) where
  threadEff :: (forall x. Regional s m x -> m x)
-> Regional s (ListT m) a -> ListT m a
threadEff forall x. Regional s m x -> m x
alg (Regionally s
s ListT m a
m) = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m (m x -> (x -> r) -> r
forall x. m x -> (x -> r) -> r
bind (m x -> (x -> r) -> r) -> (m x -> m x) -> m x -> (x -> r) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regional s m x -> m x
forall x. Regional s m x -> m x
alg (Regional s m x -> m x) -> (m x -> Regional s m x) -> m x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m x -> Regional s m x
forall k s (m :: k -> *) (a :: k). s -> m a -> Regional s m a
Regionally s
s)
  {-# INLINE threadEff #-}

instance Functor s => ThreadsEff ListT (Optional s) where
  threadEff :: (forall x. Optional s m x -> m x)
-> Optional s (ListT m) a -> ListT m a
threadEff forall x. Optional s m x -> m x
alg (Optionally s a
s ListT m a
m) = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m (\m x
mx x -> r
cn ->
      (m r -> (r -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` r -> r
forall a. a -> a
id) (m r -> r) -> m r -> r
forall a b. (a -> b) -> a -> b
$ Optional s m r -> m r
forall x. Optional s m x -> m x
alg (Optional s m r -> m r) -> Optional s m r -> m r
forall a b. (a -> b) -> a -> b
$
        (a -> r) -> s a -> s r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> r -> r
`c` r
b) s a
s
      s r -> m r -> Optional s m r
forall k (s :: k -> *) (a :: k) (m :: k -> *).
s a -> m a -> Optional s m a
`Optionally`
        (x -> r) -> m x -> m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
cn m x
mx
      ) a -> r -> r
c r
b
  {-# INLINE threadEff #-}

instance ThreadsEff ListT (Unravel p) where
  threadEff :: (forall x. Unravel p m x -> m x)
-> Unravel p (ListT m) a -> ListT m a
threadEff forall x. Unravel p m x -> m x
alg (Unravel p a
p ListT m a -> a
cataM ListT m a
main) =
    ListT m a
-> (forall x. m x -> (x -> ListT m a) -> ListT m a)
-> (a -> ListT m a -> ListT m a)
-> ListT m a
-> ListT m a
-> ListT m a
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT
      ListT m a
main
      (\m x
mx x -> ListT m a
cn -> m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> m a -> ListT m a
forall a b. (a -> b) -> a -> b
$ Unravel p m a -> m a
forall x. Unravel p m x -> m x
alg (Unravel p m a -> m a) -> Unravel p m a -> m a
forall a b. (a -> b) -> a -> b
$
        p a -> (m a -> a) -> m a -> Unravel p m a
forall (p :: * -> *) a (m :: * -> *).
p a -> (m a -> a) -> m a -> Unravel p m a
Unravel p a
p (ListT m a -> a
cataM (ListT m a -> a) -> (m a -> ListT m a) -> m a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ((x -> a) -> m x -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListT m a -> a
cataM (ListT m a -> a) -> (x -> ListT m a) -> x -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ListT m a
cn) m x
mx)
      )
      a -> ListT m a -> ListT m a
forall a (m :: * -> *). a -> ListT m a -> ListT m a
cons
      ListT m a
forall (m :: * -> *) a. ListT m a
lose
      ListT m a
forall (m :: * -> *) a. ListT m a
cutfail
  {-# INLINE threadEff #-}

instance Monoid s => ThreadsEff ListT (ListenPrim s) where
  threadEff :: (forall x. ListenPrim s m x -> m x)
-> ListenPrim s (ListT m) a -> ListT m a
threadEff = (forall x.
 (forall x. ListenPrim s m x -> m x) -> ListT m x -> ListT m (s, x))
-> (forall x. ListenPrim s m x -> m x)
-> ListenPrim s (ListT m) a
-> ListT m a
forall w (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(forall x.
 (forall y. ListenPrim w m y -> m y) -> t m x -> t m (w, x))
-> (forall y. ListenPrim w m y -> m y)
-> ListenPrim w (t m) a
-> t m a
threadListenPrim ((forall x.
  (forall x. ListenPrim s m x -> m x) -> ListT m x -> ListT m (s, x))
 -> (forall x. ListenPrim s m x -> m x)
 -> ListenPrim s (ListT m) a
 -> ListT m a)
-> (forall x.
    (forall x. ListenPrim s m x -> m x) -> ListT m x -> ListT m (s, x))
-> (forall x. ListenPrim s m x -> m x)
-> ListenPrim s (ListT m) a
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. ListenPrim s m x -> m x
alg ListT m x
main -> (forall r.
 (forall x. m x -> (x -> r) -> r)
 -> ((s, x) -> r -> r) -> r -> r -> r)
-> ListT m (s, x)
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> ((s, x) -> r -> r) -> r -> r -> r)
 -> ListT m (s, x))
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> ((s, x) -> r -> r) -> r -> r -> r)
-> ListT m (s, x)
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind (s, x) -> r -> r
c r
b r
t ->
    ListT m x
-> (forall x. m x -> (x -> s -> r) -> s -> r)
-> (x -> (s -> r) -> s -> r)
-> (s -> r)
-> (s -> r)
-> s
-> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT
      ListT m x
main
      (\m x
mx x -> s -> r
cn s
acc -> ListenPrim s m (s, x) -> m (s, x)
forall x. ListenPrim s m x -> m x
alg (m x -> ListenPrim s m (s, x)
forall (m :: * -> *) a w. m a -> ListenPrim w m (w, a)
ListenPrimListen m x
mx) m (s, x) -> ((s, x) -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` \(s
s, x
a) ->
          let
            !acc' :: s
acc' = s
acc s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
s
          in
            x -> s -> r
cn x
a s
acc'
      )
      (\x
a s -> r
r s
acc -> (s, x) -> r -> r
c (s
acc, x
a) (s -> r
r s
forall a. Monoid a => a
mempty))
      (r -> s -> r
forall a b. a -> b -> a
const r
b)
      (r -> s -> r
forall a b. a -> b -> a
const r
t)
      s
forall a. Monoid a => a
mempty
  {-# INLINE threadEff #-}

instance Monoid s => ThreadsEff ListT (WriterPrim s) where
  threadEff :: (forall x. WriterPrim s m x -> m x)
-> WriterPrim s (ListT m) a -> ListT m a
threadEff = ((forall x. WriterPrim s m x -> m x)
 -> ListT m (s -> s, a) -> ListT m a)
-> (forall x. WriterPrim s m x -> m x)
-> WriterPrim s (ListT m) a
-> ListT m a
forall w (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, ThreadsEff t (ListenPrim w), Monad m) =>
((forall x. WriterPrim w m x -> m x) -> t m (w -> w, a) -> t m a)
-> (forall x. WriterPrim w m x -> m x)
-> WriterPrim w (t m) a
-> t m a
threadWriterPrim (((forall x. WriterPrim s m x -> m x)
  -> ListT m (s -> s, a) -> ListT m a)
 -> (forall x. WriterPrim s m x -> m x)
 -> WriterPrim s (ListT m) a
 -> ListT m a)
-> ((forall x. WriterPrim s m x -> m x)
    -> ListT m (s -> s, a) -> ListT m a)
-> (forall x. WriterPrim s m x -> m x)
-> WriterPrim s (ListT m) a
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. WriterPrim s m x -> m x
alg ListT m (s -> s, a)
main ->
    let
      go' :: m (LayeredListT m (s -> s, a)) -> m (s -> s, LayeredListT m a)
go' m (LayeredListT m (s -> s, a))
m = m (LayeredListT m (s -> s, a))
m m (LayeredListT m (s -> s, a))
-> (LayeredListT m (s -> s, a) -> m (s -> s, LayeredListT m a))
-> m (s -> s, LayeredListT m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        LayeredListT m (s -> s, a)
Empty         -> (s -> s, LayeredListT m a) -> m (s -> s, LayeredListT m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s
forall a. a -> a
id, LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
Empty)
        LayeredListT m (s -> s, a)
CutFail       -> (s -> s, LayeredListT m a) -> m (s -> s, LayeredListT m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s
forall a. a -> a
id, LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
CutFail)
        Cons (s -> s
f, a
a) LayeredListT m (s -> s, a)
r -> (s -> s, LayeredListT m a) -> m (s -> s, LayeredListT m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s
f, a -> LayeredListT m a -> LayeredListT m a
forall a (m :: * -> *). a -> LayeredListT m a -> LayeredListT m a
Cons a
a (LayeredListT m (s -> s, a) -> LayeredListT m a
go LayeredListT m (s -> s, a)
r))
        Embed m x
mx x -> LayeredListT m (s -> s, a)
cn   -> m (LayeredListT m (s -> s, a)) -> m (s -> s, LayeredListT m a)
go' ((x -> LayeredListT m (s -> s, a))
-> m x -> m (LayeredListT m (s -> s, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> LayeredListT m (s -> s, a)
cn m x
mx)

      go :: LayeredListT m (s -> s, a) -> LayeredListT m a
go LayeredListT m (s -> s, a)
Empty = LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
Empty
      go LayeredListT m (s -> s, a)
CutFail = LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
CutFail
      go (Cons (s -> s
_, a
a) LayeredListT m (s -> s, a)
r) = a -> LayeredListT m a -> LayeredListT m a
forall a (m :: * -> *). a -> LayeredListT m a -> LayeredListT m a
Cons a
a (LayeredListT m (s -> s, a) -> LayeredListT m a
go LayeredListT m (s -> s, a)
r)
      go (Embed m x
mx x -> LayeredListT m (s -> s, a)
cn) = (m (LayeredListT m a)
-> (LayeredListT m a -> LayeredListT m a) -> LayeredListT m a
forall (m :: * -> *) x a.
m x -> (x -> LayeredListT m a) -> LayeredListT m a
`Embed` LayeredListT m a -> LayeredListT m a
forall a. a -> a
id) (m (LayeredListT m a) -> LayeredListT m a)
-> m (LayeredListT m a) -> LayeredListT m a
forall a b. (a -> b) -> a -> b
$ WriterPrim s m (LayeredListT m a) -> m (LayeredListT m a)
forall x. WriterPrim s m x -> m x
alg (WriterPrim s m (LayeredListT m a) -> m (LayeredListT m a))
-> WriterPrim s m (LayeredListT m a) -> m (LayeredListT m a)
forall a b. (a -> b) -> a -> b
$ m (s -> s, LayeredListT m a) -> WriterPrim s m (LayeredListT m a)
forall (m :: * -> *) w a. m (w -> w, a) -> WriterPrim w m a
WriterPrimPass (m (s -> s, LayeredListT m a) -> WriterPrim s m (LayeredListT m a))
-> m (s -> s, LayeredListT m a)
-> WriterPrim s m (LayeredListT m a)
forall a b. (a -> b) -> a -> b
$ m (LayeredListT m (s -> s, a)) -> m (s -> s, LayeredListT m a)
go' ((x -> LayeredListT m (s -> s, a))
-> m x -> m (LayeredListT m (s -> s, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> LayeredListT m (s -> s, a)
cn m x
mx)
    in
      LayeredListT m a -> ListT m a
forall (m :: * -> *) a. LayeredListT m a -> ListT m a
fromLayeredListT (LayeredListT m (s -> s, a) -> LayeredListT m a
go (ListT m (s -> s, a) -> LayeredListT m (s -> s, a)
forall (m :: * -> *) a. ListT m a -> LayeredListT m a
toLayeredListT ListT m (s -> s, a)
main))
  {-# INLINE threadEff #-}

instance ThreadsEff ListT (ReaderPrim i) where
  threadEff :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (ListT m) a -> ListT m a
threadEff = (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (ListT m) a -> ListT m a
forall i (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(Monad m, MonadTrans t, ThreadsEff t (Regional ())) =>
(forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaRegional
  {-# INLINE threadEff #-}

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

instance Fail.MonadFail m => Fail.MonadFail (ListT m) where
  fail :: String -> ListT m a
fail = m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> (String -> m a) -> String -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
  {-# INLINE fail #-}

instance MonadThrow m => MonadThrow (ListT m) where
  throwM :: e -> ListT m a
throwM = m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> (e -> m a) -> e -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM
  {-# INLINE throwM #-}

instance MonadCatch m => MonadCatch (ListT m) where
  catch :: ListT m a -> (e -> ListT m a) -> ListT m a
catch ListT m a
m e -> ListT m a
h = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT
      ListT m a
m
      (\m x
mx x -> r
cn -> (m r -> (r -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` r -> r
forall a. a -> a
id) (m r -> r) -> m r -> r
forall a b. (a -> b) -> a -> b
$
        (x -> r) -> m x -> m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
cn m x
mx m r -> (e -> m r) -> m r
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` \e
e -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> m r) -> r -> m r
forall a b. (a -> b) -> a -> b
$ ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT (e -> ListT m a
h e
e) forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t
      )
      a -> r -> r
c r
b r
t
  {-# INLINE catch #-}

cull :: ListT m a -> ListT m a
cull :: ListT m a -> ListT m a
cull ListT m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t -> ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> r) -> r
bind (\a
a r
_ -> a -> r -> r
c a
a r
b) r
b r
t

choose :: ListT m a -> ListT m a -> ListT m a
choose :: ListT m a -> ListT m a -> ListT m a
choose ListT m a
ma ListT m a
mb = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t -> ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
ma forall x. m x -> (x -> r) -> r
bind a -> r -> r
c (ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
mb forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t) r
t

lose :: ListT m a
lose :: ListT m a
lose = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
_ a -> r -> r
_ r
b r
_ -> r
b

cutfail :: ListT m a
cutfail :: ListT m a
cutfail = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
_ a -> r -> r
_ r
_ r
t -> r
t

call :: ListT m a -> ListT m a
call :: ListT m a -> ListT m a
call ListT m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
_ -> ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
b

data LayeredListT m a where
  Embed   :: m x -> (x -> LayeredListT m a) -> LayeredListT m a
  Empty   :: LayeredListT m a
  CutFail :: LayeredListT m a
  Cons    :: a -> LayeredListT m a -> LayeredListT m a

toLayeredListT :: ListT m a -> LayeredListT m a
toLayeredListT :: ListT m a -> LayeredListT m a
toLayeredListT ListT m a
m = ListT m a
-> (forall x. m x -> (x -> LayeredListT m a) -> LayeredListT m a)
-> (a -> LayeredListT m a -> LayeredListT m a)
-> LayeredListT m a
-> LayeredListT m a
-> LayeredListT m a
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> LayeredListT m a) -> LayeredListT m a
forall (m :: * -> *) x a.
m x -> (x -> LayeredListT m a) -> LayeredListT m a
Embed a -> LayeredListT m a -> LayeredListT m a
forall a (m :: * -> *). a -> LayeredListT m a -> LayeredListT m a
Cons LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
Empty LayeredListT m a
forall (m :: * -> *) a. LayeredListT m a
CutFail

split' :: LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
split' :: LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
split' (Embed m x
mx x -> LayeredListT m a
cn) = m x
-> (x -> LayeredListT m (Maybe (a, LayeredListT m a)))
-> LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) x a.
m x -> (x -> LayeredListT m a) -> LayeredListT m a
Embed m x
mx (LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a.
LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
split' (LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a)))
-> (x -> LayeredListT m a)
-> x
-> LayeredListT m (Maybe (a, LayeredListT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> LayeredListT m a
cn)
split' LayeredListT m a
Empty         = Maybe (a, LayeredListT m a)
-> LayeredListT m (Maybe (a, LayeredListT m a))
-> LayeredListT m (Maybe (a, LayeredListT m a))
forall a (m :: * -> *). a -> LayeredListT m a -> LayeredListT m a
Cons Maybe (a, LayeredListT m a)
forall a. Maybe a
Nothing LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a. LayeredListT m a
Empty
split' LayeredListT m a
CutFail       = LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a. LayeredListT m a
CutFail
split' (Cons a
a LayeredListT m a
r)    = Maybe (a, LayeredListT m a)
-> LayeredListT m (Maybe (a, LayeredListT m a))
-> LayeredListT m (Maybe (a, LayeredListT m a))
forall a (m :: * -> *). a -> LayeredListT m a -> LayeredListT m a
Cons ((a, LayeredListT m a) -> Maybe (a, LayeredListT m a)
forall a. a -> Maybe a
Just (a
a, LayeredListT m a
r)) LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a. LayeredListT m a
Empty

fromLayeredListT :: LayeredListT m a -> ListT m a
fromLayeredListT :: LayeredListT m a -> ListT m a
fromLayeredListT LayeredListT m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
t ->
  let
    go :: LayeredListT m a -> r
go (Embed m x
mx x -> LayeredListT m a
cn) = m x
mx m x -> (x -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` (LayeredListT m a -> r
go (LayeredListT m a -> r) -> (x -> LayeredListT m a) -> x -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> LayeredListT m a
cn)
    go LayeredListT m a
Empty = r
b
    go LayeredListT m a
CutFail = r
t
    go (Cons a
a LayeredListT m a
r) = a -> r -> r
c a
a (LayeredListT m a -> r
go LayeredListT m a
r)
  in
    LayeredListT m a -> r
go LayeredListT m a
m

-- split cutfail === cutfail
-- If you don't want that behaviour, instead of @split m@, do @split (call m)@
split :: ListT m a -> ListT m (Maybe (a, ListT m a))
split :: ListT m a -> ListT m (Maybe (a, ListT m a))
split =
   ((Maybe (a, LayeredListT m a) -> Maybe (a, ListT m a))
-> ListT m (Maybe (a, LayeredListT m a))
-> ListT m (Maybe (a, ListT m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (a, LayeredListT m a) -> Maybe (a, ListT m a))
 -> ListT m (Maybe (a, LayeredListT m a))
 -> ListT m (Maybe (a, ListT m a)))
-> ((LayeredListT m a -> ListT m a)
    -> Maybe (a, LayeredListT m a) -> Maybe (a, ListT m a))
-> (LayeredListT m a -> ListT m a)
-> ListT m (Maybe (a, LayeredListT m a))
-> ListT m (Maybe (a, ListT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, LayeredListT m a) -> (a, ListT m a))
-> Maybe (a, LayeredListT m a) -> Maybe (a, ListT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, LayeredListT m a) -> (a, ListT m a))
 -> Maybe (a, LayeredListT m a) -> Maybe (a, ListT m a))
-> ((LayeredListT m a -> ListT m a)
    -> (a, LayeredListT m a) -> (a, ListT m a))
-> (LayeredListT m a -> ListT m a)
-> Maybe (a, LayeredListT m a)
-> Maybe (a, ListT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayeredListT m a -> ListT m a)
-> (a, LayeredListT m a) -> (a, ListT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) LayeredListT m a -> ListT m a
forall (m :: * -> *) a. LayeredListT m a -> ListT m a
fromLayeredListT
  (ListT m (Maybe (a, LayeredListT m a))
 -> ListT m (Maybe (a, ListT m a)))
-> (ListT m a -> ListT m (Maybe (a, LayeredListT m a)))
-> ListT m a
-> ListT m (Maybe (a, ListT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayeredListT m (Maybe (a, LayeredListT m a))
-> ListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a. LayeredListT m a -> ListT m a
fromLayeredListT
  (LayeredListT m (Maybe (a, LayeredListT m a))
 -> ListT m (Maybe (a, LayeredListT m a)))
-> (ListT m a -> LayeredListT m (Maybe (a, LayeredListT m a)))
-> ListT m a
-> ListT m (Maybe (a, LayeredListT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
forall (m :: * -> *) a.
LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a))
split'
  (LayeredListT m a -> LayeredListT m (Maybe (a, LayeredListT m a)))
-> (ListT m a -> LayeredListT m a)
-> ListT m a
-> LayeredListT m (Maybe (a, LayeredListT m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m a -> LayeredListT m a
forall (m :: * -> *) a. ListT m a -> LayeredListT m a
toLayeredListT
{-# INLINE split #-}

instance Functor (ListT m) where
  fmap :: (a -> b) -> ListT m a -> ListT m b
fmap a -> b
f ListT m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
-> ListT m b
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
 -> ListT m b)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
-> ListT m b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind b -> r -> r
c r
b r
t ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> r) -> r
bind (b -> r -> r
c (b -> r -> r) -> (a -> b) -> a -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) r
b r
t
  {-# INLINE fmap #-}

instance Applicative (ListT m) where
  pure :: a -> ListT m a
pure a
a = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
_ a -> r -> r
c r
b r
_ -> a -> r -> r
c a
a r
b
  liftA2 :: (a -> b -> c) -> ListT m a -> ListT m b -> ListT m c
liftA2 a -> b -> c
f ListT m a
fa ListT m b
fb = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (c -> r -> r) -> r -> r -> r)
-> ListT m c
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (c -> r -> r) -> r -> r -> r)
 -> ListT m c)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (c -> r -> r) -> r -> r -> r)
-> ListT m c
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind c -> r -> r
c r
b r
t ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
fa forall x. m x -> (x -> r) -> r
bind (\a
a r
r -> ListT m b
-> (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m b
fb forall x. m x -> (x -> r) -> r
bind (c -> r -> r
c (c -> r -> r) -> (b -> c) -> b -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f a
a) r
r r
t) r
b r
t
  {-# INLINE liftA2 #-}

  ListT m a
ma *> :: ListT m a -> ListT m b -> ListT m b
*> ListT m b
mb = ListT m a
ma ListT m a -> (a -> ListT m b) -> ListT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> ListT m b
mb
  {-# INLINE (*>) #-}

instance Monad (ListT m) where
  ListT m a
m >>= :: ListT m a -> (a -> ListT m b) -> ListT m b
>>= a -> ListT m b
f = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
-> ListT m b
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
 -> ListT m b)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r)
-> ListT m b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind b -> r -> r
c r
b r
t ->
    ListT m a
-> (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> r) -> r
bind (\a
a r
r -> ListT m b
-> (forall x. m x -> (x -> r) -> r) -> (b -> r -> r) -> r -> r -> r
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT (a -> ListT m b
f a
a) forall x. m x -> (x -> r) -> r
bind b -> r -> r
c r
r r
t) r
b r
t
  {-# INLINE (>>=) #-}

instance MonadTrans ListT where
  lift :: m a -> ListT m a
lift m a
m = (forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
ListT ((forall r.
  (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
 -> ListT m a)
-> (forall r.
    (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r)
-> ListT m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind a -> r -> r
c r
b r
_ -> m a
m m a -> (a -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` (a -> r -> r
`c` r
b)
  {-# INLINE lift #-}

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

runListT :: (Alternative f, Monad m)
         => ListT m a
         -> m (f a)
runListT :: ListT m a -> m (f a)
runListT ListT m a
m =
  ListT m a
-> (forall x. m x -> (x -> m (f a)) -> m (f a))
-> (a -> m (f a) -> m (f a))
-> m (f a)
-> m (f a)
-> m (f a)
forall (m :: * -> *) a.
ListT m a
-> forall r.
   (forall x. m x -> (x -> r) -> r) -> (a -> r -> r) -> r -> r -> r
unListT ListT m a
m forall x. m x -> (x -> m (f a)) -> m (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ((f a -> f a) -> m (f a) -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f a) -> m (f a) -> m (f a))
-> (a -> f a -> f a) -> a -> m (f a) -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (f a -> f a -> f a) -> (a -> f a) -> a -> f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty) (f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty)
{-# INLINE runListT #-}