module Eve.Internal.Actions
( AppF(..)
, ActionT(..)
, AppT
, runApp
, evalApp
, execApp
, liftApp
, runAction
) where
import Control.Monad.State
import Control.Monad.Trans.Free
import Control.Lens
type AppT s m a = ActionT s s m a
newtype AppF base m next =
LiftApp (StateT base m next)
deriving (Functor, Applicative)
newtype ActionT base zoomed m a = ActionT
{ getAction :: FreeT (AppF base m) (StateT zoomed m) a
} deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed)
instance Monad n => MonadFree (AppF base n) (ActionT base zoomed n) where
wrap (LiftApp act) = join . ActionT . liftF . LiftApp $ act
instance MonadTrans (ActionT base zoomed) where
lift = ActionT . lift . lift
unLift :: Monad m => FreeT (AppF base m) (StateT base m) a -> StateT base m a
unLift m = do
step <- runFreeT m
case step of
Pure a -> return a
Free (LiftApp next) -> next >>= unLift
type instance Zoomed (ActionT base zoomed m) = Zoomed (FreeT (AppF base m) (StateT zoomed m))
instance Monad m => Zoom (ActionT base s m) (ActionT base t m) s t where
zoom l (ActionT action) = ActionT $ zoom l action
runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c
runAction = zoom
liftApp :: Monad m => AppT base m a -> ActionT base zoomed m a
liftApp = liftF . LiftApp . unLift . getAction
runApp :: Monad m => base -> AppT base m a -> m (a, base)
runApp baseState = flip runStateT baseState . unLift . getAction
evalApp :: Monad m => base -> AppT base m a -> m a
evalApp baseState = fmap fst . runApp baseState
execApp :: Monad m => base -> AppT base m a -> m base
execApp baseState = fmap snd . runApp baseState