-- |
-- Module      : Basement.Compat.MonadTrans
-- License     : BSD-style
-- Maintainer  : Psychohistorians
-- Stability   : experimental
-- Portability : portable
--
-- An internal and really simple monad transformers,
-- without any bells and whistse.
module Basement.Compat.MonadTrans
    ( State(..)
    , Reader(..)
    ) where

import Basement.Compat.Base
import Control.Monad ((>=>))

-- | Simple State monad
newtype State s m a = State { forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState :: s -> m (a, s) }

instance Monad m => Functor (State s m) where
    fmap :: forall a b. (a -> b) -> State s m a -> State s m b
fmap a -> b
f State s m a
fa = forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State s m a
fa forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(a
a, s
s2) -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, s
s2))
instance Monad m => Applicative (State s m) where
    pure :: forall a. a -> State s m a
pure a
a = forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State forall a b. (a -> b) -> a -> b
$ \s
st -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,s
st)
    State s m (a -> b)
fab <*> :: forall a b. State s m (a -> b) -> State s m a -> State s m b
<*> State s m a
fa = forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
        (a -> b
ab,s
s2) <- forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State s m (a -> b)
fab s
s1
        (a
a,s
s3)  <- forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State s m a
fa s
s2
        forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
ab a
a, s
s3)
instance Monad m => Monad (State r m) where
    return :: forall a. a -> State r m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    State r m a
ma >>= :: forall a b. State r m a -> (a -> State r m b) -> State r m b
>>= a -> State r m b
mb = forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State forall a b. (a -> b) -> a -> b
$ \r
s1 -> do
        (a
a,r
s2) <- forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State r m a
ma r
s1
        forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState (a -> State r m b
mb a
a) r
s2

-- | Simple Reader monad
newtype Reader r m a = Reader { forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader :: r -> m a }

instance Monad m => Functor (Reader r m) where
    fmap :: forall a b. (a -> b) -> Reader r m a -> Reader r m b
fmap a -> b
f Reader r m a
fa = forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
fa forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a))
instance Monad m => Applicative (Reader r m) where
    pure :: forall a. a -> Reader r m a
pure a
a = forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader forall a b. (a -> b) -> a -> b
$ \r
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Reader r m (a -> b)
fab <*> :: forall a b. Reader r m (a -> b) -> Reader r m a -> Reader r m b
<*> Reader r m a
fa = forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader forall a b. (a -> b) -> a -> b
$ \r
r -> do
        a
a  <- forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
fa r
r
        a -> b
ab <- forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m (a -> b)
fab r
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
ab a
a
instance Monad m => Monad (Reader r m) where
    return :: forall a. a -> Reader r m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Reader r m a
ma >>= :: forall a b. Reader r m a -> (a -> Reader r m b) -> Reader r m b
>>= a -> Reader r m b
mb = forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader forall a b. (a -> b) -> a -> b
$ \r
r -> do
        a
a <- forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
ma r
r
        forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader (a -> Reader r m b
mb a
a) r
r