If you have worked on long running process in ghci (like a server or GUI), there is a good chance you have run into this problem:
> import Control.Concurrent (forkIO, threadDelay, killThread)
> import Control.Monad (forever)
> t <- forkIO $ forever $ putStrLn "Hello" >> threadDelay 5000000
Hello
Hello
> :reload
Hello
> killThread t
error: Variable not in scope: t :: GHC.Conc.Sync.ThreadId
There are work arounds, but most introduce a dependency on foreign-store and/or require modification of your code.
:fork
forks a thread and stores it in the process environment.
If another thread was already in the selected "slot" it uses
killThread
and waits for it to terminate before starting
the new thread.
For example:
> import Control.Concurrent (forkIO, threadDelay, killThread)
> import Control.Monad (forever)
> :fork slotName forever $ putStrLn "Hello" >> threadDelay 5000000
Hello
> :reload
Hello
> :fork slotName forever $ putStrLn "World" >> threadDelay 5000000
World
World
...
The slotName
identifies where the thread id is to be stored (any
combination of isAlphaNum
characters or '_'
).
To stop a thread just replace it with something that terminates:
> :fork slotName return ()
Paste the following into ghci
or add it to a suitable .ghci
file.
Feel free to add it to the startup code of tools that use ghci
too.
:{
:def! fork (\s ->
let (slot, code) = Data.List.span (\c -> case c of
'_' -> Data.Bool.True
' ' -> Data.Bool.False
'\n' -> Data.Bool.False
_ -> if Data.Char.isAlphaNum c
then Data.Bool.True
else GHC.Base.error "Slot name must contain alpha, numbers and '_' only. Usage :fork slotName putStrLn \"Hello World\"") s
in Control.Monad.return (Data.String.unlines
[":{"
,"System.Environment.lookupEnv \"GHCI_FORK_" Data.Monoid.<> slot Data.Monoid.<> "\" Control.Monad.>>="
,"(\\s ->"
," ( case s Control.Monad.>>= Text.Read.readMaybe of"
," Data.Maybe.Just n ->"
," let sPtr = Foreign.StablePtr.castPtrToStablePtr (Foreign.Ptr.wordPtrToPtr n)"
," in Foreign.StablePtr.deRefStablePtr sPtr Control.Monad.>>="
," (\\(t, running) -> Control.Concurrent.killThread t Control.Monad.>>"
," Foreign.StablePtr.freeStablePtr sPtr Control.Monad.>>"
," Control.Monad.return running)"
," Data.Maybe.Nothing -> Control.Concurrent.newEmptyMVar"
," ) Control.Monad.>>="
,"(\\running -> Control.Concurrent.newEmptyMVar Control.Monad.>>="
,"(\\sPtrSet -> Control.Concurrent.forkFinally"
," ( Control.Concurrent.takeMVar sPtrSet Control.Monad.>>"
," Control.Concurrent.putMVar running () Control.Monad.>>"
," ("
, Data.List.drop 1 code
," )"
," ) (\\_ -> Control.Concurrent.takeMVar running) Control.Monad.>>="
,"(\\t -> Foreign.StablePtr.newStablePtr (t, running) Control.Monad.>>="
,"(\\sPtr -> System.Environment.setEnv \"GHCI_FORK_" Data.Monoid.<> slot Data.Monoid.<> "\" (GHC.Show.show"
," (Foreign.Ptr.ptrToWordPtr (Foreign.StablePtr.castStablePtrToPtr sPtr))) Control.Monad.>>"
,"Control.Concurrent.putMVar sPtrSet ())))))"
,":}"
]))
:}
This was done to avoid dependencies on the imported modules and enabled extensions.
:def! reload (const $ return "::reload\n:fork mySlot MyModule.myMainFunction")
The parent thread(s) will need to make sure the children are
cleaned up.
One option would be to use killThread
(but you could
also signal the children with an MVar
instead):
import Control.Exception (bracket)
import Control.Concurrent (forkIO, threadDelay, killThread)
import Control.Monad (forever)
:{
:fork slotName bracket
(forkIO $ forever $ putStrLn "Child!" >> threadDelay 5000000)
killThread
(\_ -> forever $ putStrLn "Parent!" >> threadDelay 5000000)
:}
Another option is to use the slave-thread package.
If you are using the distributed-process
library you can use
Monitoring and linking
to ensure children are clean up when the parent terminates.