[Haskell-cafe] Feedback on use of State monad

Atrudyjane atrudyjane at protonmail.com
Sat Jul 15 05:05:47 UTC 2017


Will need more experience before discerning between beauty and ridiculousness in Haskell code, but your version is helpful nonetheless. Can see that separating out the dice rolls at least makes a big difference. And since there's only one bind, it's readable enough without do syntax. Thank you for your suggestions!
Regards,
Andrea

Sent with [ProtonMail](https://protonmail.com) Secure Email.

> -------- Original Message --------
> Subject: Re: [Haskell-cafe] Feedback on use of State monad
> Local Time: July 14, 2017 3:22 AM
> UTC Time: July 14, 2017 8:22 AM
> From: monkleyon at gmail.com
> To: haskell-cafe at haskell.org
> On 2017-07-13 23:29, Atrudyjane via Haskell-Cafe wrote:
>> runRolls :: State RollsState RollsValue
>> runRolls = do
>> (l, s, c, sg, xs) <- get
>> if (s >= l) then
>> return (c, reverse xs)
>> else
>> do
>> let (d, ng) = randomR (1, 6) sg
>> put (l, s + d, c + 1, ng, intToDie d : xs)
>> runRolls
>>
>> rollsCountState :: Int -> IO ()
>> rollsCountState n = print $ evalState (runRolls) (n, 0, 0, mkStdGen 0, [])
>>
>> I"m wondering if that "do" block under the else is a not so great
>> stylistic choice. If the "let" and "put" is moved above the "if", then
>> that"s just an unnecessary call at the end. Or is it just the nature
>> of running inside a monad?
> It is the nature of running inside a monad. But at the same time,
> runRolls contains the implementation of two things. Which, to a purist
> like me, would be one too many. Pulling one of them out into a second
> function already makes this one much nicer. But there are other, more
> pressing stylistic choices to make. Namely to use records and mnemonic
> names. Here is an adapted version taken to more beauty and then beyond
> into ridiculousness:
> {-# LANGUAGE RecordWildCards , MultiWayIf #-}
> […]
> rollsCountState :: Int -> IO ()
> rollsCountState rollLimit = print $ evalState runRolls initialRollState
> where
> runRolls = get >>= \RollsState{..} ->
> if | rollSum >= rollLimit -> pure (rollCount, reverse rolledDice)
> | otherwise -> modify rollDice >> runRolls
> The “ideal” version is probably somewhere in between. Maybe with one of
> the many whileM or untilM implementations thrown in that everyone keeps
> reinventing.
> Cheers,
> MarLinn
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20170715/33074f4e/attachment.html>


More information about the Haskell-Cafe mailing list