[Haskell-cafe] Beginner: IORef constructor?

TJ tjay.dreaming at gmail.com
Fri Dec 1 06:22:23 EST 2006


Thanks for the demo. I don't actually understand what's going on yet,
but your code doesn't  really use a global variable, does it? From
what I can understand, the main function is passing the State to the
other functions.

I think I was careless about mixing "IO functions" and normal
functions. Now that I think about it, my "global variable" really
should only be available to IO functions, so the following should be
just fine:

----------------------------------------------------------
module Global where

import Data.IORef

theGlobalVariable = newIORef []

testIt = do ref <- theGlobalVariable
            original <- readIORef ref
            print original
            writeIORef ref [1,2,3]
            new <- readIORef ref
            print new
----------------------------------------------------------

I've got a lot to learn about Haskell...

On 12/1/06, Donald Bruce Stewart <dons at cse.unsw.edu.au> wrote:
> tjay.dreaming:
> > Thanks. I've been reading the docs and examples on State (in
> > Control.Monad.State), but I can't understand it at all. ticks and
> > plusOnes... All they seem to do is return their argument plus 1...
>
> Here's a little demo. (I agree, the State docs could have nicer demos)
>
> Play around with the code, read the haddocks, and it should make sense
> eventually :)_
>
> -- Don
>
>
>     import Control.Monad.State
>
>     --
>     -- the type for a 'global' 'variable'
>     --
>     data T = T { ref :: Int }
>
>     -- Run code with a single global 'ref', initialised to 0
>     main = evalStateT g $ T { ref = 0 }
>
>     -- set it to 10
>     g = do
>         printio "g"
>         putRef 10
>         printio "modified state"
>         f
>
>     -- read that ref, print it
>     f = do
>         r <- getRef
>         printio r
>         return ()
>
>     getRef = gets ref
>
>     putRef x = modify $ \_ -> T { ref = x }
>
>     printio :: Show a => a -> StateT T IO ()
>     printio = liftIO . print
>


More information about the Haskell-Cafe mailing list