From e987485e2d6c3b73bf917890d8cf965173af3716 Mon Sep 17 00:00:00 2001 From: Jorge Israel Peña Date: Wed, 22 May 2013 17:06:17 -0700 Subject: add max-retries to waitOpen and gracefully handle remove/delete events --- src/Hakyll/Preview/Poll.hs | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs index e1effec..5ab8600 100644 --- a/src/Hakyll/Preview/Poll.hs +++ b/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 -- cgit v1.2.3