[Haskell-cafe] Why is Haskell flagging this?
Ryan Ingram
ryani.spam at gmail.com
Thu Dec 23 18:14:45 CET 2010
Haha, not exactly.
You can replace
sj <- get
let (a, sk) = runState something sj
put sk
with
a <- something
Also, you don't need do notation for single statements; "do return x" is
just "return x"
On Wed, Dec 22, 2010 at 7:21 PM, michael rice <nowgate at yahoo.com> wrote:
> Thanks for the tip, Ozgur. It worked for me. Is this what you had in mind,
> Ryan?
>
> Michael
>
> ==============
>
> import Control.Monad.State.Lazy
>
> import Control.Monad
> import System.Random
>
> type GeneratorState = State StdGen
> data Craps a = Roll a | Win a | Lose a deriving (Show)
>
> genRandomR :: Random a => (a,a) -> GeneratorState a
> genRandomR = state . randomR
>
> rollDie :: GeneratorState Int
> rollDie = genRandomR (1,6)
>
> roll2Dice :: GeneratorState Int
> roll2Dice = liftM2 (+) rollDie rollDie
>
> f :: Craps [Int] -> GeneratorState (Craps [Int])
> f (Roll []) = do g0 <- get
> let (throw1,g1) = runState roll2Dice g0
> put g1
> case throw1 of
> 2 -> return (Lose [throw1])
> 3 -> return (Lose [throw1])
> 7 -> return (Win [throw1])
> 11 -> return (Win [throw1])
> _ -> do g1 <- get
> let (throw2,g2) = runState roll2Dice g1
> put g2
> if throw2 == throw1
> then do return (Win [throw1,throw2])
> else
> if throw2 == 7
> then do return (Lose [throw1,throw2])
> else do f (Roll [throw1,throw2])
> f (Roll z@(throw1:throws)) = do g0 <- get
> let (throw,g1) = runState roll2Dice g0
> put g1
> if throw == throw1
> then do return (Win (z ++ [throw]))
> else
> if throw == 7
> then do return (Lose (z ++ [throw]))
> else do f (Roll (z ++ [throw]))
>
>
>
> --- On *Wed, 12/22/10, Ozgur Akgun <ozgurakgun at gmail.com>* wrote:
>
>
> From: Ozgur Akgun <ozgurakgun at gmail.com>
>
> Subject: Re: [Haskell-cafe] Why is Haskell flagging this?
> To: "Ryan Ingram" <ryani.spam at gmail.com>
> Cc: haskell-cafe at haskell.org, "Daniel Fischer" <
> daniel.is.fischer at googlemail.com>
> Date: Wednesday, December 22, 2010, 7:37 PM
>
>
> see also:
> http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-State-Lazy.html#v:state
>
> On 22 December 2010 20:02, Ryan Ingram <ryani.spam at gmail.com<http://mc/compose?to=ryani.spam@gmail.com>
> > wrote:
>
> Interesting. In that case,
>
> state f = StateT $ \s -> Identity (f s)
>
> allows "state" to replace "State" in that code.
>
>
> Ozgur
>
> -----Inline Attachment Follows-----
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org <http://mc/compose?to=Haskell-Cafe@haskell.org>
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20101223/c967f8ea/attachment.htm>
More information about the Haskell-Cafe
mailing list