add max-retries to waitOpen and gracefully handle remove/delete events

src/Hakyll/Preview/Poll.hs

@@ -8,7 +8,7 @@ module Hakyll.Preview.Poll
 
 --------------------------------------------------------------------------------
 import           Control.Concurrent.MVar        (newMVar, putMVar, takeMVar)
-import           Control.Monad                  (when)
+import           Control.Monad                  (when, void)
 import           Filesystem.Path.CurrentOS      (decodeString, encodeString)
 import           System.Directory               (canonicalizePath)
 import           System.FilePath                (pathSeparators, (</>))
@@ -16,10 +16,13 @@ import           System.FSNotify                (Event (..), WatchConfig (..),
                                                  startManagerConf, 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.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)
 #endif
 
 --------------------------------------------------------------------------------
@@ -53,24 +56,32 @@ watchUpdates conf update = do
     watchTree manager providerDir (not . isRemove) $ \event -> do
         ()       <- takeMVar lock
         allowed' <- allowed event
-        when allowed' $ update' ((encodeString providerDir) </> (eventPath event))
+        when allowed' $ update' event (encodeString providerDir)
         putMVar lock ()
     where
 #ifndef mingw32_HOST_OS
-      update' _ = update >> return ()
+      update' _     _        = void update
 #else
-      update' path = waitOpen path ReadMode (\_ -> update) >> return ()
+      update' event provider = do
+          let path = provider </> eventPath event
+          -- on windows
+          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) -> IO r
-      waitOpen path mode handler = do
+      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
+                             waitOpen path mode handler (retries - 1)
                          else throw ex
               Right h -> do
                   handled <- handler h