[Haskell-cafe] Monad transformer: apply StateT to List monad

michael rice nowgate at yahoo.com
Fri Jan 14 07:12:06 CET 2011


Thanks, John. Too late to do much now, but it looks like what I was needing, and more.  May have more questions after I examine it more closely tomorrow.

Michael

--- On Fri, 1/14/11, John Millikin <jmillikin at gmail.com> wrote:

From: John Millikin <jmillikin at gmail.com>
Subject: Re: [Haskell-cafe] Monad transformer: apply StateT to List monad
To: "michael rice" <nowgate at yahoo.com>
Cc: haskell-cafe at haskell.org
Date: Friday, January 14, 2011, 1:00 AM

Lifting 'f' into StateT -- you get a list of (result, state) pairs. Since the state is never modified, the second half of each pair is identical:

--------------------------------------------------------------------------


import Control.Monad.State

f :: Int -> [Int]
f n = [0..n]

-- lifting 'f' into State, I use 'Char' for the state so you
-- can see which param it is
liftedF :: Int -> StateT Char [] Int


liftedF n = lift (f n)

-- prints [(0,'a'),(1,'a'),(2,'a'),(3,'a'),(4,'a')]
--
-- 4 is n , 'a' is the state
main = print (runStateT (liftedF 4) 'a')



--------------------------------------------------------------------------
 
Lifting 'tick' into ListT -- you get a single pair, the first
half is a list with one value, which is whatever 'tick'


returned:



--------------------------------------------------------------------------
import Control.Monad.List

type GeneratorState = State Int

tick :: GeneratorState Int
tick = do
    n <- get
    put (n + 1)


    return n

liftedTick :: ListT GeneratorState Int
liftedTick = lift tick

-- prints ([4],5)
--
-- 4 is the initial state, 5 is the final state
main = print (runState (runListT liftedTick) 4)




--------------------------------------------------------------------------

Generally, monad transformers aren't used to add new
functionality to existing monadic computations. Instead,
they're used with a generic "Monad m =>" (or similar)


constraint, and modify how that generic result is
returned.

For example, a modified version of 'tick' can have any
monad (including lists) applied to it:



--------------------------------------------------------------------------
tick :: Monad m => StateT Int m Int
tick = do
    n <- get
    put (n + 1)
    return n

-- prints [(0,1),(1,2),(2,3)]


main = print ([0,1,2] >>= runStateT tickTo)


--------------------------------------------------------------------------


On Thu, Jan 13, 2011 at 16:38, michael rice <nowgate at yahoo.com> wrote:




Hi Daniel,

What I need to see is a function, say g, that lifts the function f (in the List monad) into the StateT monad, applies it to the monad's value, say 1, and returns a result [0,1].

Or, alternatively, code that lifts a function in the State monad, say tick



import Control.Monad.State

type GeneratorState = State Int

tick :: GeneratorState Int
tick = do n <- get
          put (n+1)
          return n

into the ListT monad and applies it to a list, say



lst = [0,1,2]

producing [(0,1),(1,2),(2,3)].

Both would be very helpful. Or maybe I'm missing the concept of monad transformers altogether and putting them together improperly, like trying to use a spreadsheet to write a
 letter?

Michael




      
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110113/5c2a64dd/attachment-0001.htm>


More information about the Haskell-Cafe mailing list