on master help sign in
Add concurrency features
b6d4bc5Jasper Van der Jeugt
src/Text/Hakyll/HakyllMonad.hs+23−2
@@ -6,11 +6,14 @@ module Text.Hakyll.HakyllMonad
6 , askHakyll
6 , askHakyll
7 , getAdditionalContext
7 , getAdditionalContext
8 , logHakyll
8 , logHakyll
9+ , forkHakyllWait
10+ , concurrentHakyll
9 ) where
11 ) where
10
12
11import Control.Monad.Trans (liftIO)
13import Control.Monad.Trans (liftIO)
14+import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar)
12−import Control.Monad.Reader (ReaderT, ask)
15+import Control.Monad.Reader (ReaderT, ask, runReaderT)
13−import Control.Monad (liftM)
16+import Control.Monad (liftM, forM, forM_)
14import qualified Data.Map as M
17import qualified Data.Map as M
15import System.IO (hPutStrLn, stderr)
18import System.IO (hPutStrLn, stderr)
16
19
@@ -76,3 +79,21 @@ getAdditionalContext configuration =
76--
79--
77logHakyll :: String -> Hakyll ()
80logHakyll :: String -> Hakyll ()
78logHakyll = liftIO . hPutStrLn stderr
81logHakyll = liftIO . hPutStrLn stderr
82+
83+-- | Perform a concurrent hakyll action. Returns an MVar you can wait on
84+--
85+forkHakyllWait :: Hakyll () -> Hakyll (MVar ())
86+forkHakyllWait action = do
87+ mvar <- liftIO newEmptyMVar
88+ config <- ask
89+ liftIO $ do
90+ runReaderT action config
91+ putMVar mvar ()
92+ return mvar
93+
94+-- | Perform a number of concurrent hakyll actions, and waits for them to finish
95+--
96+concurrentHakyll :: [Hakyll ()] -> Hakyll ()
97+concurrentHakyll actions = do
98+ mvars <- forM actions forkHakyllWait
99+ forM_ mvars (liftIO . readMVar)