module Control.Monad.PhantomState (
PhantomStateT (..)
, PhantomState
, useState
, changeState
, runPhantomStateT
, runPhantomState
) where
import Control.Applicative
import Control.Monad.Trans.Class
import Data.Functor.Identity
newtype PhantomStateT s m a = PhantomStateT (s -> m s)
type PhantomState s a = PhantomStateT s Identity a
useState :: Applicative m => (s -> m a) -> PhantomStateT s m ()
useState f = PhantomStateT $ \x -> f x *> pure x
changeState :: Applicative m => (s -> s) -> PhantomStateT s m ()
changeState f = PhantomStateT $ pure . f
runPhantomStateT :: PhantomStateT s m a
-> s
-> m s
runPhantomStateT (PhantomStateT f) x = f x
runPhantomState :: PhantomState s a
-> s
-> s
runPhantomState f = runIdentity . runPhantomStateT f
instance Functor (PhantomStateT s m) where
fmap _ (PhantomStateT f) = PhantomStateT f
instance Monad m => Applicative (PhantomStateT s m) where
pure _ = PhantomStateT return
PhantomStateT f <*> PhantomStateT g = PhantomStateT (\x -> f x >>= g)
PhantomStateT f *> PhantomStateT g = PhantomStateT (\x -> f x >>= g)
PhantomStateT f <* PhantomStateT g = PhantomStateT (\x -> f x >>= g)
instance Monad m => Monad (PhantomStateT s m) where
return = pure
x >>= f = x *> f undefined
(>>) = (*>)
instance MonadTrans (PhantomStateT s) where
lift m = PhantomStateT (\x -> m >> return x)