Migrating from polling to notification: First shot

Using system file notification APIs it is much more efficient than
polling files every second.

1 files changed, 37 insertions, 32 deletions

diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs
index 55118b3..c6c9b9a 100644
--- a/src/Hakyll/Preview/Poll.hs
+++ b/src/Hakyll/Preview/Poll.hs
@@ -1,48 +1,53 @@
---------------------------------------------------------------------------------
--- | Interval-based implementation of preview polling
-{-# LANGUAGE CPP #-}
 module Hakyll.Preview.Poll
     ( previewPoll
     ) 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           Control.Monad             (void)
+import           Data.List                 (isPrefixOf)
+import           Filesystem.Path.CurrentOS (decodeString, encodeString)
+import           System.Directory          (canonicalizePath)
+import           System.FSNotify           (withManagerConf, watchTree, Event(..), WatchConfig(..))
+import           System.IO.Error           (catchIOError)
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Configuration
 
 
+
 --------------------------------------------------------------------------------
--- | A preview thread that periodically recompiles the site.
+-- | A preview thread that recompiles the site when files change.
 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
+previewPoll conf update = withManagerConf (Debounce 0.1) monitor
   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
+    monitor manager = do
+        _ <- update
+        ignore <- mapM getPath
+                  [destinationDirectory, storeDirectory, tmpDirectory]
+        watchTree manager path (predicate ignore) (\_ -> void update)
+        infiniteLoop
+    getPath fn = catchIOError (canonicalizePath $ fn conf)
+                              (const $ return $ fn conf)
+    predicate ignore evt
+        | isRemove evt = False
+        | any (flip isPrefixOf $ eventPath evt) ignore == True = False
+        | (ignoreFile conf) (eventPath evt) == True = False
+        | otherwise = True
+
+infiniteLoop :: IO ()
+infiniteLoop = do
+    threadDelay maxBound
+    infiniteLoop
+
+eventPath :: Event -> FilePath
+eventPath (Added p _) = encodeString p
+eventPath (Modified p _) = encodeString p
+eventPath (Removed p _) = encodeString p
+
+isRemove :: Event -> Bool
+isRemove (Removed _ _) = True
+isRemove _ = False