-- |
-- 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 = (s -> m (b, s)) -> State s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State ((s -> m (b, s)) -> State s m b) -> (s -> m (b, s)) -> State s m b
forall a b. (a -> b) -> a -> b
$ State s m a -> s -> m (a, s)
forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State s m a
fa (s -> m (a, s)) -> ((a, s) -> m (b, s)) -> s -> m (b, s)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(a
a, s
s2) -> (b, s) -> m (b, s)
forall a. a -> m a
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 = (s -> m (a, s)) -> State s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State ((s -> m (a, s)) -> State s m a) -> (s -> m (a, s)) -> State s m a
forall a b. (a -> b) -> a -> b
$ \s
st -> (a, s) -> m (a, s)
forall a. a -> m a
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 = (s -> m (b, s)) -> State s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State ((s -> m (b, s)) -> State s m b) -> (s -> m (b, s)) -> State s m b
forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
        (a -> b
ab,s
s2) <- State s m (a -> b) -> s -> m (a -> b, s)
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)  <- State s m a -> s -> m (a, s)
forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State s m a
fa s
s2
        (b, s) -> m (b, s)
forall a. a -> m a
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 = a -> State r m a
forall a. a -> State r m a
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 = (r -> m (b, r)) -> State r m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State ((r -> m (b, r)) -> State r m b) -> (r -> m (b, r)) -> State r m b
forall a b. (a -> b) -> a -> b
$ \r
s1 -> do
        (a
a,r
s2) <- State r m a -> r -> m (a, r)
forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState State r m a
ma r
s1
        State r m b -> r -> m (b, r)
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 = (r -> m b) -> Reader r m b
forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader ((r -> m b) -> Reader r m b) -> (r -> m b) -> Reader r m b
forall a b. (a -> b) -> a -> b
$ Reader r m a -> r -> m a
forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
fa (r -> m a) -> (a -> m b) -> r -> m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\a
a -> b -> m b
forall a. a -> m 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 = (r -> m a) -> Reader r m a
forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader ((r -> m a) -> Reader r m a) -> (r -> m a) -> Reader r m a
forall a b. (a -> b) -> a -> b
$ \r
_ -> a -> m a
forall a. a -> m a
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 = (r -> m b) -> Reader r m b
forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader ((r -> m b) -> Reader r m b) -> (r -> m b) -> Reader r m b
forall a b. (a -> b) -> a -> b
$ \r
r -> do
        a
a  <- Reader r m a -> r -> m a
forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
fa r
r
        a -> b
ab <- Reader r m (a -> b) -> r -> m (a -> b)
forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m (a -> b)
fab r
r
        b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
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 = a -> Reader r m a
forall a. a -> Reader r m a
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 = (r -> m b) -> Reader r m b
forall r (m :: * -> *) a. (r -> m a) -> Reader r m a
Reader ((r -> m b) -> Reader r m b) -> (r -> m b) -> Reader r m b
forall a b. (a -> b) -> a -> b
$ \r
r -> do
        a
a <- Reader r m a -> r -> m a
forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader Reader r m a
ma r
r
        Reader r m b -> r -> m b
forall r (m :: * -> *) a. Reader r m a -> r -> m a
runReader (a -> Reader r m b
mb a
a) r
r