[Haskell-beginners] record problem when updating fields with an IO a type
Christian Maeder
Christian.Maeder at dfki.de
Fri Apr 1 16:56:37 CEST 2011
Am 01.04.2011 16:28, schrieb Manfred Lotz:
> Hi there,
> I have a problem where I like to update a record with an IO a. Not
> quite sure how to describe it.
>
> Here is a minimal example: I get a list of numbers from the command
> line and I like to add those numbers n and randome numbers from a
> range from [0..n] in two fields of a record.
>
> <---------------------------snip---------------------------->
> module Main where
>
> import System.Environment.UTF8
> import System.Random
>
> data NumRec = NumRec {
> mxV :: Int,
> mxR :: Int
> } deriving (Show,Read)
>
>
> initNumRec = NumRec { mxV = 0, mxR = 0 }
>
> toInt s = read s :: Int
>
>
think about the type of addRandom!
> addRandom m n = do
> let mxv = mxV m
> let mxr = mxR m
change:
> let r = rand n
> m { mxV = mxv + n,
> mxR = mxr + r }
to:
r <- rand n
return m {....}
>
> rand :: Int -> IO Int
> rand max = getStdRandom (randomR (0, max))
>
>
> main = do
> args<- getArgs
> print args
> let ilist = map toInt args
> let mixed = foldl addRandom initNumRec ilist
use Control.Monad.foldM. I'm not sure if the following will work:
mixed <- foldM addRandom initNumRec ilist
Cheers Christian
> print mixed
> <---------------------------snap---------------------------->
>
> I get the following error when compiling:
>
> [1 of 1] Compiling Main ( minimal.hs, minimal.o )
>
> minimal.hs:22:23:
> Couldn't match expected type `Int' with actual type `IO Int'
> In the second argument of `(+)', namely `r'
> In the `mxR' field of a record
> In the expression: m {mxV = mxv + n, mxR = mxr + r}
>
>
> How can I correct the compile error?
>
>
>
More information about the Beginners
mailing list