Ok, so this question of stacking state on top of state has come up several times lately. So I decided to whip up a small example. So here's a goofy little example of an abstract representation of a computer that can compute a value of type 'a'. The two states here are a value of type 'a', and a stack of functions of type (a->a) which can be applied to that value. Disclaimer: this code is only type-checked, not tested!

import Control.Monad.State

-- first, we'll rename the type, for convenience
type Programmable a = StateT [a->a] (State a)

-- add a function to the stack of functions that can be applied
-- notice that we just use the normal State functions when dealing
-- with the first type of state
add :: (a -> a) -> Programmable a ()
add f = modify (f:)

-- add a bunch of functions to the stack
-- this time, notice that Programmable a is just a monad
addAll :: [a -> a] -> Programmable a ()
addAll = mapM_ add

-- this applies a function directly to the stored state, bypassing the function stack
-- notice that, to use State functions on the second type of state, we must use
-- lift to get to that layer
modify' :: (a -> a) -> Programmable a ()
modify' f = lift (modify f)

-- pop one function off the stack and apply it
-- notice again the difference between modify' and modify. we use modify' to modify the value
-- and modify to modify the function stack. This is again because of the order in which we wrapped
-- the two states. If we were dealing with StateT a (State [a->a]), it would be the opposite.
step :: Programmable a ()
step = do
  fs <- get
  let f = if (null fs) then id else (head fs)
  modify' f
  modify $ if (null fs) then id else (const (tail fs))

-- run the whole 'program'
runAll :: Programmable a ()
runAll = do
  fs <- get
  if (null fs) then (return ()) else (step >> runAll)

On Sat, Feb 28, 2009 at 8:31 AM, Daniel Fischer <daniel.is.fischer@web.de> wrote:
Am Samstag, 28. Februar 2009 13:23 schrieb Phil:
> Hi,
>
> The problem is ­ HOW DO I WRAP ANOTHER INDEPENDENT STATE AROUND THIS?
>
> After some googling it looked like the answer may be Monad Transformers.
> Specifically we could add a StateT transform for our Box Muller state to
> our VanDerCorput State Monad.
> Google didnıt yield a direct answer here ­ so Iım not even sure if my
> thinking is correct, people describe the process of using a transform as
> Œwrapping one monad in anotherı or Œthreading one monad into anotherı.
> What we want to do is have some internal state controlled by an independent
> outer state -  this sounds about right to me?

If you absolutely don't want to have a state describing both, yes.

>
> So I started playing around with the code, and got the below to compile.
>
> test ::  StateT (Bool,Double) (State Int) Double
> test = do (isStored,normal) <- get
>           let (retNorm,storeNorm) = if isStored
>                                     then (normal,0)
>                                     else (n1,n2)
>                                             where
>                                               n1 = 2
>                                               n2 = 3
>           put (not isStored, storeNorm)
>           return retNorm
>
> Now this is incomplete and may be even wrong!  Iıll Explain my thinking:
>
> (Bool,Double) is equivalent to myState and storedNormal in the C example
> The last Double is the return value of the BoxMuller Monad
> The (State Int) is supposed to represent the VanDerCorput monad ­ but the
> compiler (GHC 6.10) will only let me specify one parameter with it ­ so
> Iıve put the state and left the return type to the gods!!.... As I said
> this isnıt quite right ­ any ideas how to specify the type?

You can't, the second argument to StateT must be a Monad, hence a type
constructor you can pass an arbitrary type which then produces a new type
from that.
Fortunately, you don't need to.

Say you have

type VDCMonad = State Int

nextVDC :: VDCMonad Double
nextVDC = do
       n <- get
       put $! (n+1)
       return $ calculateVDCFromInt n

Then you could have

boxMullerVDC :: StateT (Maybe Double) VDCMonad Double
boxMullerVDC = StateT $ \s -> case s of
                               Just d -> return (d,Nothing)
                               Nothing -> do
                                       d1 <- nextVDC
                                       d2 <- nextVDC
                                       let (b1,b2) = boxMullerTransform d1 d2
                                       return (b1,Just b2)

(I find a state of Maybe a more natural to indicate that *maybe* I have one a
in store to use directly, than using (Bool,a)).

However, I suspect that you would get better code if you abstracted over the
sequence of pseudorandom Doubles and had simply

calculation :: Sate [Double] whatever
calculation = ???

result = evalState calculation bmVDC

bmVDC = boxMuller $ map vanDerCorput [1 .. ]
       where
               boxMuller (k:n:more) = u:v:boxMuller more
                   where
                       (u,v) = bmTransform k n

>
> The next few lines get and test the BoxMuller state, this seems to work OK
> to me, the problem is when I try to look at the STATE OF THE INTERNAL
> monad. n1 and n2 should evaluate and increment the state of VanDerCorput
> monad ­ but I canıt get anything to compile here.  2 and 3 are just dummy
> values to make the thing compile so I could debug.
>
> My last gripe is how to actually call this from a pure function ­ do I need
> to use both evalStateT and evalState ­ I canıt see how to initialize both
> the inner and outer state ?

result = evalState (evalStateT calculation Nothing) 1

>
> OK ­ I think thatıs more than enough typing, apologies for the war&peace
> sized post.
>
> Any help muchly muchly appreciated,
>
> Many Thanks,
>
> Phil.

HTH,
Daniel

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe