Added autocompile mode to replace preview mode.

5 files changed, 46 insertions, 13 deletions

diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index d818ebb..ee9cb5f 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -13,14 +13,17 @@ module Text.Hakyll
     , hakyllWithConfiguration
     ) where
 
-import Control.Monad.Reader (runReaderT, liftIO)
+import Control.Monad.Reader (runReaderT, liftIO, ask)
+import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad (when)
 import qualified Data.Map as M
 import System.Environment (getArgs, getProgName)
 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+import System.Time (getClockTime)
 
 import Network.Hakyll.SimpleServer (simpleServer)
 import Text.Hakyll.Hakyll
+import Text.Hakyll.File
 
 -- | The default hakyll configuration.
 defaultHakyllConfiguration :: HakyllConfiguration
@@ -29,6 +32,7 @@ defaultHakyllConfiguration = HakyllConfiguration
     , siteDirectory = "_site"
     , cacheDirectory = "_cache"
     , enableIndexUrl = False
+    , previewPollDelay = 1000000
     }
 
 -- | Main function to run Hakyll with the default configuration.
@@ -41,8 +45,8 @@ hakyllWithConfiguration configuration buildFunction = do
     args <- getArgs
     let f = case args of ["build"]      -> buildFunction
                          ["clean"]      -> clean
-                         ["preview", p] -> buildFunction >> server (read p)
-                         ["preview"]    -> buildFunction >> server 8000
+                         ["preview", p] -> preview buildFunction (read p)
+                         ["preview"]    -> preview buildFunction 8000
                          ["server", p]  -> server (read p)
                          ["server"]     -> server 8000
                          _              -> help
@@ -57,6 +61,23 @@ clean = do askHakyll siteDirectory >>= remove'
                               exists <- doesDirectoryExist dir
                               when exists $ removeDirectoryRecursive dir
 
+-- | Autocompile mode.
+preview :: Hakyll () -> Integer -> Hakyll ()
+preview buildFunction port = do
+    buildFunction
+    _ <- startServer
+    liftIO getClockTime >>= run
+  where
+    startServer = do configuration <- ask
+                     liftIO $ forkIO $ runReaderT (server port) configuration
+    run time = do delay <- askHakyll previewPollDelay
+                  liftIO $ threadDelay delay
+                  contents <- getRecursiveContents "."
+                  valid <- isMoreRecent time contents
+                  if valid then run time
+                           else do buildFunction
+                                   liftIO getClockTime >>= run
+
 -- | Show usage information.
 help :: Hakyll ()
 help = liftIO $ do
@@ -68,7 +89,7 @@ help = liftIO $ do
              ++ name ++ " build           Generate the site.\n"
              ++ name ++ " clean           Clean up and remove cache.\n"
              ++ name ++ " help            Show this message.\n"
-             ++ name ++ " preview [port]  Generate site, then start a server.\n"
+             ++ name ++ " preview [port]  Run a server and autocompile.\n"
              ++ name ++ " server [port]   Run a local test server.\n"
 
 -- | Start a server at the given port number.
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 311bd57..421a29c 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -10,12 +10,14 @@ module Text.Hakyll.File
     , getRecursiveContents
     , sortByBaseName
     , havingExtension
-    , isMoreRecent
     , directory
+    , isMoreRecent
+    , isFileMoreRecent
     ) where
 
 import System.Directory
 import System.FilePath
+import System.Time (ClockTime)
 import Control.Monad
 import Data.List (isPrefixOf, sortBy)
 import Control.Monad.Reader (liftIO)
@@ -144,14 +146,22 @@ havingExtension extension = filter ((==) extension . takeExtension)
 directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
 directory action dir = getRecursiveContents dir >>= mapM_ action
 
--- | Check if a file is newer then a number of given files.
-isMoreRecent :: FilePath -- ^ The cached file.
+-- | Check if a timestamp is newer then a number of given files.
+isMoreRecent :: ClockTime  -- ^ The time to check.
              -> [FilePath] -- ^ Dependencies of the cached file.
              -> Hakyll Bool
-isMoreRecent file depends = do
+isMoreRecent _ [] = return True
+isMoreRecent timeStamp depends = do
+    dependsModified <- liftIO $ mapM getModificationTime depends
+    return (timeStamp >= maximum dependsModified)
+
+-- | Check if a file is newer then a number of given files.
+isFileMoreRecent :: FilePath   -- ^ The cached file.
+                 -> [FilePath] -- ^ Dependencies of the cached file.
+                 -> Hakyll Bool
+isFileMoreRecent file depends = do
     exists <- liftIO $ doesFileExist file
     if not exists
         then return False
-        else do dependsModified <- liftIO $ mapM getModificationTime depends
-                fileModified <- liftIO $ getModificationTime file
-                return (fileModified >= maximum dependsModified)
+        else do timeStamp <- liftIO $ getModificationTime file
+                isMoreRecent timeStamp depends
diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
index 08cb7ea..4f36c88 100644
--- a/src/Text/Hakyll/Hakyll.hs
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -21,6 +21,8 @@ data HakyllConfiguration = HakyllConfiguration
       cacheDirectory :: FilePath
     , -- | Enable index links.
       enableIndexUrl :: Bool
+    , -- | Delay between polls in preview mode.
+      previewPollDelay :: Int
     }
 
 -- | Our custom monad stack.
diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
index 0deb5f4..d586f45 100644
--- a/src/Text/Hakyll/Internal/Cache.hs
+++ b/src/Text/Hakyll/Internal/Cache.hs
@@ -27,4 +27,4 @@ getFromCache = liftIO . decodeFile <=< toCache
 
 -- | Check if a file in the cache is more recent than a number of other files.
 isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool
-isCacheMoreRecent file depends = toCache file >>= flip isMoreRecent depends
+isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index df0f553..34e1780 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -32,7 +32,7 @@ depends :: FilePath -- ^ File to be rendered or created.
         -> Hakyll ()
 depends file dependencies action = do
     destination <- toDestination file
-    valid <- isMoreRecent destination dependencies
+    valid <- isFileMoreRecent destination dependencies
     unless valid action
 
 -- | Render to a Page.