{- |
Module      :  ./Common/Lib/State.hs
Description :  State type from Control.Monad.State but no class MonadState
Copyright   :  C. Maeder and Uni Bremen 2002-2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  experimental
Portability :  portable

State type from Control.Monad.State but no class MonadState

This module was a replacement of the (non-haskell98) module
Control.Monad.State, but now Control.Monad.Trans.State can be used instead.

-}

module Common.Lib.State where

import Control.Applicative ()
import Control.Monad
import qualified Control.Monad.Fail as Fail

-- | Our fixed state monad
newtype State s a = State { State s a -> s -> (a, s)
runState :: s -> (a, s) }

state :: (s -> (a, s)) -> State s a
state :: (s -> (a, s)) -> State s a
state = (s -> (a, s)) -> State s a
forall s a. (s -> (a, s)) -> State s a
State

instance Functor (State s) where
        fmap :: (a -> b) -> State s a -> State s b
fmap = (a -> b) -> State s a -> State s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (State s) where
        pure :: a -> State s a
pure  = a -> State s a
forall (m :: * -> *) a. Monad m => a -> m a
return
        <*> :: State s (a -> b) -> State s a -> State s b
(<*>) = State s (a -> b) -> State s a -> State s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (State s) where
        return :: a -> State s a
return a :: a
a = (s -> (a, s)) -> State s a
forall s a. (s -> (a, s)) -> State s a
State ((s -> (a, s)) -> State s a) -> (s -> (a, s)) -> State s a
forall a b. (a -> b) -> a -> b
$ \ s :: s
s -> (a
a, s
s)
        State f :: s -> (a, s)
f >>= :: State s a -> (a -> State s b) -> State s b
>>= k :: a -> State s b
k = (s -> (b, s)) -> State s b
forall s a. (s -> (a, s)) -> State s a
State ((s -> (b, s)) -> State s b) -> (s -> (b, s)) -> State s b
forall a b. (a -> b) -> a -> b
$ \ s :: s
s ->
                let (a :: a
a, s' :: s
s') = s -> (a, s)
f s
s in State s b -> s -> (b, s)
forall s a. State s a -> s -> (a, s)
runState (a -> State s b
k a
a) s
s'

instance Fail.MonadFail (State s) where
  fail :: String -> State s a
fail str :: String
str = (s -> (a, s)) -> State s a
forall s a. (s -> (a, s)) -> State s a
State ((s -> (a, s)) -> State s a) -> (s -> (a, s)) -> State s a
forall a b. (a -> b) -> a -> b
$ \_ -> String -> (a, s)
forall a. HasCallStack => String -> a
error String
str

-- put and get are non-overloaded here!

get :: State s s
get :: State s s
get = (s -> (s, s)) -> State s s
forall s a. (s -> (a, s)) -> State s a
State ((s -> (s, s)) -> State s s) -> (s -> (s, s)) -> State s s
forall a b. (a -> b) -> a -> b
$ \ s :: s
s -> (s
s, s
s)

put :: s -> State s ()
put :: s -> State s ()
put s :: s
s = (s -> ((), s)) -> State s ()
forall s a. (s -> (a, s)) -> State s a
State ((s -> ((), s)) -> State s ()) -> (s -> ((), s)) -> State s ()
forall a b. (a -> b) -> a -> b
$ ((), s) -> s -> ((), s)
forall a b. a -> b -> a
const ((), s
s)

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

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

evalState :: State s a -> s -> a
evalState :: State s a -> s -> a
evalState m :: State s a
m = (a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> (s -> (a, s)) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m

execState :: State s a -> s -> s
execState :: State s a -> s -> s
execState m :: State s a
m = (a, s) -> s
forall a b. (a, b) -> b
snd ((a, s) -> s) -> (s -> (a, s)) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f :: (a, s) -> (b, s)
f m :: State s a
m = (s -> (b, s)) -> State s b
forall s a. (s -> (a, s)) -> State s a
State ((s -> (b, s)) -> State s b) -> (s -> (b, s)) -> State s b
forall a b. (a -> b) -> a -> b
$ (a, s) -> (b, s)
f ((a, s) -> (b, s)) -> (s -> (a, s)) -> s -> (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m

withState :: (s -> s) -> State s a -> State s a
withState :: (s -> s) -> State s a -> State s a
withState f :: s -> s
f m :: State s a
m = (s -> (a, s)) -> State s a
forall s a. (s -> (a, s)) -> State s a
State ((s -> (a, s)) -> State s a) -> (s -> (a, s)) -> State s a
forall a b. (a -> b) -> a -> b
$ State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m (s -> (a, s)) -> (s -> s) -> s -> (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f