Bump fsnotify, citeproc, poll changes

1 files changed, 58 insertions, 43 deletions

diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs
index ab183f7..34eb971 100644
--- a/src/Hakyll/Preview/Poll.hs
+++ b/src/Hakyll/Preview/Poll.hs
@@ -1,30 +1,34 @@
-{-# LANGUAGE CPP #-}
-
 --------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
 module Hakyll.Preview.Poll
     ( watchUpdates
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Concurrent.MVar        (newMVar, putMVar, takeMVar)
-import           Control.Monad                  (when, void)
+import           Control.Concurrent             (forkIO)
+import           Control.Concurrent.MVar        (newEmptyMVar, takeMVar,
+                                                 tryPutMVar)
+import           Control.Exception              (AsyncException, fromException,
+                                                 handle, throw)
+import           Control.Monad                  (forever, void, when)
 import           Filesystem.Path.CurrentOS      (decodeString, encodeString)
 import           System.Directory               (canonicalizePath)
 import           System.FilePath                (pathSeparators, (</>))
-import           System.FSNotify                (Event (..), WatchConfig (..),
-                                                 startManagerConf, watchTree)
+import           System.FSNotify                (Event (..), startManager,
+                                                 watchTree)
 
 #ifdef mingw32_HOST_OS
-import           System.IO                      (IOMode(ReadMode), Handle, openFile,
-                                                 hClose)
-import           System.IO.Error                (isPermissionError)
 import           Control.Concurrent             (threadDelay)
 import           Control.Exception              (IOException, throw, try)
-import           System.Exit                    (exitFailure)
 import           System.Directory               (doesFileExist)
+import           System.Exit                    (exitFailure)
+import           System.IO                      (Handle, IOMode (ReadMode),
+                                                 hClose, openFile)
+import           System.IO.Error                (isPermissionError)
 #endif
 
+
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Configuration
 import           Hakyll.Core.Identifier
@@ -37,10 +41,10 @@ import           Hakyll.Core.Identifier.Pattern
 watchUpdates :: Configuration -> IO Pattern -> IO ()
 watchUpdates conf update = do
     let providerDir = decodeString $ providerDirectory conf
-    lock            <- newMVar ()
+    shouldBuild     <- newEmptyMVar
     pattern         <- update
     fullProviderDir <- canonicalizePath $ providerDirectory conf
-    manager         <- startManagerConf (Debounce 0.1)
+    manager         <- startManager
 
     let allowed event = do
             -- Absolute path of the changed file. This must be inside provider
@@ -53,42 +57,53 @@ watchUpdates conf update = do
             shouldIgnore <- shouldIgnoreFile conf path
             return $ not shouldIgnore && matches pattern identifier
 
-    watchTree manager providerDir (not . isRemove) $ \event -> do
-        ()       <- takeMVar lock
+    -- This thread continually watches the `shouldBuild` MVar and builds
+    -- whenever a value is present.
+    _ <- forkIO $ forever $ do
+        event <- takeMVar shouldBuild
+        handle
+            (\e -> case fromException e of
+                Nothing    -> putStrLn (show e)
+                Just async -> throw (async :: AsyncException))
+            (update' event $ encodeString providerDir)
+
+    -- Send an event whenever something occurs so that the thread described
+    -- above will do a build.
+    void $ watchTree manager providerDir (not . isRemove) $ \event -> do
         allowed' <- allowed event
-        when allowed' $ update' event (encodeString providerDir)
-        putMVar lock ()
-    where
+        when allowed' $ void $ tryPutMVar shouldBuild event
+  where
 #ifndef mingw32_HOST_OS
-      update' _     _        = void update
+    update' _     _        = void update
 #else
-      update' event provider = do
-          let path = provider </> eventPath event
-          -- on windows, a 'Modified' event is also sent on file deletion
-          fileExists <- doesFileExist path
-
-          when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10
-
-      -- continuously attempts to open the file in between sleep intervals
-      -- handler is run only once it is able to open the file
-      waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r
-      waitOpen _    _    _       0 = do
-          putStrLn "[ERROR] Failed to retrieve modified file for regeneration"
-          exitFailure
-      waitOpen path mode handler retries = do
-          res <- try $ openFile path mode :: IO (Either IOException Handle)
-          case res of
-              Left ex -> if isPermissionError ex
-                         then do
-                             threadDelay 100000
-                             waitOpen path mode handler (retries - 1)
-                         else throw ex
-              Right h -> do
-                  handled <- handler h
-                  hClose h
-                  return handled
+    update' event provider = do
+        let path = provider </> eventPath event
+        -- on windows, a 'Modified' event is also sent on file deletion
+        fileExists <- doesFileExist path
+
+        when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10
+
+    -- continuously attempts to open the file in between sleep intervals
+    -- handler is run only once it is able to open the file
+    waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r
+    waitOpen _    _    _       0 = do
+        putStrLn "[ERROR] Failed to retrieve modified file for regeneration"
+        exitFailure
+    waitOpen path mode handler retries = do
+        res <- try $ openFile path mode :: IO (Either IOException Handle)
+        case res of
+            Left ex -> if isPermissionError ex
+                       then do
+                           threadDelay 100000
+                           waitOpen path mode handler (retries - 1)
+                       else throw ex
+            Right h -> do
+                handled <- handler h
+                hClose h
+                return handled
 #endif
 
+
 --------------------------------------------------------------------------------
 eventPath :: Event -> FilePath
 eventPath evt = encodeString $ evtPath evt