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