[Haskell-cafe] State separation/combination pattern question

Nicolas Frisby nicolas.frisby at gmail.com
Sat Dec 23 12:09:57 EST 2006


Another option is to use the HList library (though this can involve a
learning curve). Essentially your monad is a state monad and its state
is a big tuple constrained to contain at least whichever types you ask
of it. Consider

> foo :: (HOccurs StateA st, ...other HList properties..., MonadState st m) => m ()
> foo = do st <- gets hOccurs -- note the gets hOccurs
>          put $ st { a = 1:(a st) }

> bar :: (HOccurs StateB st, ...other HList properties..., MonadState st m) => m ()
> bar = do st <- gets hOccurs
>          put $ st { b = 2:(b st) }


When you use foo and bar together, the constraints the state of your
monad must satisfy accumulate, i.e. exec would require both HOccurs
properties of its monad's state.

This approach would stretch the type checker more than the others. And
I can't say I've ever used it on a large scale, but it has worked on
smaller examples. Also, "too much polymorphism" can cause some issues
with all of the library's type machinery.

But I think it's an attractive option if it fits your needs.

Good luck,
Nick

On 12/23/06, J. Garrett Morris <trevion at gmail.com> wrote:
> 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.
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list