diff options
| -rw-r--r-- | src/Text/Hakyll/HakyllMonad.hs | 25 |
1 files changed, 23 insertions, 2 deletions
diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs index 40e8c75..f51cf2c 100644 --- a/src/Text/Hakyll/HakyllMonad.hs +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -6,11 +6,14 @@ module Text.Hakyll.HakyllMonad , askHakyll , getAdditionalContext , logHakyll + , forkHakyllWait + , concurrentHakyll ) where import Control.Monad.Trans (liftIO) -import Control.Monad.Reader (ReaderT, ask) -import Control.Monad (liftM) +import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar) +import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad (liftM, forM, forM_) import qualified Data.Map as M import System.IO (hPutStrLn, stderr) @@ -76,3 +79,21 @@ getAdditionalContext configuration = -- logHakyll :: String -> Hakyll () logHakyll = liftIO . hPutStrLn stderr + +-- | Perform a concurrent hakyll action. Returns an MVar you can wait on +-- +forkHakyllWait :: Hakyll () -> Hakyll (MVar ()) +forkHakyllWait action = do + mvar <- liftIO newEmptyMVar + config <- ask + liftIO $ do + runReaderT action config + putMVar mvar () + return mvar + +-- | Perform a number of concurrent hakyll actions, and waits for them to finish +-- +concurrentHakyll :: [Hakyll ()] -> Hakyll () +concurrentHakyll actions = do + mvars <- forM actions forkHakyllWait + forM_ mvars (liftIO . readMVar) |