I'm writing some code with reactive-banana and gtk2hs that needs to read from a file handle. I need to have at least two threads (one to read keyboard events with reactive banana and one to read from the file handle), so at the moment I have code that looks something like this:
type EventSource a = (AddHandler a, a -> IO ())
fire :: EventSource a -> a -> IO ()
fire = snd
watch :: EventSource ByteString -> Handle -> IO ()
watch textIn pty = forever $
hGetLine pty >>= fire textIn >> threadWaitRead pty
With the following main function:
mainAxn :: IO ()
mainAxn = do
h <- openFile "foo" ReadMode
initGUI
win <- windowNew
txt <- textViewNew
containerAdd win txt
widgetShowAll win
(keyPress, textIn) <-
(,) <$> newAddHandler <*> newAddHandler
network <- setupNetwork keyPress textIn
actuate network
_ <- forkIO $ watch textIn h
_ <- win `on` keyPressEvent $
eventKeyVal >>= liftIO . fire keyPress >> return True
mainGUI
and my event network set up as follows:
setupNetwork :: EventSource KeyVal -> EventSource ByteString -> IO EventNetwork
setupNetwork keyPress textIn = compile $ do
ePressed <- fromAddHandler $ addHandler keyPress
eText <- fromAddHandler $ addHandler textIn
reactimate $ print <$> (filterJust $ keyToChar <$> ePressed)
reactimate $ print <$> eText
(except in my actual code, those reactimate calls write to the TextView built in mainAxn). I found that I needed to build with -threaded to make the event network correctly capture both text from textIn and keypresses from keyPress, which caused issues because it's not safe to modify objects from the gtk package concurrently.
At the moment, I have postGUIAsync calls scattered throughout my code, and I've found that using postGUISync causes the whole thing to deadlock --- I'm not sure why. I think it's because I end up calling postGUISync inside of the same thread that ran mainGUI.
It seems like it would be better to run all of the GUI stuff in its own thread and use the postGUI* functions for every access to it. However, when I change the last line of mainAxn to be
forkIO mainGUI
return ()
the program returns immediately when it hits the end of mainAxn. I tried to fix that by using:
forkIO mainGUI
forever $ return ()
but then the gtk GUI never opens at all, and I don't understand why.
What's the right way to do this? What am I missing?
The basic problem here is that, in Haskell, as soon as main exits, the entire program is torn down. The solution is simply to keep the main thread open; e.g.
done <- newEmptyMVar
forkOS (mainGUI >> putMVar done ())
takeMVar done
I've also replaced forkIO with forkOS. GTK uses (OS-)thread-local state on Windows, so as a matter of defensive programming it is best to ensure that mainGUI runs on a bound thread just in case one day you want to support Windows.
Daniel Wagner answered my question as asked, but I got a more informative perspective from the #haskell IRC channel, which I'll post here for future reference.
Rather than jumping through awkward hoops of forking off the GUI thread and putting the main thread to sleep, a better solution is to let the main thread be the GUI thread and deal with the reactive-banana event network in a new thread. I ended up modifying my main function to contain the following:
keyChan <- newChan
_ <- forkIO $ watchKeys keyPress keyChan
_ <- win `on` keyPressEvent $
eventKeyVal >>= liftIO . writeChan keyChan >> return True
where watchKeys is defined as:
watchKeys :: EventSource KeyVal -> Chan KeyVal -> IO ()
watchKeys keyPress chan = forever $
readChan chan >>= fire keyPress
Now I can deal with the postGUI(A)Sync issues in exactly one place, by defining:
reactimateSafe :: Frameworks t => Event t (IO ()) -> Moment t ()
reactimateSafe = reactimate . fmap postGUIAsync
and using reactimateSafe for any IO action that modifies a GTK object
Related
The next simple code works fine in GHCi (the window with graphics appears), but after compiling in GHC, when one run it from command line, nothing happens. Why is it so?
import Graphics.Gnuplot.Simple
main :: IO ()
main = do
plotFunc [] (linearScale 1000 (-10.0::Double,10.0)) (\x -> x^2)
GHC 8.2.2
gnuplot 0.5.5.1
Don't exit your program immediately after opening the window, since that will close it down.
For instance, wait for the user:
import Graphics.Gnuplot.Simple
main :: IO ()
main = do
plotFunc [] (linearScale 1000 (-10.0::Double,10.0)) (\x -> x^2)
putStrLn "Press enter to exit."
getLine
return ()
Your best bet is to switch from Graphics.Gnuplot.Simple to Graphics.Gnuplot.Advanced. You can use plotSync to wait for GNUPlot to exit. I don't think plotAsync has much to offer, since it doesn't offer a way to wait for the thread it creates. Here's a better version:
myPlotAsync
:: (Terminal.C terminal, Display.C gfx)
=> terminal -> gfx -> IO (ThreadId, MVar ExitStatus)
myPlotAsync term gfx = do
resultMV <- newEmptyMVar
tid <- forkIO $ plotSync term gfx
>>= putMVar resultMV
`onException` putMVar resultMV ExitSuccess
pure (tid, resultMV)
After your program calls myPlotAsync, it can do whatever else it needs to do and then call readMVar on the MVar to wait for GNUPlot to exit and get its exit status. It also has the option of holding on to the thread ID so it can kill the GNUPlot thread using throwTo.
I'm new for Haskell. Recently, I was trying to create a game by Haskell. In that game, I use Concurrent to create multiple threads.
data Msg = C Char | Time
forkIO $ userThread chan
forkIO $ processThread startTimer
userThread :: MVar Msg -> IO ()
userThread chan = forever $ do
c <- getChar
putMVar chan (C c)
showStr(show c)
processThread :: MVar Msg -> IO ()
processThread chan = forever $ do
threadDelay (startTimer)
putMVar chan (Time)
I don't know how to define any other data shared between threads. Can I define a variable like C++ (static double xxx) and be visited by any function?
Usually, such variables are created in main, or another IO action.
main = do
chan <- newEmptyMVar
startTimer <- newEmptyMVar
...
forkIO $ userThread chan
forkIO $ processThread startTimer
...
There are some ways to declare "global variables" (mostly IORefs and MVars), but they involve unsafe functions, and are best to be avoided, especially by beginners. Such globals are mostly unnecessary, and it's often better to pass a few arguments around, even if it requires more typing.
In more advanced code, one might use a ReaderT r IO monad to reduce the verbosity of the code which simply passes the MVars around. But at the beginning, passing variables around is fine.
Is it safe to trigger the fire action in
(addHandler, fire) <- newAddHandler
from a different thread from which the reactive-banana graph was compiled?
Yes, this is safe, but there is the caveat that #Cirdec mentioned.
For conreteness, consider the following example that creates an event network using the addHandler in a separate thread and then calls fire repeatedly in the main thread
import Control.Concurrent (myThreadId, threadDelay, forkIO)
main = do
...
(addHandler, fire) <- newAddHandler
let networkDescription :: MomentIO ()
networkDescription = do
e <- fromAddHandler addHandler
...
reactimate $ (print =<< myThreadId) <$ e -- reactimate
forkIO $ do
network <- compile networkDescription
actuate network
...
forever $ do -- event loop
threadDelay (10^6)
fire ()
(See the documentation "Terminating the program" in Control.Concurrent for why I've put the event loop in the main thread as opposed to putting the network in the main thread.)
In this and similar situations, the following will hold:
The IO actions executed by the reactimate will be run in the thread that calls fire, not in the thread where the network was compiled. This is what #Cirdec already mentioned.
If there were a second thread also calling fire, then it could potentially interleave with other calls to fire, i.e. the program could be calling fire twice concurrently. Then,
Reactive-banana uses a lock to ensure that Behaviors and Events are updated consistently. You can treat them as pure functions Time -> a and lists [(Time,a)] as usual.
However, the IO actions from the reactimates may interleave. In other words, the pure FRP part will stay pure, but the actual IO is subject to concurrency as usual.
Firing the fire handler itself is safe; it reads an IORef that is being updated atomically and runs each of the added handlers in the current thread. Whether or not that's safe will depend on what handlers have been added to the addHandler.
Using the addHandler in interpretAsHandler, fromAddHandler, or fromChanges should be safe. Nothing I know of in reactive-banana has any thread affinity, and even if it did, these are what newAddHandler was made for, so it should be safe anyway.
What you need to be careful of is the IO () actions executed by reactimate. If you need to reactimate IO actions that need to be run in a specific thread (for OpenGL output, etc), you need to only produce IO () actions that will send their data to that thread. In this complete OpenGL example for reactive-banana the IO () actions for OpenGL output, which have thread affinity, are run in the OpenGL thread. Instead ofreactimateing the Event (IO ()) executing them directly they are added to an IORef
whenIdleRef <- newIORef (return ())
let
addWhenIdle :: IO () -> IO ()
addWhenIdle y = atomicModifyIORef' whenIdleRef (\x -> (x >> y, ()))
runWhenIdle :: IO ()
runWhenIdle = atomicModifyIORef' whenIdleRef (\x -> (return (), x)) >>= id
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
reactimate $ fmap addWhenIdle (whenIdle outputs)
^ ^
| Event (IO ())
Stuff the event into an IORef
The IORef holding which IO () actions to run is read and each of all the actions are run in a context that I know is in the OpenGL thread.
idleCallback $= Just (do -- will be executed in the OpenGL thread when it's idle
getCurrentTime >>= raiseTime
runWhenIdle -- run those `IO ()` actions in this thread
postRedisplay Nothing)
The following is my dining philosophers code and yields a compilation error saying "The last statement in a 'do' construct must be an expression: mVar2 <- newEmptyMVar mVar3"
Can Somebody help me fix this error and get this program working? thank you
import Control.Concurrent
import Control.Concurrent.MVar
import System.Random
takefork :: Int -> forks -> IO ()
takefork n forks = takeMVar (forks!!n)
releasefork :: Int -> forks -> IO ()
releasefork n forks = putMVar (forks!!n)
philosopher :: [Int]
philosopher = [1,2,3,4,5]
forks :: [MVar] -> [Int]
forks = do
takefork n ( philosopher - 1)
threadDelay delay
let delay = 100000
takefork n philosopher
putStrLn("Philosopher" ++ philosopher ++ "has started eating")
releasefork n philosopher
releasefork n ( philosopher - 1)
ptStrLn ("Philosopher" ++ philosopher ++ "has stopped eating")
forks
main :: IO ()
main = do
mVar1 <- newEmptyMVar
mVar2 <- newEmptyMVar
mVar3 <- newEmptyMVar
mVar4 <- newEmptyMVar
mVar5 <- newEmptyMVar
let mVar = [mVar1, mVar2, mVar3, mVar4, mVar5]
sequence_ [ forkIO forks (mVar philosopher) ]
There are many problems with your code.
The error message you report indicates you are probably mixing spaces and tabs. Get rid of the tabs and use only spaces.
You are presumably writing this program in order to practice writing Haskell programs, not in order to run the program for fun and profit. So we don't want to simply give you a working Dining Philosophers implementation, we want to help you write your implementation.
I cannot tell from your code how you expect it to work.
I'm going to focus on the last line:
sequence_ [ forkIO forks (mVar philosopher) ]
sequence_ :: [IO a] -> IO () --- give sequence_ a list of i/o actions, and it (returns an i/o action that) performs each action in order. From the [...], it looks like you are trying to give it a list, but with only one element. This is probably not what you mean.
forkIO :: IO () -> IO ThreadID --- give forkIO an i/o action, and it (returns an i/o action that) starts that i/o action running in a new thread, giving you the id of that thread.
There are two problems here:
forks is a function, not an i/o action (it's not even a function that returns an i/o action, though you probably mean it to be)
you give forkIO a second argunment ((mVar philosopher)), but it only takes one argument
mVar philosopher itself doesn't make any sense: mVar :: [MVar a] (it's a list of MVars, and I haven't worked out what type the MVars are supposed to contain) but you treat it like a function, passing it philosopher as an argument.
At this point a lightbulb blinks on above my head. You wish to call forks with parameters mVar and philosopher?
sequence_ [ forkIO (forks mVar philosopher) ]
We're still sequencing a single action though. Perhaps you wish to call forks with each element of philosopher in turn?
sequence_ $ map (\n -> forkIO (forks mVar n)) philosopher
We can simplify this to
mapM_ (\n -> forkIO (forks mVar n)) philosopher
This doesn't match up with the type you given forks :: [MVar] -> [Int]. But that's probably wrong, so you'll want to fix that function next.
I built a really simple read-eval-print-loop in Haskell that catches Control-C (UserInterrupt). However, whenever I compile and run this program, it always catches the first Control-C and always aborts on the second Control-C with exit code 130. It doesn't matter how many lines of input I give it before and between the two Control-Cs, it always happens this way. I know I must be missing something simple... please help, thanks!
Note: this is with base-4 exceptions, so Control.Exception and not Control.OldException.
import Control.Exception as E
import System.IO
main :: IO ()
main = do hSetBuffering stdout NoBuffering
hSetBuffering stdin NoBuffering
repLoop
repLoop :: IO ()
repLoop
= do putStr "> "
line <- interruptible "<interrupted>" getLine
if line == "exit"
then putStrLn "goodbye"
else do putStrLn $ "input was: " ++ line
repLoop
interruptible :: a -> IO a -> IO a
interruptible a m
= E.handleJust f return m
where
f UserInterrupt
= Just a
f _
= Nothing
Wei Hu is correct; the Haskell runtime system deliberately aborts the program when a second control-C is pressed. To get the behavior one might expect:
import Control.Exception as E
import Control.Concurrent
import System.Posix.Signals
main = do
tid <- myThreadId
installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing
... -- rest of program
Disclaimer: I'm not familiar with GHC internals and my answer is based on grepping the source code, reading the comments, and making guesses.
The main function you define is in fact wrapped by runMainIO defined in GHC.TopHandler (this is further confirmed by looking at TcRnDriver.lhs):
-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
-- called in the program). It catches otherwise uncaught exceptions,
-- and also flushes stdout\/stderr before exiting.
runMainIO :: IO a -> IO a
runMainIO main =
do
main_thread_id <- myThreadId
weak_tid <- mkWeakThreadId main_thread_id
install_interrupt_handler $ do
m <- deRefWeak weak_tid
case m of
Nothing -> return ()
Just tid -> throwTo tid (toException UserInterrupt)
a <- main
cleanUp
return a
`catch`
topHandler
And install_interrupt_handler is defined as:
install_interrupt_handler :: IO () -> IO ()
#ifdef mingw32_HOST_OS
install_interrupt_handler handler = do
_ <- GHC.ConsoleHandler.installHandler $
Catch $ \event ->
case event of
ControlC -> handler
Break -> handler
Close -> handler
_ -> return ()
return ()
#else
#include "rts/Signals.h"
-- specialised version of System.Posix.Signals.installHandler, which
-- isn't available here.
install_interrupt_handler handler = do
let sig = CONST_SIGINT :: CInt
_ <- setHandler sig (Just (const handler, toDyn handler))
_ <- stg_sig_install sig STG_SIG_RST nullPtr
-- STG_SIG_RST: the second ^C kills us for real, just in case the
-- RTS or program is unresponsive.
return ()
On Linux, stg_sig_install is a C function that calls out to sigaction. The parameter STG_SIG_RST is translated to SA_RESETHAND. On Windows, things are done differently, which probably explains ja's observation.
The most reliable solution for me (at least on Linux), has been to install a signal handler using System.Posix.Signals. I was hoping for a solution that would not require this, but the real reason I posted the question was that I wanted to know why GHC behaved the way it did. As explained on #haskell, a likely explanation is that GHC behaves this way so that the user can always Control-C an application if it hangs. Still, it would be nice if GHC provided a way to affect this behavior without the somewhat lower-level method that we resorted to :).