1
0
forked from GitHub/gf-core

(1) Refactor concurrency, (2) write to .gfo.tmp then rename to .gfo

(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.
This commit is contained in:
hallgren
2014-09-08 15:43:20 +00:00
parent 4d28c7632e
commit 4eb6b55e98
7 changed files with 90 additions and 34 deletions

View File

@@ -0,0 +1,48 @@
-- | 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