-- | The applicative list transformer
module Control.Applicative.Trans.List where

-- base
import Control.Applicative (Alternative)
import Data.Functor.Compose

{- | The 'Applicative' list transformer.

This is isomorphic to the "old" @ListT@ transformer.
It is not a monad, but a lawful 'Applicative'.
-}
newtype ListT f a = ListT {forall (f :: * -> *) a. ListT f a -> f [a]
runListT :: f [a]}
  deriving (forall a b. a -> ListT f b -> ListT f a
forall a b. (a -> b) -> ListT f a -> ListT f b
forall (f :: * -> *) a b. Functor f => a -> ListT f b -> ListT f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ListT f a -> ListT f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ListT f b -> ListT f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> ListT f b -> ListT f a
fmap :: forall a b. (a -> b) -> ListT f a -> ListT f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ListT f a -> ListT f b
Functor)
  deriving
    (forall a. a -> ListT f a
forall a b. ListT f a -> ListT f b -> ListT f a
forall a b. ListT f a -> ListT f b -> ListT f b
forall a b. ListT f (a -> b) -> ListT f a -> ListT f b
forall a b c. (a -> b -> c) -> ListT f a -> ListT f b -> ListT f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {f :: * -> *}. Applicative f => Functor (ListT f)
forall (f :: * -> *) a. Applicative f => a -> ListT f a
forall (f :: * -> *) a b.
Applicative f =>
ListT f a -> ListT f b -> ListT f a
forall (f :: * -> *) a b.
Applicative f =>
ListT f a -> ListT f b -> ListT f b
forall (f :: * -> *) a b.
Applicative f =>
ListT f (a -> b) -> ListT f a -> ListT f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ListT f a -> ListT f b -> ListT f c
<* :: forall a b. ListT f a -> ListT f b -> ListT f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
ListT f a -> ListT f b -> ListT f a
*> :: forall a b. ListT f a -> ListT f b -> ListT f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
ListT f a -> ListT f b -> ListT f b
liftA2 :: forall a b c. (a -> b -> c) -> ListT f a -> ListT f b -> ListT f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ListT f a -> ListT f b -> ListT f c
<*> :: forall a b. ListT f (a -> b) -> ListT f a -> ListT f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
ListT f (a -> b) -> ListT f a -> ListT f b
pure :: forall a. a -> ListT f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> ListT f a
Applicative, forall a. ListT f a
forall a. ListT f a -> ListT f [a]
forall a. ListT f a -> ListT f a -> ListT f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {f :: * -> *}. Alternative f => Applicative (ListT f)
forall (f :: * -> *) a. Alternative f => ListT f a
forall (f :: * -> *) a. Alternative f => ListT f a -> ListT f [a]
forall (f :: * -> *) a.
Alternative f =>
ListT f a -> ListT f a -> ListT f a
many :: forall a. ListT f a -> ListT f [a]
$cmany :: forall (f :: * -> *) a. Alternative f => ListT f a -> ListT f [a]
some :: forall a. ListT f a -> ListT f [a]
$csome :: forall (f :: * -> *) a. Alternative f => ListT f a -> ListT f [a]
<|> :: forall a. ListT f a -> ListT f a -> ListT f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
ListT f a -> ListT f a -> ListT f a
empty :: forall a. ListT f a
$cempty :: forall (f :: * -> *) a. Alternative f => ListT f a
Alternative)
    via (Compose f [])