[Haskell-cafe] State separation/combination pattern question

J. Garrett Morris trevion at gmail.com
Sat Dec 23 03:38:41 EST 2006


On 12/22/06, Reto Kramer <ml at retokramer.net> wrote:
> What I'm really looking for is not so much the chaining of StateT
> compositions, but rather the isolation of StateA from StateB while
> they both flow from the search loop into the respective library calls
> (foo, bar) transparently to the application programmer.  I'm hoping
> there's a way to have the loop be in a State monad whose content is
> the sum of the two states that are needed for the foo and bar call
> made to the stores from inside the loop. The calls sites for foo and
> bar should then extract the right component of the global state and
> thread only that state through into the modules. Sounds like magic,
> but how close can I get?

My first impulse would be to define classes for each type of state and
have a top-level monad which is instances of each of those.  Using
your example: (your code is > quoted, mine < quoted)

> -- ghci -fglasgow-exts ...
> --
> type StateA = [Integer]

At this point, I would add:

< class Monad m => MonadStateA m
<     where getA    :: m StateA
<           modifyA :: (StateA -> StateA) -> m ()
<
< putA :: MonadStateA m => StateA -> m ()
< putA = modifyA . const

> type StateB = [Integer]

And, similarly here:

< class Monad m => MonadStateB m
<     where getB    :: m StateB
<           modifyB :: (StateB -> StateB) -> m ()
<
< putB :: MonadStateB m => StateB -> m ()
< putB = modifyB . const

> data AppStateRec = AppStateRec { a :: StateA, b :: StateB } deriving
> Show

These functions change in two ways: first, their type signatures now
use the new classes I defiend above.  Second, by including the modify
functions, I can make the function bodies somewhat shorter.

> foo :: MonadState AppStateRec m => m ()
> foo = do st <- get
>          put $ st { a = 1:(a st) }

< foo :: MonadStateA m => m ()
< foo = modifyA (1:)

> bar :: MonadState AppStateRec m => m ()
> bar = do st <- get
>          put $ st { b = 2:(b st) }

< bar :: MonadStateB m => m ()
< bar = modifyB (2:)

At this point, you have several options.  If you're willing to allow
undecidable instances, you can write instances like:

< instance MonadState AppStateRec m => MonadStateA m
<     where getA = get >>= return . a
<           modifyA f = do st <- get
<                          put (st { a = f (a st) })
<
< instance MonadState AppStateRec m => MonadStateB m
<     where getB = get >>= return . b
<           modifyB f = do st <- get
<                          put (st { b = f (b st) })

And the remainder of your code will run as you wrote it.  An
alternative without using undecidable instances is to write the
instances manually.  However, in that case, I believe you will have to
write your monad as a newtype instead of a type, and then rely on
either GHC's ability to derive instances of MonadState etc. or else
write those instances yourself as well.

Hope that helps.

 /g

> type Eval a = StateT AppStateRec Identity a
>
> exec :: Eval ()
> exec = do foo
>           bar
>           foo
>           foo
>           bar
>
> go = runIdentity $ runStateT exec AppStateRec { a = [], b = [] }
>
> Prints: ((),AppStateRec {a = [1,1,1], b = [2,2]})
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


-- 
It is myself I have never met, whose face is pasted on the underside of my mind.


More information about the Haskell-Cafe mailing list