1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FunctionalDependencies #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE UndecidableInstances #-}
6-- Search for UndecidableInstances to see why this is needed
7
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  Control.Monad.State.Class
11-- Copyright   :  (c) Andy Gill 2001,
12--                (c) Oregon Graduate Institute of Science and Technology, 2001
13-- License     :  BSD-style (see the file LICENSE)
14--
15-- Maintainer  :  libraries@haskell.org
16-- Stability   :  experimental
17-- Portability :  non-portable (multi-param classes, functional dependencies)
18--
19-- MonadState class.
20--
21--      This module is inspired by the paper
22--      /Functional Programming with Overloading and Higher-Order Polymorphism/,
23--        Mark P Jones (<http://web.cecs.pdx.edu/~mpj/>)
24--          Advanced School of Functional Programming, 1995.
25
26-----------------------------------------------------------------------------
27
28module Control.Monad.State.Class (
29    MonadState(..),
30    modify,
31    modify',
32    gets
33  ) where
34
35import Control.Monad.Trans.Cont
36import Control.Monad.Trans.Error
37import Control.Monad.Trans.Except
38import Control.Monad.Trans.Identity
39import Control.Monad.Trans.List
40import Control.Monad.Trans.Maybe
41import Control.Monad.Trans.Reader
42import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST, get, put, state)
43import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST, get, put, state)
44import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put, state)
45import qualified Control.Monad.Trans.State.Strict as Strict (StateT, get, put, state)
46import Control.Monad.Trans.Writer.Lazy as Lazy
47import Control.Monad.Trans.Writer.Strict as Strict
48
49import Control.Monad.Trans.Class (lift)
50import Control.Monad
51import Data.Monoid
52
53-- ---------------------------------------------------------------------------
54
55-- | Minimal definition is either both of @get@ and @put@ or just @state@
56class Monad m => MonadState s m | m -> s where
57    -- | Return the state from the internals of the monad.
58    get :: m s
59    get = state (\s -> (s, s))
60
61    -- | Replace the state inside the monad.
62    put :: s -> m ()
63    put s = state (\_ -> ((), s))
64
65    -- | Embed a simple state action into the monad.
66    state :: (s -> (a, s)) -> m a
67    state f = do
68      s <- get
69      let ~(a, s') = f s
70      put s'
71      return a
72#if __GLASGOW_HASKELL__ >= 707
73    {-# MINIMAL state | get, put #-}
74#endif
75
76-- | Monadic state transformer.
77--
78--      Maps an old state to a new state inside a state monad.
79--      The old state is thrown away.
80--
81-- >      Main> :t modify ((+1) :: Int -> Int)
82-- >      modify (...) :: (MonadState Int a) => a ()
83--
84--    This says that @modify (+1)@ acts over any
85--    Monad that is a member of the @MonadState@ class,
86--    with an @Int@ state.
87modify :: MonadState s m => (s -> s) -> m ()
88modify f = state (\s -> ((), f s))
89
90-- | A variant of 'modify' in which the computation is strict in the
91-- new state.
92--
93-- @since 2.2
94modify' :: MonadState s m => (s -> s) -> m ()
95modify' f = do
96  s' <- get
97  put $! f s'
98
99-- | Gets specific component of the state, using a projection function
100-- supplied.
101gets :: MonadState s m => (s -> a) -> m a
102gets f = do
103    s <- get
104    return (f s)
105
106instance Monad m => MonadState s (Lazy.StateT s m) where
107    get = Lazy.get
108    put = Lazy.put
109    state = Lazy.state
110
111instance Monad m => MonadState s (Strict.StateT s m) where
112    get = Strict.get
113    put = Strict.put
114    state = Strict.state
115
116instance (Monad m, Monoid w) => MonadState s (LazyRWS.RWST r w s m) where
117    get = LazyRWS.get
118    put = LazyRWS.put
119    state = LazyRWS.state
120
121instance (Monad m, Monoid w) => MonadState s (StrictRWS.RWST r w s m) where
122    get = StrictRWS.get
123    put = StrictRWS.put
124    state = StrictRWS.state
125
126-- ---------------------------------------------------------------------------
127-- Instances for other mtl transformers
128--
129-- All of these instances need UndecidableInstances,
130-- because they do not satisfy the coverage condition.
131
132instance MonadState s m => MonadState s (ContT r m) where
133    get = lift get
134    put = lift . put
135    state = lift . state
136
137instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
138    get = lift get
139    put = lift . put
140    state = lift . state
141
142-- | @since 2.2
143instance MonadState s m => MonadState s (ExceptT e m) where
144    get = lift get
145    put = lift . put
146    state = lift . state
147
148instance MonadState s m => MonadState s (IdentityT m) where
149    get = lift get
150    put = lift . put
151    state = lift . state
152
153instance MonadState s m => MonadState s (ListT m) where
154    get = lift get
155    put = lift . put
156    state = lift . state
157
158instance MonadState s m => MonadState s (MaybeT m) where
159    get = lift get
160    put = lift . put
161    state = lift . state
162
163instance MonadState s m => MonadState s (ReaderT r m) where
164    get = lift get
165    put = lift . put
166    state = lift . state
167
168instance (Monoid w, MonadState s m) => MonadState s (Lazy.WriterT w m) where
169    get = lift get
170    put = lift . put
171    state = lift . state
172
173instance (Monoid w, MonadState s m) => MonadState s (Strict.WriterT w m) where
174    get = lift get
175    put = lift . put
176    state = lift . state
177