I have this code:
main = do
_ <- forkIO foo
_ <- forkIO bar
return ()
Functions foo and bar start, but terminate as soon as main terminates. How can I keep main running indefinitely, but not doing much?
The async package nicely wraps this up as concurrently foo bar.
Here's a self-contained stack shebang script.
#!/usr/bin/env stack
{- stack
--resolver lts-6.12
--install-ghc
runghc
--package async
-}
import Control.Concurrent
import Control.Concurrent.Async
forever :: String -> Int -> IO ()
forever msg delay = loop
where
loop = do
putStrLn msg
threadDelay (delay * 1000)
loop
foo = forever "foo" 3000
bar = forever "bar" 5000
main = foo `concurrently` bar
One thing you could do is to use an MVar () as a simple semaphore. Something like
main = do
vFoo <- newEmptyMVar
vBar <- newEmptyMVar
forkIO (foo vFoo)
forkIO (bar vBar)
takeMVar vFoo
takeMVar vBar
foo vFoo = do
...whatever...
putMVar vFoo ()
bar vBar = do
...whatever...
putMVar vBar ()
You could call getChar so your main thread waits for input. This would also give you a convenient way to really exit the program. Or if you don't want that, just recur on the getChar.
Depending on what behavior you want in the case that one of the two threads fails, this could be a good case for the async package.
Functions like race and concurrently might be particularly relevant to what you're doing.
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.
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
I'm writing a simple script to run bunch of tasks in parallel using the Shelly library but I want to limit the max number of tasks running at any one time. The script takes a file with an input on each line and runs a task for that input. There are a few hundred inputs in the file and I want to limit to around 16 processes at a time.
The current script actually limits to 1 (well tries to) using a QSem with an initial count of 1. I seem to be missing something though because when I run on a test file with 4 inputs I see this:
Starting
Starting
Starting
Starting
Done
Done
Done
Done
So the threads are not blocking on the QSem as I would expect, they're all running simultaneously. I've even gone so far as to implement my own semaphores both on MVar and TVar and neither worked the way I expected. I'm obviously missing something fundamental but what? I've also tried compiling the code and running it as a binary.
#!/usr/bin/env runhaskell
{-# LANGUAGE TemplateHaskell, QuasiQuotes, DeriveDataTypeable, OverloadedStrings #-}
import Shelly
import Prelude hiding (FilePath)
import Text.Shakespeare.Text (lt)
import qualified Data.Text.Lazy as LT
import Control.Monad (forM)
import System.Environment (getArgs)
import qualified Control.Concurrent.QSem as QSem
import Control.Concurrent (forkIO, MVar, putMVar, newEmptyMVar, takeMVar)
-- Define max number of simultaneous processes
maxProcesses :: IO QSem.QSem
maxProcesses = QSem.newQSem 1
bkGrnd :: ShIO a -> ShIO (MVar a)
bkGrnd proc = do
mvar <- liftIO newEmptyMVar
_ <- liftIO $ forkIO $ do
-- Block until there are free processes
sem <- maxProcesses
QSem.waitQSem sem
putStrLn "Starting"
-- Run the shell command
result <- shelly $ silently proc
liftIO $ putMVar mvar result
putStrLn "Done"
-- Signal that this process is done and another can run.
QSem.signalQSem sem
return mvar
main :: IO ()
main = shelly $ silently $ do
[img, file] <- liftIO $ getArgs
contents <- readfile $ fromText $ LT.pack file
-- Run a backgrounded process for each line of input.
results <- forM (LT.lines contents) $ \line -> bkGrnd $ do
runStdin <command> <arguments>
liftIO $ mapM_ takeMVar results
As I said in my comment, each call to bkGrnd creates its own semaphonre, allowing every thread to continue without waiting. I would try something like this instead, where the semaphore is created in the main and passed each time to bkGrnd.
bkGrnd :: QSem.QSem -> ShIO a -> ShIO (MVar a)
bkGrnd sem proc = do
mvar <- liftIO newEmptyMVar
_ <- liftIO $ forkIO $ do
-- Block until there are free processes
QSem.waitQSem sem
--
-- code continues as before
--
main :: IO ()
main = shelly $ silently $ do
[img, file] <- liftIO $ getArgs
contents <- readfile $ fromText $ LT.pack file
sem <- maxProcesses
-- Run a backgrounded process for each line of input.
results <- forM (LT.lines contents) $ \line -> bkGrnd sem $ do
runStdin <command> <arguments>
liftIO $ mapM_ takeMVar results
You have an answer, but I need to add: QSem and QSemN are not thread safe if killThread or asynchronous thread death is possible.
My bug report and patch are GHC trac ticket #3160. The fixed code is available as a new library called SafeSemaphore with module Control.Concurrent.MSem, MSemN, MSampleVar, and a bonus FairRWLock.
Isn't it better
bkGrnd sem proc = do
QSem.waitQSem sem
mvar <- liftIO newEmptyMVar
_ <- liftIO $ forkIO $ do
...
so not even forkIO until you get the semaphore?
I'm using
import Control.Concurrent.ParallelIO.Global
main = parallel_ (map processI [1..(sdNumber runParameters)]) >> stopGlobalPool
where
processI :: Int -> IO ()
is some function, which reads data from file, processes it and writes it to another file. No output to terminal. The problem is when I run the program with +RTS -N8 the terminal is flooded with random text like
piptufuht teata thtsieieo ocnsno e nscsdeoe qnqvuduee ernvnstetiirioasanlil lolwynya. .s
w
a s s uY Ysosopuuue's'nvpvdeeee n dpdp rerdodoub beada
bub lel y
What is happening? Without +RTS there is no clutter. I couldn't reproduce the behavior with a more simple (suitable to post here) program.
GHC 7.0.3 if that matters
Buffering is probably preventing you from constructing a simple test case. I was able to reproduce it with this (only when run with +RTS -Nsomething):
import Control.Concurrent
import System.IO
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
forkIO $ putStrLn "foo"
forkIO $ putStrLn "bar"
forkIO $ putStrLn "baz"
threadDelay 1000 -- Allow things to print
As Thomas mentioned, you'll probably need to sequence this somehow, though I'm not sure how writing straight to files would change this. Here's a simple example how you can sequence this with a Chan. I'm sure there's a better way to do this, this is just an example of how I got this to not garble the output.
import Control.Concurrent
import Control.Concurrent.Chan
import System.IO
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
ch <- newChan -- Things written here are picked up by stuffWriter
forkIO $ stuffWriter ch -- Fire up concurrent stuffWriter
forkIO $ writeChan ch "foo"
forkIO $ writeChan ch "bar"
forkIO $ writeChan ch "baz"
threadDelay 1000 -- Allow things to print
-- | Write all the things!
stuffWriter :: Chan String -> IO ()
stuffWriter ch = do
readChan ch >>= putStrLn -- Block, then write once I've got something
stuffWriter ch -- loop... looking for more things to write
Now your writes to somewhere are now synchronous (stuffWriter writes things, one at a time), and you should have no more garbling.