summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/HakyllMonad.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll/HakyllMonad.hs')
-rw-r--r--src/Text/Hakyll/HakyllMonad.hs25
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)