mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-06 09:42:50 -06:00
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
|