hakyll 4.6.0.0 → 4.6.1.0

raw patch · 2 files changed

+63/−48 lines, 2 filesdep ~fsnotifydep ~pandoc-citeprocPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: fsnotify, pandoc-citeproc

API changes (from Hackage documentation)

Files

• hakyll.cabal +7/−7
• src/Hakyll/Preview/Poll.hs +56/−41

@@ -1,5 +1,5 @@ Name:    hakyll-Version: 4.6.0.0+Version: 4.6.1.0  Synopsis: A static website compiler library Description:@@ -160,7 +160,7 @@     old-locale      >= 1.0    && < 1.1,     old-time        >= 1.0    && < 1.2,     pandoc          >= 1.12.4 && < 1.14,-    pandoc-citeproc >= 0.4    && < 0.5,+    pandoc-citeproc >= 0.4    && < 0.7,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,     random          >= 1.0    && < 1.2,@@ -174,7 +174,7 @@     Build-depends:       snap-core       >= 0.6   && < 0.10,       snap-server     >= 0.6   && < 0.10,-      fsnotify        >= 0.0.6 && < 0.1,+      fsnotify        >= 0.1   && < 0.2,       system-filepath >= 0.4.6 && <= 0.5     Cpp-options:       -DPREVIEW_SERVER@@ -184,7 +184,7 @@    If flag(watchServer)     Build-depends:-      fsnotify        >= 0.0.6 && < 0.1,+      fsnotify        >= 0.1   && < 0.2,       system-filepath >= 0.4.6 && <= 0.5     Cpp-options:       -DWATCH_SERVER@@ -247,7 +247,7 @@     old-locale      >= 1.0    && < 1.1,     old-time        >= 1.0    && < 1.2,     pandoc          >= 1.12.4 && < 1.14,-    pandoc-citeproc >= 0.4    && < 0.5,+    pandoc-citeproc >= 0.4    && < 0.7,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,     random          >= 1.0    && < 1.2,@@ -261,7 +261,7 @@     Build-depends:       snap-core       >= 0.6   && < 0.10,       snap-server     >= 0.6   && < 0.10,-      fsnotify        >= 0.0.6 && < 0.1,+      fsnotify        >= 0.1   && < 0.2,       system-filepath >= 0.4.6 && <= 0.5     Cpp-options:       -DPREVIEW_SERVER@@ -271,7 +271,7 @@    If flag(watchServer)     Build-depends:-      fsnotify        >= 0.0.6 && < 0.1,+      fsnotify        >= 0.1   && < 0.2,       system-filepath >= 0.4.6 && <= 0.5     Cpp-options:       -DWATCH_SERVER

@@ -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 @@ 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,41 +57,52 @@             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+    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+        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+    -- 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