@@ -1,48 +1,53 @@
1−--------------------------------------------------------------------------------
2−-- | Interval-based implementation of preview polling
3−{-# LANGUAGE CPP #-}
41module Hakyll.Preview.Poll
52 ( previewPoll
63 ) where
74
8−
95--------------------------------------------------------------------------------
10−import Control.Applicative ((<$>))
116import Control.Concurrent (threadDelay)
12−import Control.Monad (filterM)
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−
7+import Control.Monad (void)
8+import Data.List (isPrefixOf)
9+import Filesystem.Path.CurrentOS (decodeString, encodeString)
10+import System.Directory (canonicalizePath)
11+import System.FSNotify (withManagerConf, watchTree, Event(..), WatchConfig(..))
12+import System.IO.Error (catchIOError)
2013
2114--------------------------------------------------------------------------------
2215import Hakyll.Core.Configuration
2316
2417
18+
2519--------------------------------------------------------------------------------
26−-- | A preview thread that periodically recompiles the site.
20+-- | A preview thread that recompiles the site when files change.
2721previewPoll :: Configuration -- ^ Configuration
2822 -> IO [FilePath] -- ^ Updating action
2923 -> IO () -- ^ Can block forever
30−previewPoll _ update = do
31−#if MIN_VERSION_directory(1,2,0)
32− time <- getCurrentTime
33−#else
34− time <- getClockTime
35−#endif
36− loop time =<< update
24+previewPoll conf update = withManagerConf (Debounce 0.1) monitor
3725 where
38− delay = 1000000
39− loop time files = do
40− threadDelay delay
41− files' <- filterM doesFileExist files
42− filesTime <- case files' of
43− [] -> return time
44− _ -> maximum <$> mapM getModificationTime files'
45−
46− if filesTime > time || files' /= files
47− then loop filesTime =<< update
48− else loop time files'
26+ path = decodeString $ providerDirectory conf
27+ monitor manager = do
28+ _ <- update
29+ ignore <- mapM getPath
30+ [destinationDirectory, storeDirectory, tmpDirectory]
31+ watchTree manager path (predicate ignore) (\_ -> void update)
32+ infiniteLoop
33+ getPath fn = catchIOError (canonicalizePath $ fn conf)
34+ (const $ return $ fn conf)
35+ predicate ignore evt
36+ | isRemove evt = False
37+ | any (flip isPrefixOf $ eventPath evt) ignore == True = False
38+ | (ignoreFile conf) (eventPath evt) == True = False
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