Option to choose between preview modes

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