From 6611e86ac5db5790b271f0b3e41376a0affdbb80 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 12 Feb 2010 12:01:23 +0100 Subject: Added autocompile mode to replace preview mode. --- hakyll.cabal | 1 + src/Text/Hakyll.hs | 29 +++++++++++++++++++++++++---- src/Text/Hakyll/File.hs | 24 +++++++++++++++++------- src/Text/Hakyll/Hakyll.hs | 2 ++ src/Text/Hakyll/Internal/Cache.hs | 2 +- src/Text/Hakyll/Render.hs | 2 +- 6 files changed, 47 insertions(+), 13 deletions(-) diff --git a/hakyll.cabal b/hakyll.cabal index 8e34cce..c588da3 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -33,6 +33,7 @@ library network >= 2, mtl >= 1.1, old-locale >= 1, + old-time >= 1, time >= 1, binary >= 0.5, QuickCheck >= 2 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. -- cgit v1.2.3