git.iko.soy/hakyll
on master help sign in
Merge pull request #155 from blaenk/win32-preview-fix
0409d61Jasper Van der Jeugt
src/Hakyll/Preview/Poll.hs+43−3
compare with master
unifiedsplit
@@ -1,3 +1,5 @@
1+{-# LANGUAGE CPP #-}
2+
1--------------------------------------------------------------------------------
3--------------------------------------------------------------------------------
2module Hakyll.Preview.Poll
4module Hakyll.Preview.Poll
3 ( watchUpdates
5 ( watchUpdates
@@ -6,13 +8,22 @@ module Hakyll.Preview.Poll
6
8
7--------------------------------------------------------------------------------
9--------------------------------------------------------------------------------
8import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
10import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
9−import Control.Monad (when)
11+import Control.Monad (when, void)
10import Filesystem.Path.CurrentOS (decodeString, encodeString)
12import Filesystem.Path.CurrentOS (decodeString, encodeString)
11import System.Directory (canonicalizePath)
13import System.Directory (canonicalizePath)
12−import System.FilePath (pathSeparators)
14+import System.FilePath (pathSeparators, (</>))
13import System.FSNotify (Event (..), WatchConfig (..),
15import System.FSNotify (Event (..), WatchConfig (..),
14 startManagerConf, watchTree)
16 startManagerConf, watchTree)
15
17
18+#ifdef mingw32_HOST_OS
19+import System.IO (IOMode(ReadMode), Handle, openFile,
20+ hClose)
21+import System.IO.Error (isPermissionError)
22+import Control.Concurrent (threadDelay)
23+import Control.Exception (IOException, throw, try)
24+import System.Exit (exitFailure)
25+import System.Directory (doesFileExist)
26+#endif
16
27
17--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
18import Hakyll.Core.Configuration
29import Hakyll.Core.Configuration
@@ -45,9 +56,38 @@ watchUpdates conf update = do
45 watchTree manager providerDir (not . isRemove) $ \event -> do
56 watchTree manager providerDir (not . isRemove) $ \event -> do
46 () <- takeMVar lock
57 () <- takeMVar lock
47 allowed' <- allowed event
58 allowed' <- allowed event
48− when allowed' $ update >> return ()
59+ when allowed' $ update' event (encodeString providerDir)
49 putMVar lock ()
60 putMVar lock ()
61+ where
62+#ifndef mingw32_HOST_OS
63+ update' _ _ = void update
64+#else
65+ update' event provider = do
66+ let path = provider </> eventPath event
67+ -- on windows, a 'Modified' event is also sent on file deletion
68+ fileExists <- doesFileExist path
69+
70+ when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10
50
71
72+ -- continuously attempts to open the file in between sleep intervals
73+ -- handler is run only once it is able to open the file
74+ waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r
75+ waitOpen _ _ _ 0 = do
76+ putStrLn "[ERROR] Failed to retrieve modified file for regeneration"
77+ exitFailure
78+ waitOpen path mode handler retries = do
79+ res <- try $ openFile path mode :: IO (Either IOException Handle)
80+ case res of
81+ Left ex -> if isPermissionError ex
82+ then do
83+ threadDelay 100000
84+ waitOpen path mode handler (retries - 1)
85+ else throw ex
86+ Right h -> do
87+ handled <- handler h
88+ hClose h
89+ return handled
90+#endif
51
91
52--------------------------------------------------------------------------------
92--------------------------------------------------------------------------------
53eventPath :: Event -> FilePath
93eventPath :: Event -> FilePath