diff options
Diffstat (limited to 'src/Hakyll/Preview/Poll.hs')
| -rw-r--r-- | src/Hakyll/Preview/Poll.hs | 33 |
1 files changed, 22 insertions, 11 deletions
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 |