
I don't know if this will help or not, but there's a basic StateT
example on the haskell wiki that you could look at, to see how to deal
with State in general. The code is at
http://www.haskell.org/haskellwiki/Simple_StateT_use and is thanks to
Don Stewart. Maybe I'll just paste the code with a few more comments
(with the warning that I'm a newbie as well):
import Control.Monad.State
main :: IO ()
main = runStateT code [1..] >> return ()
-- Here, the state is just a simple stack of integers. runStateT is
the equivalent
-- in the StateT monad of runState in the State monad
code :: StateT [Integer] IO ()
code = do
x <- pop -- pop an item out of the stack
io $ print x -- now in the INNER monad, perform an action
return ()
--
-- pop the next unique off the stack
--
pop :: StateT [Integer] IO Integer
-- This type signature is correct, but it's the reason you have to be
-- careful with StateT. pop really has nothing to do with IO, but it has
-- been 'tainted' by IO because it's being done together with it
pop = do
(x:xs) <- get -- get the list that's currently in the stack
put xs -- put back all but the first
return x -- return the first
io :: IO a -> StateT [Integer] IO a
-- transform an action from being in the inner monad (in this case IO), to
-- being in the outer monad. since IO is so familiar, it's been written already
-- and it's called liftIO
io = liftIO
Gurus, please check my comments to be sure I haven't said something stupid!
Hope this helps.
Andrew
On 2/26/07, Alfonso Acosta
On 2/27/07, Kirsten Chevalier
wrote: So what if you changed your netlist function so that the type sig would be:
netlist :: DT.Traversable f => (State s (S HDPrimSignal) -> State s v ) -> -- new (State s (Type,v) -> S v -> State s ()) -> -- define State s (f HDPrimSignal) -> -- the graph IO (State s ())
Or why not:
netlist :: DT.Traversable f => (State s (S HDPrimSignal) -> State s v ) -> -- new (State s (Type,v) -> S v -> State s ()) -> -- define State s (f HDPrimSignal) -> -- the graph IO s
Uhm, this looks better, I'll try with this one and see what I get, I anyway suspect I'll have a hard time because of the nested monads _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe