diff options
Diffstat (limited to 'src/Text/Hakyll.hs')
-rw-r--r-- | src/Text/Hakyll.hs | 32 |
1 files changed, 29 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. -- |