How to nondeterministically put a value in a state? - haskell

In the following code, how can I replace put 1 with some code that insert nondeterministically 1 or 2 in the state?
import Control.Monad.List
import Control.Monad.Trans.State
test :: StateT Int [] Int
test = do
put 1
v <- get
return v

Your monad stack signature is already the correct one.
Lift a computation from the [] monad and bind to its value. This will fork the computation:
test :: StateT Int [] Int
test = do
s <- lift [1,2,3]
put s
v <- get
return v
Testing to see it works:
*Main> runStateT test 10
[(1,1),(2,2),(3,3)]
Not only there are many results, but the state gets included in the nondeterminism as well.
If test had had type ListT (State Int) Int, only the results would have been nondetermistic, the state would have been shared among all the branches in the computation:
test :: ListT (State Int) Int
test = do
s <- ListT $ return [1,2,3]
put s
v <- get
return v
The result:
*Main> runState (runListT test) 10
([1,2,3],3)

maybe you want something like this instead:
import Control.Monad.List
import Control.Monad.Trans.State
import System.Random (randomIO)
test :: StateT Int IO Int
test = do
put1 <- liftIO $ randomIO
put (if put1 then 1 else 2)
v <- get
return v
This will use the global generator to set 1 or 2 at random

Related

Interrupting lengthy pure computation in MonadState

I can't grasp the correct way of interrupting lengthy pure computation on SIGINT signal.
In the simple example below, I have slowFib function that simulates lengthy computation. When it is run just in IO monad I can terminate it with C-c (using async to spawn worker).
However, when I put computation inside MonadState, MonadIO stack it no longer work... On the other hand, simple threadDelay in the same stack still can be terminated.
The code is following:
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Data.Monoid
import Control.DeepSeq
import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad.State
-- import Control.Monad.State.Strict
import System.Posix.Signals
slowFib :: Integer -> Integer
slowFib 0 = 0
slowFib 1 = 1
slowFib n = slowFib (n - 2 ) + slowFib (n - 1)
data St = St { x :: Integer } deriving (Show)
stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
let f = slowFib n
modify $ \st -> st{x=f}
return f
stateWait :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateWait n = do
liftIO $ threadDelay 5000000
return 41
interruptable n act = do
putStrLn $ "STARTING EVALUATION: " <> n
e <- async act
installHandler sigINT (Catch (cancel e)) Nothing
putStrLn "WAITING FOR RESULT"
waitCatch e
main = do
let s0 = St 0
r <- interruptable "slowFib" $ do
let f = slowFib 41
f `deepseq` return ()
return f
r <- interruptable "threadDelay in StateT" $ runStateT (stateWait 41) s0
putStrLn $ show r
r <- interruptable "slowFib in StateT" $ runStateT (stateFib 41) s0
putStrLn $ show r
I suspected that it has something to do with lazy evaluation. I already figured out that in the first example (with just the IO monad) I have to force the result. Otherwise async computation just returns a thunk.
However all my attempts to do something analogous in MonadState failed. Anyway, it seems to be more complicated, since async thread does not return immediately. It waits until the result is computed. For some reason I just cannot terminate it when the pure computation is "blocking".
Any clues?
PS. My use case is too add ability to abort computation in custom Jupyter kernel made using jupyter package. Functions evaluating user input are exactly in MonadState and MonadIO.
The computation seems to be blocked on putStrLn $ show r, i.e. outside the interruptable function. Note that stateFib doesn't force the result, so the async exits almost immediately. The whole work is delayed until putStrLn tries to print the result. Try to force the computation earlier:
stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
let f = slowFib n
modify $ \st -> st{x=f}
f `seq` return f

How to pass a field constructor parameter to a function?

1) I need to pass a field constructor parameter to a function. I made some tests but i was unable to do so. Is it possible? Otherwise, is it possible with lens package?
2) Is it possible in a MonadState to modify a field using modify? (I made a few attempts, but without success. For example: modify (second = "x") does not work.
import Control.Monad.State
data Test = Test {first :: Int, second :: String} deriving Show
dataTest = Test {first = 1, second = ""}
test1 = runStateT modif1 dataTest -- OK
test2 = runStateT (modif2 "!") dataTest -- OK
test3 = runStateT (modif3 second) dataTest -- WRONG
-- modif1 :: StateT Test IO ()
modif1 = do
st <- get
r <- lift getLine
put $ st {second = "x" ++ r}
-- modif2 :: String -> StateT Test IO ()
modif2 s = do
stat <- get
r <- lift getLine
put $ stat {second = "x" ++ r ++ s}
-- modif3 :: ???? -> StateT Test IO ()
modif3 fc = do
stat <- get
r <- lift getLine
put $ stat {fc = "x" ++ r}
-- When i try to load the module, this is the result:
-- ghc > Failed:
-- ProvaRecord.hs:33:16:`fc' is not a (visible) constructor field name
As you said, you're probably looking for lenses. A lens is a value that allows to read, set or modify a given field. Usually with Control.Lens, you define fields with underscores and you use makeLenses to create full-featured lenses.
There are many combinators that allow lenses to be used together within MonadState. In your case we can use %=, which in this case would be specialized to type
(MonadState s m) => Lens' s b -> (b -> b) -> m ()
which modifies a state value using a given lens and a function that operates on the inside value.
Your example could be rewritten using lenses as follows:
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
data Test = Test { _first :: Int
, _second :: String
}
deriving Show
-- Generate `first` and `second` lenses.
$(makeLenses ''Test)
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
r <- lift getLine
l %= (++ r)
dataTest :: Test
dataTest = Test { _first = 1, _second = "" }
test :: IO Test
test = execStateT (modif second) dataTest

Monad transformers: IO and state

This question is close to ground covered elsewhere, but I haven't found anything that addresses it specifically (at least not in a way that I'm able to understand).
I'd like to update state in a way that depends on various random choices. Because of the instance of the RandomSource typeclass that I'm using, all of these random choices live in the IO monad, as below:
main :: IO Int
main = do
a <- pickRand [1..7]
return a
where pickRand lst = runRVar (choice lst) DevRandom
What I'd like to do is something like the following: store a state of type [Int], and if the randomly chosen list element a is greater than 3 , push it onto the state. Any tips?
import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.IO.Class
import Data.Random.RVar
import Data.Random.Source.DevRandom
import Data.Random.List
myFun :: StateT [Int] IO ()
myFun = do
lst <- get
r <- liftIO $ runRVar (randomElement lst) DevRandom
put $ if r > 3 then (r:lst) else lst
return ()
main :: IO ()
main = evalStateT myFun [1..10] >>= print

Maybe monad inside stack of transformers

I have the following code:
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.State
type T = StateT Int IO Int
someMaybe = Just 3
f :: T
f = do
x <- get
val <- lift $ do
val <- someMaybe
-- more code in Maybe monad
-- return 4
return 3
When I use do notation inside to work in Maybe monad it fails. From the error it gives it looks like type signature for this do doesn't match. However I have no idea how to fix it. I tried some lift combinations, but none of them worked and I don't want to guess anymore.
The problem is that Maybe is not part of your transformer stack. If your transformer only knows about StateT Int and IO, it does not know anything about how to lift Maybe.
You can fix this by changing your type T to something like:
type T = StateT Int (MaybeT IO) Int
(You'll need to import Control.Monad.Trans.Maybe.)
You will also need to change your inner do to work with MaybeT rather than Maybe. This means wrapping raw Maybe a values with MaybeT . return:
f :: T
f = do
x <- get
val <- lift $ do
val <- MaybeT $ return someMaybe
-- more code in Maybe monad
return 4
return 3
This is a little awkward, so you probably want to write a function like liftMaybe:
liftMaybe = MaybeT . return
If you used lift to lift IO a values in other parts of your code, this will now break because you have three levels in your transformer stack now. You will get an error that looks like this:
Couldn't match expected type `MaybeT IO t0'
with actual type `IO String'
To fix this, you should use liftIO for all your raw IO a values. This uses a typeclass to life IO actions through any number of transformer layers.
In response to your comment: if you only have a bit of code depending on Maybe, it would be easier just to put the result of the do notation into a variable and match against that:
let maybeVal = do val <- someMaybe
-- more Maybe code
return 4
case maybeVal of
Just res -> ...
Nothing -> ...
This means that the Maybe code will not be able to do an IO. You can also naturally use a function like fromMaybe instead of case.
If you want to run the code in the inner do purely in the Maybe monad, you will not have access to the StateT Int or IO monads (which might be a good thing). Doing so will return a Maybe value, which you will have to scrutinize:
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.State
type T = StateT Int IO Int
someMaybe = Just 3
f :: T
f = do
x <- get
-- no need to use bind
let mval = do
-- this code is purely in the Maybe monad
val <- someMaybe
-- more code in Maybe monad
return 4
-- scrutinize the resulting Maybe value now we are back in the StateT monad
case mval of
Just val -> liftIO . putStrLn $ "I got " ++ show val
Nothing -> liftIO . putStrLn $ "I got a rock"
return 3

Monadic way to read bits from Get monad

I need to read some amount of bits from Get monad. Now my code looks like
readBits :: Int -> Int -> Get (Word32, Int)
readBits count state = ...
readValue :: Get (Word32, Word32)
readValue = do
-- read fst bit count
(bits1, s0) <- readBits 5 0
-- read bits1 bits as fst
(fst, s1) <- readBits bits1 s0
-- read snd bit count
(bits2, s2) <- readBits 5 s1
-- read bits2 bits as snd
(snd, s3) <- readBits bits2 s2
-- flush incomplete byte
when (s3 /= 0) $ skip 1
return (fst, snd)
I want to wrap this into some kind of state monad, to have code like
readBits :: Int -> BitReader Word32
readBits count = ...
runBitReader :: BitReader a -> Get a
readValue :: Get (Word32, Word32)
readValue = runBitReader $ do
bits1 <- readBits 5
fst <- readBits bits1
bits2 <- readBits 5
snd <- readBits bits2
return (fst, snd)
What functions should I implement? How should they be implemented?
I have looked into Get and BitGet source code, but not fully understand what's going on.
This is the most typical usecase for Monad Transformers.
You have defined most of the structure correctly. To answer your questions
What functions should I implement?
Well you first need to wrap Get monad into the StateT Transformer to get BitReader.
You need to implement proper definition for readBits using get to get the current state and put to save the state back.
You need to run your code wrapped in BitReader to get back the output in Get Monad. So you need to define runBitReader using runStateT.
To answer your next question.
How should they be implemented?
I have given the possible implementation. You still need to define some functions to make it work.
import Control.Monad.State
import qualified Control.Monad.State as ST
import Data.Binary
type BitReader = StateT Int Get
readBits' :: Int -> Int -> Get (Word32, Int)
readBits' = undefined
readBits :: Int -> BitReader Word32
readBits n = do
s0 <- ST.get
(a,s1) <- lift $ readBits' n s0
ST.put s1
return a
runBitReader :: BitReader a -> Get a
runBitReader w = do
(a,s) <- runStateT w 0
return a
readValue = do
fst <- readBits 5
snd <- readBits 10
return (fst, snd)
I don't know how looking into code of Get was going to help you. You were looking in the wrong house. You need to read about State Monads and Monad Transformers.
You can read more about monad transformers here.

Resources