module Algebra.Monad.Foldable (
MonadList(..),
ListT,listT,
TreeT(..),treeT,
MaybeT(..),maybeT
) where
import Algebra.Monad.Base
import Algebra.Monad.RWS
import Data.Tree (Tree(..))
instance MonadList [] where fork = id
newtype ListT m a = ListT (Compose' [] m a)
deriving (Semigroup,Monoid,
Functor,Applicative,Unit,Monad,
Foldable,Traversable,MonadTrans)
listT :: Iso (ListT m a) (ListT m' a') (m [a]) (m' [a'])
listT = _Compose'.iso ListT (\(ListT l) -> l)
instance Monad m => MonadList (ListT m) where
fork = by listT . return
instance MonadFix m => MonadFix (ListT m) where
mfix f = by listT (mfix (yb listT . f . head))
instance MonadState s m => MonadState s (ListT m) where
get = get_ ; modify = modify_ ; put = put_
instance MonadWriter w m => MonadWriter w (ListT m) where
tell = lift.tell
listen = listT-.map sequence.listen.-listT
censor = listT-.censor.map (\l -> (fst<$>l,compose (snd<$>l))).-listT
instance Monad m => MonadError Void (ListT m) where
throw = const zero
catch f mm = mm & listT %%~ (\m -> m >>= \_l -> case _l of
[] -> f zero^..listT; l -> pure l)
newtype TreeT m a = TreeT (Compose' Tree m a)
deriving (Functor,Unit,Applicative,Monad,MonadFix,
Foldable,Traversable,MonadTrans)
treeT :: Iso (TreeT m a) (TreeT n b) (m (Tree a)) (n (Tree b))
treeT = _Compose'.iso TreeT (\(TreeT t) -> t)
newtype MaybeT m a = MaybeT (Compose' Maybe m a)
deriving (Functor,Unit,Applicative,Monad,MonadFix,
Foldable,Traversable,MonadTrans)
maybeT :: Iso (MaybeT m a) (MaybeT m' b) (m (Maybe a)) (m' (Maybe b))
maybeT = _Compose'.iso MaybeT (\(MaybeT m) -> m)