{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}
module Control.Monad.ListT (ListT(..)) where
import Data.List.Class (List(..), ListItem(..), foldrL)
import Control.Applicative (Alternative(..), Applicative(..))
import Control.Monad (MonadPlus(..), ap, liftM)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Monoid (Monoid(..))
newtype ListT m a =
ListT { forall (m :: * -> *) a. ListT m a -> m (ListItem (ListT m) a)
runListT :: m (ListItem (ListT m) a) }
deriving instance (Eq (m (ListItem (ListT m) a))) => Eq (ListT m a)
deriving instance (Ord (m (ListItem (ListT m) a))) => Ord (ListT m a)
deriving instance (Read (m (ListItem (ListT m) a))) => Read (ListT m a)
deriving instance (Show (m (ListItem (ListT m) a))) => Show (ListT m a)
foldrL' :: List l => (a -> l b -> l b) -> l b -> l a -> l b
foldrL' :: forall (l :: * -> *) a b.
List l =>
(a -> l b -> l b) -> l b -> l a -> l b
foldrL' a -> l b -> l b
consFunc l b
nilFunc =
ItemM l (l b) -> l b
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM l (l b) -> l b) -> (l a -> ItemM l (l b)) -> l a -> l b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ItemM l (l b) -> ItemM l (l b))
-> ItemM l (l b) -> l a -> ItemM l (l b)
forall (l :: * -> *) a b.
List l =>
(a -> ItemM l b -> ItemM l b) -> ItemM l b -> l a -> ItemM l b
foldrL a -> ItemM l (l b) -> ItemM l (l b)
step (l b -> ItemM l (l b)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return l b
nilFunc)
where
step :: a -> ItemM l (l b) -> ItemM l (l b)
step a
x = l b -> ItemM l (l b)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l b -> ItemM l (l b))
-> (ItemM l (l b) -> l b) -> ItemM l (l b) -> ItemM l (l b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> l b -> l b
consFunc a
x (l b -> l b) -> (ItemM l (l b) -> l b) -> ItemM l (l b) -> l b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemM l (l b) -> l b
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL
#if MIN_VERSION_base(4,9,0)
instance Monad m => Semigroup (ListT m a) where
<> :: ListT m a -> ListT m a -> ListT m a
(<>) = (ListT m a -> ListT m a -> ListT m a)
-> ListT m a -> ListT m a -> ListT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> ListT m a -> ListT m a)
-> ListT m a -> ListT m a -> ListT m a
forall (l :: * -> *) a b.
List l =>
(a -> l b -> l b) -> l b -> l a -> l b
foldrL' a -> ListT m a -> ListT m a
forall a. a -> ListT m a -> ListT m a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons)
#endif
instance Monad m => Monoid (ListT m a) where
mempty :: ListT m a
mempty = m (ListItem (ListT m) a) -> ListT m a
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT (m (ListItem (ListT m) a) -> ListT m a)
-> m (ListItem (ListT m) a) -> ListT m a
forall a b. (a -> b) -> a -> b
$ ListItem (ListT m) a -> m (ListItem (ListT m) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ListItem (ListT m) a
forall (l :: * -> *) a. ListItem l a
Nil
#if !(MIN_VERSION_base(4,11,0))
mappend = flip (foldrL' cons)
#endif
instance Functor m => Functor (ListT m) where
fmap :: forall a b. (a -> b) -> ListT m a -> ListT m b
fmap a -> b
func (ListT m (ListItem (ListT m) a)
action) =
m (ListItem (ListT m) b) -> ListT m b
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT ((ListItem (ListT m) a -> ListItem (ListT m) b)
-> m (ListItem (ListT m) a) -> m (ListItem (ListT m) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListItem (ListT m) a -> ListItem (ListT m) b
f m (ListItem (ListT m) a)
action)
where
f :: ListItem (ListT m) a -> ListItem (ListT m) b
f ListItem (ListT m) a
Nil = ListItem (ListT m) b
forall (l :: * -> *) a. ListItem l a
Nil
f (Cons a
x ListT m a
xs) = b -> ListT m b -> ListItem (ListT m) b
forall (l :: * -> *) a. a -> l a -> ListItem l a
Cons (a -> b
func a
x) ((a -> b) -> ListT m a -> ListT m b
forall a b. (a -> b) -> ListT m a -> ListT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
func ListT m a
xs)
instance Monad m => Monad (ListT m) where
return :: forall a. a -> ListT m a
return = m (ListItem (ListT m) a) -> ListT m a
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT (m (ListItem (ListT m) a) -> ListT m a)
-> (a -> m (ListItem (ListT m) a)) -> a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListItem (ListT m) a -> m (ListItem (ListT m) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListItem (ListT m) a -> m (ListItem (ListT m) a))
-> (a -> ListItem (ListT m) a) -> a -> m (ListItem (ListT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ListT m a -> ListItem (ListT m) a
forall (l :: * -> *) a. a -> l a -> ListItem l a
`Cons` ListT m a
forall a. Monoid a => a
mempty)
ListT m a
a >>= :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
>>= a -> ListT m b
b = (ListT m b -> ListT m b -> ListT m b)
-> ListT m b -> ListT m (ListT m b) -> ListT m b
forall (l :: * -> *) a b.
List l =>
(a -> l b -> l b) -> l b -> l a -> l b
foldrL' ListT m b -> ListT m b -> ListT m b
forall a. Monoid a => a -> a -> a
mappend ListT m b
forall a. Monoid a => a
mempty ((a -> ListT m b) -> ListT m a -> ListT m (ListT m b)
forall a b. (a -> b) -> ListT m a -> ListT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ListT m b
b ListT m a
a)
instance Monad m => Applicative (ListT m) where
pure :: forall a. a -> ListT m a
pure = a -> ListT m a
forall a. a -> ListT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m 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
instance Monad m => Alternative (ListT m) where
empty :: forall a. ListT m a
empty = ListT m a
forall a. Monoid a => a
mempty
<|> :: forall a. ListT m a -> ListT m a -> ListT m a
(<|>) = ListT m a -> ListT m a -> ListT m a
forall a. Monoid a => a -> a -> a
mappend
instance Monad m => MonadPlus (ListT m) where
mzero :: forall a. ListT m a
mzero = ListT m a
forall a. Monoid a => a
mempty
mplus :: forall a. ListT m a -> ListT m a -> ListT m a
mplus = ListT m a -> ListT m a -> ListT m a
forall a. Monoid a => a -> a -> a
mappend
instance MonadTrans ListT where
lift :: forall (m :: * -> *) a. Monad m => m a -> ListT m a
lift = m (ListItem (ListT m) a) -> ListT m a
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT (m (ListItem (ListT m) a) -> ListT m a)
-> (m a -> m (ListItem (ListT m) a)) -> m a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ListItem (ListT m) a) -> m a -> m (ListItem (ListT m) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> ListT m a -> ListItem (ListT m) a
forall (l :: * -> *) a. a -> l a -> ListItem l a
`Cons` ListT m a
forall a. Monoid a => a
mempty)
instance Monad m => List (ListT m) where
type ItemM (ListT m) = m
runList :: forall a. ListT m a -> ItemM (ListT m) (ListItem (ListT m) a)
runList = ListT m a -> m (ListItem (ListT m) a)
ListT m a -> ItemM (ListT m) (ListItem (ListT m) a)
forall (m :: * -> *) a. ListT m a -> m (ListItem (ListT m) a)
runListT
joinL :: forall a. ItemM (ListT m) (ListT m a) -> ListT m a
joinL = m (ListItem (ListT m) a) -> ListT m a
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT (m (ListItem (ListT m) a) -> ListT m a)
-> (m (ListT m a) -> m (ListItem (ListT m) a))
-> m (ListT m a)
-> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (ListT m a)
-> (ListT m a -> m (ListItem (ListT m) a))
-> m (ListItem (ListT m) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListT m a -> m (ListItem (ListT m) a)
ListT m a -> ItemM (ListT m) (ListItem (ListT m) a)
forall a. ListT m a -> ItemM (ListT m) (ListItem (ListT m) a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList)
cons :: forall a. a -> ListT m a -> ListT m a
cons a
x = m (ListItem (ListT m) a) -> ListT m a
forall (m :: * -> *) a. m (ListItem (ListT m) a) -> ListT m a
ListT (m (ListItem (ListT m) a) -> ListT m a)
-> (ListT m a -> m (ListItem (ListT m) a))
-> ListT m a
-> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListItem (ListT m) a -> m (ListItem (ListT m) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListItem (ListT m) a -> m (ListItem (ListT m) a))
-> (ListT m a -> ListItem (ListT m) a)
-> ListT m a
-> m (ListItem (ListT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ListT m a -> ListItem (ListT m) a
forall (l :: * -> *) a. a -> l a -> ListItem l a
Cons a
x
instance MonadIO m => MonadIO (ListT m) where
liftIO :: forall a. IO a -> ListT m a
liftIO = m a -> ListT m a
forall (m :: * -> *) a. Monad m => 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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO