forked from GitHub/gf-core
4eb6b55e98
(1) introduces the module GF.Infra.Concurreny with lifted concurrency
operators (to reduce uses of liftIO) and some additional concurrency
utilities, e.g. a function for sequential logging that is used in
both GF.CompileInParallel and GFServer.
(2) avoids leaving broken .gfo files behind if compilation is aborted.
49 lines
1.1 KiB
Haskell
49 lines
1.1 KiB
Haskell
-- | Lifted concurrency operators and a some useful concurrency abstractions
|
|
module GF.Infra.Concurrency(
|
|
module GF.Infra.Concurrency,
|
|
C.forkIO,
|
|
C.MVar,C.modifyMVar,C.modifyMVar_,
|
|
C.Chan
|
|
) where
|
|
import qualified Control.Concurrent as C
|
|
import System.IO.Unsafe(unsafeInterleaveIO)
|
|
import Control.Monad((<=<))
|
|
import Control.Monad.Trans(MonadIO(..))
|
|
|
|
-- * Futures
|
|
|
|
newtype Future a = Future {now::IO a}
|
|
|
|
spawn io = do v <- newEmptyMVar
|
|
C.forkIO $ putMVar v =<< io
|
|
return (Future (readMVar v))
|
|
|
|
parMapM f = mapM now <=< mapM (spawn . f)
|
|
|
|
-- * Single-threaded logging
|
|
|
|
newLog put =
|
|
do logchan <- newChan
|
|
liftIO $ C.forkIO (mapM_ put =<< getChanContents logchan)
|
|
return (writeChan logchan)
|
|
|
|
-- * Lifted concurrency operators
|
|
|
|
newMVar x = liftIO $ C.newMVar x
|
|
readMVar v = liftIO $ C.readMVar v
|
|
putMVar v = liftIO . C.putMVar v
|
|
|
|
newEmptyMVar :: MonadIO io => io (C.MVar a)
|
|
newEmptyMVar = liftIO C.newEmptyMVar
|
|
|
|
newChan :: MonadIO io => io (C.Chan a)
|
|
newChan = liftIO C.newChan
|
|
|
|
getChanContents ch = liftIO $ C.getChanContents ch
|
|
writeChan ch = liftIO . C.writeChan ch
|
|
|
|
|
|
-- * Delayed IO
|
|
|
|
lazyIO = unsafeInterleaveIO
|