add max-retries to waitOpen and gracefully handle remove/delete events
This commit is contained in:
parent
2fba64c5ad
commit
e987485e2d
1 changed files with 22 additions and 11 deletions
|
@ -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 (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
|
||||
|
|
Loading…
Reference in a new issue