module Data.Monoid.State where
import qualified Data.Monoid.Transformer as MonoidTrans
import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup, (<>), )
import Data.Functor (Functor, fmap, )
import Data.Function (const, ($), (.), )
import Data.Tuple (fst, snd, )
import Prelude ()
newtype T s a = Cons {run :: s -> (a,s)}
pure :: a -> T s a
pure a = Cons $ \s -> (a,s)
evaluate :: s -> T s a -> a
evaluate s m = fst $ run m s
execute :: s -> T s a -> s
execute s m = snd $ run m s
put :: Monoid a => s -> T s a
put s = Cons $ const (mempty, s)
modify :: Monoid a => (s -> s) -> T s a
modify f = Cons $ \s -> (mempty, f s)
instance Semigroup a => Semigroup (T s a) where
Cons x <> Cons y =
Cons $ \s0 ->
let (xr,s1) = x s0
(yr,s2) = y s1
in (xr<>yr, s2)
instance Monoid a => Monoid (T s a) where
mempty = MonoidTrans.lift mempty
mappend (Cons x) (Cons y) =
Cons $ \s0 ->
let (xr,s1) = x s0
(yr,s2) = y s1
in (mappend xr yr, s2)
instance MonoidTrans.C (T s) where
lift x = Cons $ (,) x
instance Functor (T s) where
fmap f (Cons g) = Cons (mapFst f . g)
mapFst :: (a -> c) -> (a,b) -> (c,b)
mapFst f ~(a,b) = (f a, b)