Using IORef in threepenny gui - haskell

I'm trying to set an IORef in threepenny-gui but I can't get it to work. In my app the IORef itself will be more complicated and not itself be displayed - but this example demonstrates the problem I think.
Here is my try:
testIORef2 :: IORef String -> Window -> UI ()
testIORef2 ref window = void $ do
return window # set title "Test IORef"
inCell <- UI.input
outCell <- UI.input
getBody window #+ [
column [
grid [[string " In cell::", element inCell]
,[string "Out cell::" , element outCell ]]
, string "Cells should update while typing."
]]
-- When value changes write to IORef
on UI.valueChange inCell $ \_ -> do
inValue <- get value inCell
liftIO $ writeIORef ref inValue
-- Read the IORef
refVal <- liftIO $ readIORef ref
-- Behaviour which holds the string value in the input cell
inValue <- stepper "0" $ UI.valueChange inCell
-- Behaviour which holds the value in the ref
let outValue = (const refVal) <$> inValue
-- Set the value of the output cell to the outValue
element outCell # sink value outValue
The code sort of works but the outValue is not quite up to date.
How do I fix it so that the updates are on time. Also, any improvements to the code would be welcome.
Thanks.

The code you wrote is probably not what you intended to do. The line
let outValue = (const refVal) <$> inValue
specifies that outValue is a Behavior whose value is constant and equal to refValue. In turn, the latter value is obtained from
refVal <- liftIO $ readIORef ref
which means that its the value stored by IORef at this point in time in the UI monad.
When using IORef, you want to read the value of the reference when something changes, and use this value to modify the UI content, for instance like this:
on UI.valueChange inCell $ \_ -> do
inValue <- get value inCell
liftIO $ writeIORef ref inValue
outValue <- liftIO $ readIORef ref
element outCell # set value outValue
For reasons of consistency (order of operations), it is not advisable to use an IORef as a source for a Behavior — it's either the latter or the former.

I'm not an expert on threepenny-gui, but here's my guess.
The code you write outside the on event handler is executed just once. You therefore want to include the outValue update inside said handler, e.g.
-- When value changes write to IORef
on UI.valueChange inCell $ \_ -> do
inValue <- get value inCell
liftIO $ writeIORef ref inValue
... -- compute outValue
element outCell # sink value outValue

Related

How to use Atomics Counter for counting operation order of randomly occuring operations on different threads?

What I'd like to do is something like this where every time one of these print actions occurs it updates the counter to ensure that the next subsequent occurrence of a print action will always have the correct order in which it occurred among any of the possible print actions that may occur across multiple threads shown by the counter. The problem in my example is that if the IORef is read at the same time between threads then two or more print actions will have the same counter value. From what I've read it seems that using the Data.Atomics.Counter library would solve this problem but i am having a really hard time understanding how to use it do so. Can anyone show me an example or try to explain it to me please?
main = do
myref <- newIORef 1 :: IO (IORef Int)
void(forkIO (forever $ do ref <- readIORef myref
print ("hi " ++ show (ref))
modifyIORef myref (+1) ))
void(forkIO (forever $ do ref <- readIORef myref
print ("hey " ++ show (ref))
modifyIORef myref (+1) ))
forever $ do ref <- readIORef myref
print ("hello " ++ show (ref))
modifyIORef myref (+1)
I would use an MVar for this.
inc mvar = forever $ do
v <- takeMVar mvar
print v
putMVar mvar (v+1)
main = do
mvar <- newMVar 1
forkIO (inc mvar)
forkIO (inc mvar)
inc mvar
It is important that the print occur between takeMVar and putMVar, while the MVar is empty; otherwise another thread may empty the MVar and execute its print.
You could use atomicModifyIORef'. It would look something like:
increment ref = forever do
val <- atomicModifyIORef' ref \old -> (old + 1, old)
print val
main = do
ref <- newIORef 0
forkIO $ increment ref
forkIO $ increment ref
increment ref

IO action in a when statement

Can anyone tell me why I cannot add a IO statement within a do block? This code only prints "test" and then completes execution. The last two lines do not seem to be executing.
putStrLn "Do you want to add a task. Press y to add:"
option <- getChar
when (option == 'y') $ do
print "test"
newText <- getLine
appendFile "todoList.txt" (newText ++ "\n")
getChar will peak the y char but will let the \n in the input stream.
So you need to flush the input stream before going further.
Alternatively you can use the readLn providing you define a new data type:
data Choice = Y | N
deriving (Read, Show, Eq)
putStrLn "Do you want to add a task. Press y to add:"
option <- readLn
when (option == Y) $ do
print "test"
getLine >>= appendFile "todoList.txt" . (++"\n")

Pipeline-like operation using TChan

I want to implement a pipeline between two threads. I have thread A that take the data, process it, and send it to thread B. I have a MVar that check if the data is completely processed
However, I'm having an exception *** Exception: thread blocked indefinitely in an STM transaction
Why are my threads blocked? I though than when the first thread write on the channel, then when there is a data on the channel, the second one can read it
fstPipe :: (a -> b) -> TChan b -> MVar () -> [a] -> IO ()
fstPipe f chIn m xs = do
( mapM_(\x-> atomically $ writeTChan chIn $ f x) xs) >> putMVar m ()
pipelineDone channel mIn = do
isDone <- fmap isJust $ tryTakeMVar mIn
isEmpty <- atomically $ isEmptyTChan channel
return $ isDone && isEmpty
lastPipe f chIn mIn = iter
where iter = do
atomically $ fmap f $ readTChan chIn
isDone <- pipelineDone chIn mIn
unless isDone $ iter
pipeline = do
chIn <- atomically newTChan
m <- newEmptyMVar
first <- async $ fstPipe reverse chIn m $ replicate 10 [1..500]
last <- async $ lastPipe print chIn m
wait first
wait last
It seems odd to me to be using STM and semaphores in the same code block... Why not do the entire thing in STM?
In particular, why not a TChan (Maybe x), with Nothing indicating the end of the sequence?
Also, notice that your fstPipe likely just generates a bunch of unevaluated thunks and immediately chucks them into the TChan, without actually computing anything. You probably want a seq or similar in there to force some actual work to happen on that thread.
I think there's a race condition:
stop fstPipe just before the putMVar
advance lastPipe to read everything, and then call pipelineDone
pipelineDone returns False since putMVar was not yet done
lastPipe will try to read from the channel
putMVar executes, but it's too late
Now lastPipe is stuck reading on an empty channel.
Your problem is in the logic of pipelineDone. Currently, you have:
pipelineDone channel mIn = do
isDone <- fmap isJust $ tryTakeMVar mIn
isEmpty <- atomically $ isEmptyTChan channel
return $ isDone && isEmpty
tryTakeMVar is going to take the contents of the MVar assuming there is something in there. Assuming your producer finishes first, it is going to write () into the MVar. Your consumer is then going to try and take the contents of it. If it succeeds, then the MVar goes empty. Any subsequent tryTakeMVar will always return Nothing, thus isDone && isEmpty will always return false and you will keep trying to read from the TChan. Once the TChan goes empty, GHC can tell you that it has encountered a deadlock.
You should instead change your pipelineDone implementation to:
pipelineDone channel mIn = do
stillRunning <- isEmptyMVar mIn
isEmpty <- atomically $ isEmptyTChan channel
return $ (not stillRunning) && isEmpty
This will instead simply poll the MVar, instead of actually emptying it.

Using FRP and IORef in threepenny-gui

I have a little example using IORef in threepenny-gui (TPG):
testIORef :: IORef String -> Window -> UI ()
testIORef ref window = void $ do
return window # set title "Test IORef"
inCell <- UI.input
outCell <- UI.input
-- When value changes write to IORef
on UI.valueChange inCell $ \_ -> do
inValue <- get value inCell
liftIO $ writeIORef ref inValue
-- function that reads the IORef and sets the value of an element with it
let setValue oc = do
newVal <- liftIO $ readIORef ref
element oc # set value newVal
-- When enter is pressed update the value of the output
on UI.keydown inCell $ \c -> if (c==13) then setValue outCell else return outCell
getBody window #+ [ column [ grid [[string "In cell :", element inCell]
,[string "Out cell:", element outCell]
]
, string "Cells should update while typing."
]
]
I am trying to change this to use the Reactive stuff in TPG. I have got as far as making the Behaviors from the events valueChange and keyDown:
inValue <- stepper "0" $ UI.valueChange inCell
inEnter <- stepper "0" $ fmap show $ filterE (\kc-> kc==13) $ UI.keydown inCell
But I am stuck on how to use these Behaviors to save/get the value to/from the IORef. The problem is that the IORef calls will be in the UI monad, so if I use them the Behaviour will be Behavior (UI a), but then they won't work with sink. I know in this case I needn't use an IORef (eg. the currency conversion example) - but in my actual case I do.
EDIT:
I tried writing my own attribute:
valueUI :: ReadWriteAttr Element (UI String) String
so that I can set an attribute with a Behavior (UI String):
inEnter <- stepper "0" $ fmap show $ filterE (\kc-> kc==13) $ UI.keydown inCell
let getValue = fmap (const $ liftIO $ readIORef ref) inEnter
element outCell # sink valueUI getValue
The code compiles but doesn't work.

Simple counter in IO

I'm trying to create a simple counter which increases by 1 indefinitely, using IO.
I've been scratching my head ever since...
Ideally, I would like to do something along the lines of
tick = do putStr (counter)
counter + 1
where counter = 0
Then repeat the process. Then repeat the first 2 expressions. Or something along the lines of:
tick = tick'
where
counter = 1
tick' counter | counter > 0 = do putStrLn (show counter)
tick' (counter + 1)
| otherwise = tick
Which gives me errors :/
Any help is appreciated :)
There are a couple ways to do this without using a mutable cell. You already did it with your second attempt, there's just a little error. You need to pass an initial value to the tick' function, not "set it" (haskell does not have an idea of assigning variables -- only definitions. If the line x = y appears, x will be y for its entire lifetime).
tick = tick' 0
where ...
The counter = 0 line is not doing anything; it is defining a name that is never used. The counter used in the tick' function is bound as one of its arguments (and shadows the one defined to be 0). Take some time to stare at it with that in mind, see if that makes sense.
There is a nice "higher order" way we can do this too. Essentially we want to run the infinitely long block of code:
do
print 0
print 1
print 2
...
There is a function called sequence :: [IO a] -> IO [a] (see caveat below) that will take a list of actions and construct an action. So if we can construct the list [print 0, print 1, print 2, ...] then we can pass it to sequence to build the infinitely long block we are looking for.
Take note here, this is a very important concept in Haskell: [print 0, print 1, print 2] does not print those three numbers then construct the list [0,1,2]. Instead it is itself a list of actions, whose type is [IO ()]. Making the list does nothing; it is only when you bind an action to main that it will be executed. For example, we might say:
main = do
let xs = [putStrLn "hello", getLine >> putStrLn "world"]
xs !! 0
xs !! 0
xs !! 1
xs !! 1
xs !! 0
This would twice print hello, twice get a line and print world after each, then once print hello again.
With that concept, it is easy to build the list of actions [print 0, print 1, ...] with a list comprehension:
main = sequence [ print x | x <- [0..] ]
We can simplify a bit:
main = sequence (map (\x -> print x) [0..])
main = sequence (map print [0..])
So map print [0..] is the list of actions [print 0, print 1, ...] we were looking for, then we just pass that to sequence which chains them together.
This pattern of sequence is common, and has its own mapM:
mapM :: (a -> IO b) -> [a] -> IO [b]
mapM f xs = sequence (map f xs)
Thus:
main = mapM print [0..]
About as simple as you could want.
One note about performance: since we are not using the output of these functions, we should be using sequence_ and mapM_, with trailing underscores, which are optimized for that purpose. Usually this wouldn't matter in a Haskell program because of garbage collection, but in this particular use case is kind of a special case because of various subtleties. You'll find that without the _s, the memory usage of your program gradually grows as the list of results (in this case [(),(),(),...]) is constructed but never used.
Caveat: I have given the type signatures of sequence and mapM specialized to IO, not a general monad, so that the reader does not have to learn about the orthogonal concepts of actions having types and typeclasses at the same time.
Well, let's go back to basics. What you want appears to be an IO action that when bound, prints and increments a counter? I'm going to work from that assumption.
The first thing you need is some mutable cell, since you're using the same action each time. It needs to have something mutable inside it to do something different each time it's used. I'd go with an IORef for this case.
But keeping that IORef hidden is a bit tricky. Especially since globals are bad. The best way to do it is create the IO action from inside another IO action, and then close over the IORef. Doing so gives you something like this:
import Data.IORef
mkCounter :: IO (IO ())
mkCounter = do
ref <- newIORef 0
return $ do
counter <- readIORef ref
print counter
writeIORef ref $ counter + 1
This can be used by doing something like this:
main = do
tick <- mkCounter
tick
tick
tick
Your second implementation is really close!
tick = tick'
where
counter = 1
tick' counter | counter > 0 = do putStrLn (show counter)
tick' (counter + 1)
| otherwise = tick
Let's look at the errors for this:
Couldn't match expected type `IO b0' with actual type `a0 -> IO b0'
In the expression: tick'
Let's add some types to make sure we're getting what we want.
tick is an IO action. We don't care what value the action encapsulates, since the whole
point of it is to run forever.
tick :: IO a
Now our error is:
Couldn't match expected type `IO a' with actual type `a0 -> IO b0'
In the expression: tick'
Well, that's pretty much the same, no help there. Let's keep going.
tick' is a function that takes some integer and returns an IO action
that prints the integer and repeats tick' on the next value. Again, we don't care what
value the action encapsulates, since it runs forever.
tick' :: Int -> IO b
Wait, now that error makes sense! We defined tick = tick', but the two things have fundamentally different types. One is an action (tick) one is a function that returns an action (tick'). All we need to do is give tick' some value to get the action, so let's do that.
You'd tried to do that by saying where counter = 1 but all that did is define counter as 1 within the statement tick = tick', and since counter isn't mentioned there, it wasn't used.
When you said tick' counter | ... =, you weren't referring to the same counter as on the line above. There, you were defining another variable called counter that was only in scope within the definition of tick'.
So now our code looks like:
tick :: IO a
tick = tick' 1
where
tick' :: Int -> IO b
tick' counter | counter > 0 = do putStrLn (show counter)
tick' (counter + 1)
| otherwise = tick
If we try to compile it, ghc doesn't complain, and if we try it out in ghci it runs as desired:
% ghci
ghci> :l Tick.hs
Ok, modules loaded: Tick.
ghci> tick
1
2
3
...
25244
^C
Interrupted
ghci>
For a simple infinite counter just use recursion:
counter n = do print n
counter (n+1)
main = counter 1
Yet another way to implement tick functionality without using mutable state is to mix State and IO monad using monad transformers:
import Control.Monad.State
type Ticking a = StateT Int IO a
tick :: Ticking ()
tick = do
modify succ
get >>= liftIO . print
getCounterValue :: Ticking Int
getCounterValue = get
Then you can use it to create 'ticking' IO functions (with nuisance: IO functions here need to be prefixed with liftIO since it is now Ticking a monad not IO a):
ticking :: Ticking ()
ticking = do
liftIO $ putStrLn "Starting"
tick
tick
c <- getCounterValue
liftIO $ do
putStrLn ("Finished at " ++ show c)
putStrLn "Press any Enter to start infinite counter"
getChar
forever tick
Which can be converted into 'normal' IO using runStateT (with initial counter value):
startTicking :: Ticking a -> Int -> IO a
startTicking = evalStateT
So:
main :: IO ()
main = startTicking ticking 0
A forkIO safe version similar to Carl's answer using STM is
import Control.Concurrent.STM
import Control.Monad (replicateM_)
import Control.Monad(forever)
makeCounter :: IO (IO Int)
makeCounter = do
var <- newTVarIO 0
return $ do
atomically $ do
value <- readTVar var
modifyTVar var (+1)
readTVar var
-- a version that only counts from 1 to 10
main1:: IO ()
main1 = do
counter <- makeCounter
replicateM_ 10 $ counter >>= print
-- a version that counters forever
main2 :: IO ()
main2 = do
counter <- makeCounter
forever $ do
x<- counter
print x
main :: IO ()
main = do
counter <- makeCounter
tick<- counter
tick<- counter
print tick -- 2
Reference:
Mutable closures in Haskell and nested IO
An EXERCISE from STM tutorial
Mutable State in Haskell

Resources