From 2fba64c5adb65a954448e37e2f83772ae865ea17 Mon Sep 17 00:00:00 2001 From: Jorge Israel Peña Date: Wed, 22 May 2013 01:20:43 -0700 Subject: fix preview functionality on windows --- src/Hakyll/Preview/Poll.hs | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs index 7dd266b..e1effec 100644 --- a/src/Hakyll/Preview/Poll.hs +++ b/src/Hakyll/Preview/Poll.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -------------------------------------------------------------------------------- module Hakyll.Preview.Poll ( watchUpdates @@ -9,10 +11,16 @@ import Control.Concurrent.MVar (newMVar, putMVar, takeMVar) import Control.Monad (when) import Filesystem.Path.CurrentOS (decodeString, encodeString) import System.Directory (canonicalizePath) -import System.FilePath (pathSeparators) +import System.FilePath (pathSeparators, ()) 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) +#endif -------------------------------------------------------------------------------- import Hakyll.Core.Configuration @@ -45,9 +53,30 @@ watchUpdates conf update = do watchTree manager providerDir (not . isRemove) $ \event -> do () <- takeMVar lock allowed' <- allowed event - when allowed' $ update >> return () + when allowed' $ update' ((encodeString providerDir) (eventPath event)) putMVar lock () + where +#ifndef mingw32_HOST_OS + update' _ = update >> return () +#else + update' path = waitOpen path ReadMode (\_ -> update) >> return () + -- 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 + 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 + else throw ex + Right h -> do + handled <- handler h + hClose h + return handled +#endif -------------------------------------------------------------------------------- eventPath :: Event -> FilePath -- cgit v1.2.3 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 From 294c48ea4819c98270a7373e2c0598ab15d82419 Mon Sep 17 00:00:00 2001 From: Jorge Israel Peña Date: Wed, 22 May 2013 17:28:32 -0700 Subject: finish incomplete comment --- src/Hakyll/Preview/Poll.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs index 5ab8600..ab183f7 100644 --- a/src/Hakyll/Preview/Poll.hs +++ b/src/Hakyll/Preview/Poll.hs @@ -64,7 +64,7 @@ watchUpdates conf update = do #else update' event provider = do let path = provider eventPath event - -- on windows + -- on windows, a 'Modified' event is also sent on file deletion fileExists <- doesFileExist path when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10 -- cgit v1.2.3