git.iko.soy/hakyll
on master help sign in
Merge pull request #131 from simukis/fsnotify
5f6035bJasper Van der Jeugt
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/Commands.hs+5−13
@@ -13,7 +13,7 @@ module Hakyll.Commands
13
13
14
14
15--------------------------------------------------------------------------------
15--------------------------------------------------------------------------------
16−import System.Exit (ExitCode (ExitSuccess), exitWith)
16+import System.Exit (exitWith)
17
17
18
18
19--------------------------------------------------------------------------------
19--------------------------------------------------------------------------------
@@ -27,10 +27,6 @@ import Hakyll.Core.Util.File
27
27
28--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
29#ifdef PREVIEW_SERVER
29#ifdef PREVIEW_SERVER
30−import Control.Concurrent (forkIO)
31−import qualified Data.Set as S
32−import Hakyll.Core.Identifier
33−import Hakyll.Core.Rules.Internal
34import Hakyll.Preview.Poll
30import Hakyll.Preview.Poll
35import Hakyll.Preview.Server
31import Hakyll.Preview.Server
36#endif
32#endif
@@ -68,16 +64,12 @@ clean conf = do
68preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
64preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
69#ifdef PREVIEW_SERVER
65#ifdef PREVIEW_SERVER
70preview conf verbosity rules port = do
66preview conf verbosity rules port = do
71− -- Run the server in a separate thread
67+ watchUpdates conf update
72− _ <- forkIO $ server conf port
68+ server conf port
73− previewPoll conf update
74 where
69 where
75 update = do
70 update = do
76− (exitCode, ruleSet) <- run conf verbosity rules
71+ _ <- run conf verbosity rules
77− case exitCode of
72+ return ()
78− ExitSuccess -> return $ map toFilePath $ S.toList $
79− rulesResources ruleSet
80− _ -> exitWith exitCode
81#else
73#else
82preview _ _ _ _ = previewServerDisabled
74preview _ _ _ _ = previewServerDisabled
83#endif
75#endif
src/Hakyll/Preview/Poll.hs+29−37
@@ -1,48 +1,40 @@
1−--------------------------------------------------------------------------------
2−-- | Interval-based implementation of preview polling
3−{-# LANGUAGE CPP #-}
4module Hakyll.Preview.Poll
1module Hakyll.Preview.Poll
5− ( previewPoll
2+ ( watchUpdates
6 ) where
3 ) where
7
4
8−
9--------------------------------------------------------------------------------
5--------------------------------------------------------------------------------
10−import Control.Applicative ((<$>))
6+import Filesystem.Path.CurrentOS (decodeString, encodeString)
11−import Control.Concurrent (threadDelay)
7+import System.FSNotify (startManagerConf, watchTree,
12−import Control.Monad (filterM)
8+ Event(..), WatchConfig(..))
13−#if MIN_VERSION_directory(1,2,0)
14−import Data.Time (getCurrentTime)
15−#else
16−import System.Time (getClockTime)
17−#endif
18−import System.Directory (doesFileExist, getModificationTime)
19−
20
9
21--------------------------------------------------------------------------------
10--------------------------------------------------------------------------------
22import Hakyll.Core.Configuration
11import Hakyll.Core.Configuration
23
12
24
13
14+
25--------------------------------------------------------------------------------
15--------------------------------------------------------------------------------
26−-- | A preview thread that periodically recompiles the site.
16+-- | A thread that watches for updates in a 'providerDirectory' and recompiles
27−previewPoll :: Configuration -- ^ Configuration
17+-- a site as soon as any changes occur
28− -> IO [FilePath] -- ^ Updating action
18+watchUpdates :: Configuration -> IO () -> IO ()
29− -> IO () -- ^ Can block forever
19+watchUpdates conf update = do
30−previewPoll _ update = do
20+ _ <- update
31−#if MIN_VERSION_directory(1,2,0)
21+ manager <- startManagerConf (Debounce 0.1)
32− time <- getCurrentTime
22+ watchTree manager path (not . isRemove) update'
33−#else
34− time <- getClockTime
35−#endif
36− loop time =<< update
37 where
23 where
38− delay = 1000000
24+ path = decodeString $ providerDirectory conf
39− loop time files = do
25+ update' evt = do
40− threadDelay delay
26+ ignore <- shouldIgnoreFile conf $ eventPath evt
41− files' <- filterM doesFileExist files
27+ if ignore then return () else update
42− filesTime <- case files' of
28+
43− [] -> return time
29+
44− _ -> maximum <$> mapM getModificationTime files'
30+eventPath :: Event -> FilePath
45−
31+eventPath evt = encodeString $ evtPath evt
46− if filesTime > time || files' /= files
32+ where
47− then loop filesTime =<< update
33+ evtPath (Added p _) = p
48− else loop time files'
34+ evtPath (Modified p _) = p
35+ evtPath (Removed p _) = p
36+
37+
38+isRemove :: Event -> Bool
39+isRemove (Removed _ _) = True
40+isRemove _ = False