{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                  ~ 2011.07.05
-- |
-- Module      :  Control.Monad.State.UnificationExtras
-- Copyright   :  Copyright (c) 2008--2015 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  perpetually unstable
-- Portability :  semi-portable (MPTCs)
--
-- This module defines some extra functions for "Control.Monad.State.Lazy".
-- This package really isn't the proper place for these, but we
-- need them to be somewhere.
--
-- TODO: patch transformers\/mtl-2 with these functions.
----------------------------------------------------------------
module Control.Monad.State.UnificationExtras
    (
    -- * Additional functions for MTL
      liftReader
    , liftReaderT
    , modify'
    , localState
    ) where

import Control.Monad            (liftM)
import Control.Monad.Reader     (Reader(), ReaderT(..))
import Control.Monad.State.Lazy (MonadState(..), State(), StateT(..))

----------------------------------------------------------------
----------------------------------------------------------------

-- | Lift a reader into a state monad. More particularly, this
-- allows disabling mutability in a local context within @StateT@.
liftReaderT :: (Monad m) => ReaderT e m a -> StateT e m a
{-# INLINE liftReaderT #-}
liftReaderT :: ReaderT e m a -> StateT e m a
liftReaderT ReaderT e m a
r = (e -> m (a, e)) -> StateT e m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((e -> m (a, e)) -> StateT e m a)
-> (e -> m (a, e)) -> StateT e m a
forall a b. (a -> b) -> a -> b
$ \e
e -> (a -> (a, e)) -> m a -> m (a, e)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
a -> (a
a,e
e)) (ReaderT e m a -> e -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT e m a
r e
e)


-- | Lift a reader into a state monad. More particularly, this
-- allows disabling mutability in a local context within @State@.
liftReader :: Reader e a -> State e a
{-# INLINE liftReader #-}
liftReader :: Reader e a -> State e a
liftReader = Reader e a -> State e a
forall (m :: * -> *) e a. Monad m => ReaderT e m a -> StateT e m a
liftReaderT


-- | A strict version of 'modify'.
modify' :: (MonadState s m) => (s -> s) -> m ()
{-# INLINE modify' #-}
modify' :: (s -> s) -> m ()
modify' s -> s
f = do
    s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
    s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (s -> m ()) -> s -> m ()
forall a b. (a -> b) -> a -> b
$! s -> s
f s
s


-- | Run a state action and undo the state changes at the end.
localState :: (MonadState s m) => m a -> m a
{-# INLINE localState #-}
localState :: m a -> m a
localState m a
m = do
    s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
    a
x <- m a
m
    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

----------------------------------------------------------------
----------------------------------------------------------- fin.