diff options
| author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2013-04-04 01:43:33 -0700 |
|---|---|---|
| committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2013-04-04 01:43:33 -0700 |
| commit | 5f6035b8e95c0fa5747d8b46b15f6e6c75651abd (patch) | |
| tree | 3121b1a8a19a17bdd57a1b8eeafefd9bbae3908e /src | |
| parent | cbfc7c18e1aa6c498d2fc7bdecf2f127b6582dbd (diff) | |
| parent | 5a9a869e5878f82df486859bcb36bd50b309c290 (diff) | |
| download | hakyll-5f6035b8e95c0fa5747d8b46b15f6e6c75651abd.tar.gz | |
Merge pull request #131 from simukis/fsnotify
Migrate to filesystem notification
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Commands.hs | 18 | ||||
| -rw-r--r-- | src/Hakyll/Preview/Poll.hs | 66 |
2 files changed, 34 insertions, 50 deletions
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 |