diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 3.1.2.5 +Version: 3.1.2.6 Synopsis: A simple static site generator library. Description: A simple static site generator library, mainly aimed at @@ -26,20 +26,23 @@ type: git location: git://github.com/jaspervdj/hakyll.git -flag inotify - description: Use the inotify bindings for the preview server. Better, but - only works on Linux. - default: False +-- Disabled while inotify is broken with GHC 7. If you're interested in fixing, +-- contact me! +-- +-- flag inotify +-- description: Use the inotify bindings for the preview server. Better, +-- but only works on Linux. +-- default: False library ghc-options: -Wall hs-source-dirs: src - if flag(inotify) - hs-source-dirs: src-inotify - build-depends: hinotify >= 0.3 - else - hs-source-dirs: src-interval +-- if flag(inotify) +-- hs-source-dirs: src-inotify +-- build-depends: hinotify >= 0.3 +-- else + hs-source-dirs: src-interval build-depends: base >= 4 && < 5, filepath == 1.*, diff --git a/src-interval/Hakyll/Web/Preview/Poll.hs b/src-interval/Hakyll/Web/Preview/Poll.hs --- a/src-interval/Hakyll/Web/Preview/Poll.hs +++ b/src-interval/Hakyll/Web/Preview/Poll.hs @@ -7,30 +7,29 @@ import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay) -import Control.Monad (when, filterM) +import Control.Monad (filterM) import System.Time (getClockTime) -import Data.Set (Set) -import qualified Data.Set as S import System.Directory (getModificationTime, doesFileExist) import Hakyll.Core.Configuration -import Hakyll.Core.Resource -- | A preview thread that periodically recompiles the site. -- previewPoll :: HakyllConfiguration -- ^ Configuration - -> Set Resource -- ^ Resources to watch - -> IO () -- ^ Action called when something changes + -> IO [FilePath] -- ^ Updating action -> IO () -- ^ Can block forever -previewPoll _ resources callback = do - let files = map unResource $ S.toList resources +previewPoll _ update = do time <- getClockTime - loop files time + loop time =<< update where delay = 1000000 - loop files time = do + loop time files = do threadDelay delay files' <- filterM doesFileExist files - modified <- any (time <) <$> mapM getModificationTime files' - when (modified || files' /= files) callback - loop files' =<< getClockTime + filesTime <- case files' of + [] -> return time + _ -> maximum <$> mapM getModificationTime files' + + if filesTime > time || files' /= files + then loop filesTime =<< update + else loop time files' diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -93,6 +93,7 @@ ( Compiler , runCompiler , getIdentifier + , getResource , getRoute , getRouteFor , getResourceString @@ -172,6 +173,11 @@ -- getIdentifier :: Compiler a Identifier getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask + +-- | Get the resource that is currently being compiled +-- +getResource :: Compiler a Resource +getResource = getIdentifier >>> arr fromIdentifier -- | Get the route we are using for this item -- diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs --- a/src/Hakyll/Core/Logger.hs +++ b/src/Hakyll/Core/Logger.hs @@ -13,7 +13,7 @@ import Control.Monad (forever) import Control.Monad.Trans (MonadIO, liftIO) -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative (pure, (<$>), (<*>)) import Control.Concurrent (forkIO) import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar) @@ -24,15 +24,16 @@ -- | Logger structure. Very complicated. -- data Logger = Logger - { loggerChan :: Chan (Maybe String) -- Nothing marks the end - , loggerSync :: MVar () -- Used for sync on quit + { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end + , loggerSync :: MVar () -- ^ Used for sync on quit + , loggerSink :: String -> IO () -- ^ Out sink } -- | Create a new logger -- -makeLogger :: IO Logger -makeLogger = do - logger <- Logger <$> newChan <*> newEmptyMVar +makeLogger :: (String -> IO ()) -> IO Logger +makeLogger sink = do + logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink _ <- forkIO $ loggerThread logger return logger where @@ -42,7 +43,7 @@ -- Stop: sync Nothing -> putMVar (loggerSync logger) () -- Print and continue - Just m -> putStrLn m + Just m -> loggerSink logger m -- | Flush the logger (blocks until flushed) -- diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -37,7 +37,7 @@ -- run :: HakyllConfiguration -> Rules -> IO RuleSet run configuration rules = do - logger <- makeLogger + logger <- makeLogger putStrLn section logger "Initialising" store <- timed logger "Creating store" $ diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -5,12 +5,15 @@ , hakyllWith ) where +import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Monad (when) import System.Environment (getProgName, getArgs) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) +import qualified Data.Set as S import Hakyll.Core.Configuration +import Hakyll.Core.Resource import Hakyll.Core.Run import Hakyll.Core.Rules import Hakyll.Core.Rules.Internal @@ -26,32 +29,32 @@ -- configuration -- hakyllWith :: HakyllConfiguration -> Rules -> IO () -hakyllWith configuration rules = do +hakyllWith conf rules = do args <- getArgs case args of - ["build"] -> build configuration rules - ["clean"] -> clean configuration + ["build"] -> build conf rules + ["clean"] -> clean conf ["help"] -> help - ["preview"] -> preview configuration rules 8000 - ["preview", p] -> preview configuration rules (read p) - ["rebuild"] -> rebuild configuration rules - ["server"] -> server configuration 8000 - ["server", p] -> server configuration (read p) + ["preview"] -> preview conf rules 8000 + ["preview", p] -> preview conf rules (read p) + ["rebuild"] -> rebuild conf rules + ["server"] -> server conf 8000 + ["server", p] -> server conf (read p) _ -> help -- | Build the site -- build :: HakyllConfiguration -> Rules -> IO () -build configuration rules = do - _ <- run configuration rules +build conf rules = do + _ <- run conf rules return () -- | Remove the output directories -- clean :: HakyllConfiguration -> IO () -clean configuration = do - remove $ destinationDirectory configuration - remove $ storeDirectory configuration +clean conf = do + remove $ destinationDirectory conf + remove $ storeDirectory conf where remove dir = do putStrLn $ "Removing " ++ dir ++ "..." @@ -82,32 +85,27 @@ -- | Preview the site -- preview :: HakyllConfiguration -> Rules -> Int -> IO () -preview configuration rules port = do - -- Build once, keep the rule set - ruleSet <- run configuration rules - - -- Get the resource list and a callback for the preview poll - let resources' = rulesResources ruleSet - callback = build configuration rules - +preview conf rules port = do -- Fork a thread polling for changes - _ <- forkIO $ previewPoll configuration resources' callback + _ <- forkIO $ previewPoll conf update -- Run the server in the main thread - server configuration port + server conf port + where + update = map unResource . S.toList . rulesResources <$> run conf rules -- | Rebuild the site -- rebuild :: HakyllConfiguration -> Rules -> IO () -rebuild configuration rules = do - clean configuration - build configuration rules +rebuild conf rules = do + clean conf + build conf rules -- | Start a server -- server :: HakyllConfiguration -> Int -> IO () -server configuration port = do - let destination = destinationDirectory configuration +server conf port = do + let destination = destinationDirectory conf staticServer destination preServeHook port where preServeHook _ = return ()