@@ -8,7 +8,7 @@ module Hakyll.Preview.Poll
9--------------------------------------------------------------------------------
9--------------------------------------------------------------------------------
10import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
10import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
11−import Control.Monad (when)
11+import Control.Monad (when, void)
12import Filesystem.Path.CurrentOS (decodeString, encodeString)
12import Filesystem.Path.CurrentOS (decodeString, encodeString)
13import System.Directory (canonicalizePath)
13import System.Directory (canonicalizePath)
14import System.FilePath (pathSeparators, (</>))
14import System.FilePath (pathSeparators, (</>))
@@ -16,10 +16,13 @@ import System.FSNotify (Event (..), WatchConfig (..),
16 startManagerConf, watchTree)
16 startManagerConf, watchTree)
18#ifdef mingw32_HOST_OS
18#ifdef mingw32_HOST_OS
19−import System.IO (IOMode(ReadMode), Handle, openFile, hClose)
19+import System.IO (IOMode(ReadMode), Handle, openFile,
20−import System.IO.Error (isPermissionError)
21+import System.IO.Error (isPermissionError)
21−import Control.Concurrent (threadDelay)
22+import Control.Concurrent (threadDelay)
22−import Control.Exception (IOException, throw, try)
23+import Control.Exception (IOException, throw, try)
24+import System.Exit (exitFailure)
25+import System.Directory (doesFileExist)
25--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
@@ -53,24 +56,32 @@ watchUpdates conf update = do
53 watchTree manager providerDir (not . isRemove) $ \event -> do
56 watchTree manager providerDir (not . isRemove) $ \event -> do
54 () <- takeMVar lock
57 () <- takeMVar lock
55 allowed' <- allowed event
58 allowed' <- allowed event
56− when allowed' $ update' ((encodeString providerDir) </> (eventPath event))
59+ when allowed' $ update' event (encodeString providerDir)
57 putMVar lock ()
60 putMVar lock ()
59#ifndef mingw32_HOST_OS
62#ifndef mingw32_HOST_OS
60− update' _ = update >> return ()
63+ update' _ _ = void update
65+ update' event provider = do
66+ let path = provider </> eventPath event
68+ fileExists <- doesFileExist path
62− update' path = waitOpen path ReadMode (\_ -> update) >> return ()
70+ when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10
64 -- continuously attempts to open the file in between sleep intervals
72 -- continuously attempts to open the file in between sleep intervals
65 -- handler is run only once it is able to open the file
73 -- handler is run only once it is able to open the file
66− waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
74+ waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r
75+ waitOpen _ _ _ 0 = do
76+ putStrLn "[ERROR] Failed to retrieve modified file for regeneration"
67− waitOpen path mode handler = do
78+ waitOpen path mode handler retries = do
68 res <- try $ openFile path mode :: IO (Either IOException Handle)
79 res <- try $ openFile path mode :: IO (Either IOException Handle)
69 case res of
80 case res of
70 Left ex -> if isPermissionError ex
81 Left ex -> if isPermissionError ex
72 threadDelay 100000
83 threadDelay 100000
73− waitOpen path mode handler
84+ waitOpen path mode handler (retries - 1)
74 else throw ex
85 else throw ex
75 Right h -> do
86 Right h -> do
76 handled <- handler h
87 handled <- handler h