diff options
| -rw-r--r-- | src/Text/Hakyll.hs | 32 | ||||
| -rw-r--r-- | src/Text/Hakyll/HakyllMonad.hs | 11 |
2 files changed, 40 insertions, 3 deletions
diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs index a2ade71..7fd2eaa 100644 --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -13,16 +13,19 @@ module Text.Hakyll , hakyllWithConfiguration ) where +import Control.Concurrent (forkIO, threadDelay) import Control.Monad.Reader (runReaderT, liftIO, ask) import Control.Monad (when) import Data.Monoid (mempty) import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) +import System.Time (getClockTime) import Text.Pandoc import Network.Hakyll.SimpleServer (simpleServer) import Text.Hakyll.HakyllMonad +import Text.Hakyll.File -- | The default reader options for pandoc parsing. -- @@ -52,6 +55,7 @@ defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration , siteDirectory = "_site" , cacheDirectory = "_cache" , enableIndexUrl = False + , previewMode = BuildOnRequest , pandocParserState = defaultPandocParserState , pandocWriterOptions = defaultPandocWriterOptions } @@ -74,13 +78,35 @@ hakyllWithConfiguration configuration buildFunction = do args <- getArgs let f = case args of ["build"] -> buildFunction ["clean"] -> clean - ["preview", p] -> server (read p) buildFunction - ["preview"] -> server 8000 buildFunction + ["preview", p] -> preview (read p) + ["preview"] -> preview defaultPort ["rebuild"] -> clean >> buildFunction ["server", p] -> server (read p) (return ()) - ["server"] -> server 8000 (return ()) + ["server"] -> server defaultPort (return ()) _ -> help runReaderT f configuration + where + preview port = case previewMode configuration of + BuildOnRequest -> server port buildFunction + BuildOnInterval -> do + let pIO = runReaderT (previewThread buildFunction) configuration + _ <- liftIO $ forkIO pIO + server port (return ()) + + defaultPort = 8000 + +-- | A preview thread that periodically recompiles the site. +-- +previewThread :: Hakyll () -- ^ Build function + -> Hakyll () -- ^ Result +previewThread buildFunction = run =<< liftIO getClockTime + where + delay = 1000000 + run time = do liftIO $ threadDelay delay + contents <- getRecursiveContents "." + valid <- isMoreRecent time contents + when valid buildFunction + run =<< liftIO getClockTime -- | Clean up directories. -- diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs index 9535a66..f17ae52 100644 --- a/src/Text/Hakyll/HakyllMonad.hs +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -1,6 +1,7 @@ -- | Module describing the Hakyll monad stack. module Text.Hakyll.HakyllMonad ( HakyllConfiguration (..) + , PreviewMode (..) , Hakyll , askHakyll , getAdditionalContext @@ -15,9 +16,17 @@ import Text.Pandoc (ParserState, WriterOptions) import Text.Hakyll.Context (Context (..)) -- | Our custom monad stack. +-- type Hakyll = ReaderT HakyllConfiguration IO +-- | Preview mode. +-- +data PreviewMode = BuildOnRequest + | BuildOnInterval + deriving (Show, Eq, Ord) + -- | Hakyll global configuration type. +-- data HakyllConfiguration = HakyllConfiguration { -- | Absolute URL of the site. absoluteUrl :: String @@ -30,6 +39,8 @@ data HakyllConfiguration = HakyllConfiguration cacheDirectory :: FilePath , -- | Enable index links. enableIndexUrl :: Bool + , -- | The preview mode used + previewMode :: PreviewMode , -- | Pandoc parsing options pandocParserState :: ParserState , -- | Pandoc writer options |