{-# LANGUAGE CPP #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} -- Search for UndecidableInstances to see why this is needed ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.State.Class -- Copyright : (c) Andy Gill 2001, -- (c) Oregon Graduate Institute of Science and Technology, 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : [email protected] -- Stability : experimental -- Portability : non-portable (multi-param classes, functional dependencies) -- -- MonadState class. -- -- This module is inspired by the paper -- /Functional Programming with Overloading and Higher-Order Polymorphism/, -- Mark P Jones (<http://web.cecs.pdx.edu/~mpj/>) -- Advanced School of Functional Programming, 1995. ----------------------------------------------------------------------------- module Control.Monad.State.Class ( MonadState(..), modify, modify', gets ) where import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST, get, put, state) import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST, get, put, state) import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put, state) import qualified Control.Monad.Trans.State.Strict as Strict (StateT, get, put, state) import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad.Trans.Class (lift) import Control.Monad import Data.Monoid -- --------------------------------------------------------------------------- -- | Minimal definition is either both of @[email protected] and @[email protected] or just @[email protected] class Monad m => MonadState s m | m -> s where -- | Return the state from the internals of the monad. get :: m s get = state (\s -> (s, s)) -- | Replace the state inside the monad. put :: s -> m () put s = state (\_ -> ((), s)) -- | Embed a simple state action into the monad. state :: (s -> (a, s)) -> m a state f = do s <- get let ~(a, s') = f s put s' return a #if __GLASGOW_HASKELL__ >= 707 {-# MINIMAL state | get, put #-} #endif -- | Monadic state transformer. -- -- Maps an old state to a new state inside a state monad. -- The old state is thrown away. -- -- > Main> :t modify ((+1) :: Int -> Int) -- > modify (...) :: (MonadState Int a) => a () -- -- This says that @modify (+1)@ acts over any -- Monad that is a member of the @[email protected] class, -- with an @[email protected] state. modify :: MonadState s m => (s -> s) -> m () modify f = state (\s -> ((), f s)) -- | A variant of 'modify' in which the computation is strict in the -- new state. -- -- @since 2.2 modify' :: MonadState s m => (s -> s) -> m () modify' f = do s' <- get put $! f s' -- | Gets specific component of the state, using a projection function -- supplied. gets :: MonadState s m => (s -> a) -> m a gets f = do s <- get return (f s) instance Monad m => MonadState s (Lazy.StateT s m) where get = Lazy.get put = Lazy.put state = Lazy.state instance Monad m => MonadState s (Strict.StateT s m) where get = Strict.get put = Strict.put state = Strict.state instance (Monad m, Monoid w) => MonadState s (LazyRWS.RWST r w s m) where get = LazyRWS.get put = LazyRWS.put state = LazyRWS.state instance (Monad m, Monoid w) => MonadState s (StrictRWS.RWST r w s m) where get = StrictRWS.get put = StrictRWS.put state = StrictRWS.state -- --------------------------------------------------------------------------- -- Instances for other mtl transformers -- -- All of these instances need UndecidableInstances, -- because they do not satisfy the coverage condition. instance MonadState s m => MonadState s (ContT r m) where get = lift get put = lift . put state = lift . state instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where get = lift get put = lift . put state = lift . state -- | @since 2.2 instance MonadState s m => MonadState s (ExceptT e m) where get = lift get put = lift . put state = lift . state instance MonadState s m => MonadState s (IdentityT m) where get = lift get put = lift . put state = lift . state instance MonadState s m => MonadState s (ListT m) where get = lift get put = lift . put state = lift . state instance MonadState s m => MonadState s (MaybeT m) where get = lift get put = lift . put state = lift . state instance MonadState s m => MonadState s (ReaderT r m) where get = lift get put = lift . put state = lift . state instance (Monoid w, MonadState s m) => MonadState s (Lazy.WriterT w m) where get = lift get put = lift . put state = lift . state instance (Monoid w, MonadState s m) => MonadState s (Strict.WriterT w m) where get = lift get put = lift . put state = lift . state