module System.Console.Haskeline.Monads(
                MonadTrans(..),
                MonadIO(..),
                ReaderT,
                runReaderT,
                runReaderT',
                mapReaderT,
                asks,
                StateT,
                runStateT,
                evalStateT',
                mapStateT,
                gets,
                modify,
                update,
                MonadReader(..),
                MonadState(..),
                MaybeT(MaybeT),
                runMaybeT,
                orElse
                ) where

import Control.Monad (liftM)
import Control.Monad.Catch ()
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Maybe (MaybeT(MaybeT),runMaybeT)
import Control.Monad.Trans.Reader hiding (ask,asks)
import qualified Control.Monad.Trans.Reader as Reader
import Control.Monad.Trans.State.Strict hiding (get, put, gets, modify)
import qualified Control.Monad.Trans.State.Strict as State

import Data.IORef

class Monad m => MonadReader r m where
    ask :: m r

instance Monad m => MonadReader r (ReaderT r m) where
    ask :: ReaderT r m r
ask = ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
Reader.ask

instance Monad m => MonadReader s (StateT s m) where
    ask :: StateT s m s
ask = StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get

instance {-# OVERLAPPABLE #-} (MonadReader r m, MonadTrans t, Monad (t m))
    => MonadReader r (t m) where
    ask :: t m r
ask = m r -> t m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask

asks :: MonadReader r m => (r -> a) -> m a
asks :: (r -> a) -> m a
asks r -> a
f = (r -> a) -> m r -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM r -> a
f m r
forall r (m :: * -> *). MonadReader r m => m r
ask

class Monad m => MonadState s m where
    get :: m s
    put :: s -> m ()

gets :: MonadState s m => (s -> a) -> m a
gets :: (s -> a) -> m a
gets s -> a
f = (s -> a) -> m s -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM s -> a
f m s
forall s (m :: * -> *). MonadState s m => m s
get

modify :: MonadState s m => (s -> s) -> m ()
modify :: (s -> s) -> m ()
modify s -> s
f = m s
forall s (m :: * -> *). MonadState s m => m s
get m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (s -> m ()) -> (s -> s) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f

update :: MonadState s m => (s -> (a,s)) -> m a
update :: (s -> (a, s)) -> m a
update s -> (a, s)
f = do
    s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
    let (a
x,s
s') = s -> (a, s)
f s
s
    s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s'
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

runReaderT' :: r -> ReaderT r m a -> m a
runReaderT' :: r -> ReaderT r m a -> m a
runReaderT' = (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

instance Monad m => MonadState s (StateT s m) where
    get :: StateT s m s
get = StateT s m s
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
    put :: s -> StateT s m ()
put s
x = s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (s -> StateT s m ()) -> s -> StateT s m ()
forall a b. (a -> b) -> a -> b
$! s
x

instance {-# OVERLAPPABLE #-} (MonadState s m, MonadTrans t, Monad (t m))
    => MonadState s (t m) where
    get :: t m s
get = m s -> t m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> t m ()
put = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (s -> m ()) -> s -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

-- ReaderT (IORef s) is better than StateT s for some applications,
-- since StateT loses its state after an exception such as ctrl-c.
instance MonadIO m => MonadState s (ReaderT (IORef s) m) where
    get :: ReaderT (IORef s) m s
get = ReaderT (IORef s) m (IORef s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (IORef s) m (IORef s)
-> (IORef s -> ReaderT (IORef s) m s) -> ReaderT (IORef s) m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO s -> ReaderT (IORef s) m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> ReaderT (IORef s) m s)
-> (IORef s -> IO s) -> IORef s -> ReaderT (IORef s) m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef s -> IO s
forall a. IORef a -> IO a
readIORef
    put :: s -> ReaderT (IORef s) m ()
put s
s = ReaderT (IORef s) m (IORef s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (IORef s) m (IORef s)
-> (IORef s -> ReaderT (IORef s) m ()) -> ReaderT (IORef s) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ReaderT (IORef s) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (IORef s) m ())
-> (IORef s -> IO ()) -> IORef s -> ReaderT (IORef s) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef s -> s -> IO ()) -> s -> IORef s -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef s
s

evalStateT' :: Monad m => s -> StateT s m a -> m a
evalStateT' :: s -> StateT s m a -> m a
evalStateT' s
s StateT s m a
f = ((a, s) -> a) -> m (a, s) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, s) -> a
forall a b. (a, b) -> a
fst (m (a, s) -> m a) -> m (a, s) -> m a
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
f s
s

orElse :: Monad m => MaybeT m a -> m a -> m a
orElse :: MaybeT m a -> m a -> m a
orElse (MaybeT m (Maybe a)
f) m a
g = m (Maybe a)
f m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
g a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return