git.iko.soy/hakyll
on master help sign in
Migrating from polling to notification: First shot
42cdd64Simonas Kazlauskas
hakyll.cabal+7−3
compare with master
unifiedsplit
@@ -165,7 +165,9 @@ Library
165 If flag(previewServer)
165 If flag(previewServer)
166 Build-depends:
166 Build-depends:
167 snap-core >= 0.6 && < 0.10,
167 snap-core >= 0.6 && < 0.10,
168− snap-server >= 0.6 && < 0.10
168+ snap-server >= 0.6 && < 0.10,
169+ fsnotify >= 0.0.6 && < 0.1,
170+ system-filepath >= 0.4.6 && <= 0.5
169 Cpp-options:
171 Cpp-options:
170 -DPREVIEW_SERVER
172 -DPREVIEW_SERVER
171 Other-modules:
173 Other-modules:
@@ -238,8 +240,10 @@ Test-suite hakyll-tests
238
240
239 If flag(previewServer)
241 If flag(previewServer)
240 Build-depends:
242 Build-depends:
241− snap-core >= 0.6 && < 0.10,
243+ snap-core >= 0.6 && < 0.10,
242− snap-server >= 0.6 && < 0.10
244+ snap-server >= 0.6 && < 0.10,
245+ fsnotify >= 0.0.6 && < 0.1,
246+ system-filepath >= 0.4.6 && <= 0.5
243 Cpp-options:
247 Cpp-options:
244 -DPREVIEW_SERVER
248 -DPREVIEW_SERVER
245 Other-modules:
249 Other-modules:
src/Hakyll/Preview/Poll.hs+37−32
@@ -1,48 +1,53 @@
1−--------------------------------------------------------------------------------
2−-- | Interval-based implementation of preview polling
3−{-# LANGUAGE CPP #-}
4module Hakyll.Preview.Poll
1module Hakyll.Preview.Poll
5 ( previewPoll
2 ( previewPoll
6 ) where
3 ) where
7
4
8−
9--------------------------------------------------------------------------------
5--------------------------------------------------------------------------------
10−import Control.Applicative ((<$>))
11import Control.Concurrent (threadDelay)
6import Control.Concurrent (threadDelay)
12−import Control.Monad (filterM)
7+import Control.Monad (void)
13−#if MIN_VERSION_directory(1,2,0)
8+import Data.List (isPrefixOf)
14−import Data.Time (getCurrentTime)
9+import Filesystem.Path.CurrentOS (decodeString, encodeString)
15−#else
16−import System.Time (getClockTime)
17−#endif
18−import System.Directory (doesFileExist, getModificationTime)
10+import System.Directory (canonicalizePath)
19−
11+import System.FSNotify (withManagerConf, watchTree, Event(..), WatchConfig(..))
12+import System.IO.Error (catchIOError)
20
13
21--------------------------------------------------------------------------------
14--------------------------------------------------------------------------------
22import Hakyll.Core.Configuration
15import Hakyll.Core.Configuration
23
16
24
17
18+
25--------------------------------------------------------------------------------
19--------------------------------------------------------------------------------
26−-- | A preview thread that periodically recompiles the site.
20+-- | A preview thread that recompiles the site when files change.
27previewPoll :: Configuration -- ^ Configuration
21previewPoll :: Configuration -- ^ Configuration
28 -> IO [FilePath] -- ^ Updating action
22 -> IO [FilePath] -- ^ Updating action
29 -> IO () -- ^ Can block forever
23 -> IO () -- ^ Can block forever
30−previewPoll _ update = do
24+previewPoll conf update = withManagerConf (Debounce 0.1) monitor
31−#if MIN_VERSION_directory(1,2,0)
32− time <- getCurrentTime
33−#else
34− time <- getClockTime
35−#endif
36− loop time =<< update
37 where
25 where
38− delay = 1000000
26+ path = decodeString $ providerDirectory conf
39− loop time files = do
27+ monitor manager = do
40− threadDelay delay
28+ _ <- update
41− files' <- filterM doesFileExist files
29+ ignore <- mapM getPath
42− filesTime <- case files' of
30+ [destinationDirectory, storeDirectory, tmpDirectory]
31+ watchTree manager path (predicate ignore) (\_ -> void update)
32+ infiniteLoop
33+ getPath fn = catchIOError (canonicalizePath $ fn conf)
43− [] -> return time
34+ (const $ return $ fn conf)
44− _ -> maximum <$> mapM getModificationTime files'
35+ predicate ignore evt
45−
36+ | isRemove evt = False
46− if filesTime > time || files' /= files
37+ | any (flip isPrefixOf $ eventPath evt) ignore == True = False
47− then loop filesTime =<< update
38+ | (ignoreFile conf) (eventPath evt) == True = False
48− else loop time files'
39+ | otherwise = True
40+
41+infiniteLoop :: IO ()
42+infiniteLoop = do
43+ threadDelay maxBound
44+ infiniteLoop
45+
46+eventPath :: Event -> FilePath
47+eventPath (Added p _) = encodeString p
48+eventPath (Modified p _) = encodeString p
49+eventPath (Removed p _) = encodeString p
50+
51+isRemove :: Event -> Bool
52+isRemove (Removed _ _) = True
53+isRemove _ = False