diff options
| -rw-r--r-- | hakyll.cabal | 10 | ||||
| -rw-r--r-- | src/Hakyll/Commands.hs | 18 | ||||
| -rw-r--r-- | src/Hakyll/Preview/Poll.hs | 66 |
3 files changed, 41 insertions, 53 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 4a555b9..de83ee4 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -165,7 +165,9 @@ Library If flag(previewServer) Build-depends: snap-core >= 0.6 && < 0.10, - snap-server >= 0.6 && < 0.10 + snap-server >= 0.6 && < 0.10, + fsnotify >= 0.0.6 && < 0.1, + system-filepath >= 0.4.6 && <= 0.5 Cpp-options: -DPREVIEW_SERVER Other-modules: @@ -238,8 +240,10 @@ Test-suite hakyll-tests If flag(previewServer) Build-depends: - snap-core >= 0.6 && < 0.10, - snap-server >= 0.6 && < 0.10 + snap-core >= 0.6 && < 0.10, + snap-server >= 0.6 && < 0.10, + fsnotify >= 0.0.6 && < 0.1, + system-filepath >= 0.4.6 && <= 0.5 Cpp-options: -DPREVIEW_SERVER Other-modules: diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs index 6e0b9f2..700dda5 100644 --- a/src/Hakyll/Commands.hs +++ b/src/Hakyll/Commands.hs @@ -13,7 +13,7 @@ module Hakyll.Commands -------------------------------------------------------------------------------- -import System.Exit (ExitCode (ExitSuccess), exitWith) +import System.Exit (exitWith) -------------------------------------------------------------------------------- @@ -27,10 +27,6 @@ import Hakyll.Core.Util.File -------------------------------------------------------------------------------- #ifdef PREVIEW_SERVER -import Control.Concurrent (forkIO) -import qualified Data.Set as S -import Hakyll.Core.Identifier -import Hakyll.Core.Rules.Internal import Hakyll.Preview.Poll import Hakyll.Preview.Server #endif @@ -68,16 +64,12 @@ clean conf = do preview :: Configuration -> Verbosity -> Rules a -> Int -> IO () #ifdef PREVIEW_SERVER preview conf verbosity rules port = do - -- Run the server in a separate thread - _ <- forkIO $ server conf port - previewPoll conf update + watchUpdates conf update + server conf port where update = do - (exitCode, ruleSet) <- run conf verbosity rules - case exitCode of - ExitSuccess -> return $ map toFilePath $ S.toList $ - rulesResources ruleSet - _ -> exitWith exitCode + _ <- run conf verbosity rules + return () #else preview _ _ _ _ = previewServerDisabled #endif diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs index 55118b3..36b057e 100644 --- a/src/Hakyll/Preview/Poll.hs +++ b/src/Hakyll/Preview/Poll.hs @@ -1,48 +1,40 @@ --------------------------------------------------------------------------------- --- | Interval-based implementation of preview polling -{-# LANGUAGE CPP #-} module Hakyll.Preview.Poll - ( previewPoll + ( watchUpdates ) where - -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) -import Control.Concurrent (threadDelay) -import Control.Monad (filterM) -#if MIN_VERSION_directory(1,2,0) -import Data.Time (getCurrentTime) -#else -import System.Time (getClockTime) -#endif -import System.Directory (doesFileExist, getModificationTime) - +import Filesystem.Path.CurrentOS (decodeString, encodeString) +import System.FSNotify (startManagerConf, watchTree, + Event(..), WatchConfig(..)) -------------------------------------------------------------------------------- import Hakyll.Core.Configuration + -------------------------------------------------------------------------------- --- | A preview thread that periodically recompiles the site. -previewPoll :: Configuration -- ^ Configuration - -> IO [FilePath] -- ^ Updating action - -> IO () -- ^ Can block forever -previewPoll _ update = do -#if MIN_VERSION_directory(1,2,0) - time <- getCurrentTime -#else - time <- getClockTime -#endif - loop time =<< update +-- | A thread that watches for updates in a 'providerDirectory' and recompiles +-- a site as soon as any changes occur +watchUpdates :: Configuration -> IO () -> IO () +watchUpdates conf update = do + _ <- update + manager <- startManagerConf (Debounce 0.1) + watchTree manager path (not . isRemove) update' where - delay = 1000000 - loop time files = do - threadDelay delay - files' <- filterM doesFileExist files - filesTime <- case files' of - [] -> return time - _ -> maximum <$> mapM getModificationTime files' - - if filesTime > time || files' /= files - then loop filesTime =<< update - else loop time files' + path = decodeString $ providerDirectory conf + update' evt = do + ignore <- shouldIgnoreFile conf $ eventPath evt + if ignore then return () else update + + +eventPath :: Event -> FilePath +eventPath evt = encodeString $ evtPath evt + where + evtPath (Added p _) = p + evtPath (Modified p _) = p + evtPath (Removed p _) = p + + +isRemove :: Event -> Bool +isRemove (Removed _ _) = True +isRemove _ = False |