module Text.Hakyll.HakyllMonad
( HakyllConfiguration (..)
, PreviewMode (..)
, Hakyll
, askHakyll
, getAdditionalContext
, logHakyll
, forkHakyllWait
, concurrentHakyll
) where
import Control.Monad.Trans (liftIO)
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)
import Text.Pandoc (ParserState, WriterOptions)
import Text.Hamlet (HamletSettings)
import Text.Hakyll.Context (Context (..))
type Hakyll = ReaderT HakyllConfiguration IO
data PreviewMode = BuildOnRequest
| BuildOnInterval
deriving (Show, Eq, Ord)
data HakyllConfiguration = HakyllConfiguration
{
absoluteUrl :: String
,
additionalContext :: Context
,
siteDirectory :: FilePath
,
cacheDirectory :: FilePath
,
enableIndexUrl :: Bool
,
previewMode :: PreviewMode
,
pandocParserState :: ParserState
,
pandocWriterOptions :: WriterOptions
,
hamletSettings :: HamletSettings
}
askHakyll :: (HakyllConfiguration -> a) -> Hakyll a
askHakyll = flip liftM ask
getAdditionalContext :: HakyllConfiguration -> Context
getAdditionalContext configuration =
let (Context c) = additionalContext configuration
in Context $ M.insert "absolute" (absoluteUrl configuration) c
logHakyll :: String -> Hakyll ()
logHakyll = liftIO . hPutStrLn stderr
forkHakyllWait :: Hakyll () -> Hakyll (MVar ())
forkHakyllWait action = do
mvar <- liftIO newEmptyMVar
config <- ask
liftIO $ do
runReaderT action config
putMVar mvar ()
return mvar
concurrentHakyll :: [Hakyll ()] -> Hakyll ()
concurrentHakyll actions = do
mvars <- forM actions forkHakyllWait
forM_ mvars (liftIO . readMVar)