(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 d7dc541f74
commit 782bdf3a52
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