[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