git.iko.soy/hakyll
on master help sign in
fix preview functionality on windows
2fba64cJorge Israel Peña
src/Hakyll/Preview/Poll.hs+31−2
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
@@ -9,10 +11,16 @@ import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)
9import Control.Monad (when)
11import Control.Monad (when)
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, hClose)
20+import System.IO.Error (isPermissionError)
21+import Control.Concurrent (threadDelay)
22+import Control.Exception (IOException, throw, try)
23+#endif
16
24
17--------------------------------------------------------------------------------
25--------------------------------------------------------------------------------
18import Hakyll.Core.Configuration
26import Hakyll.Core.Configuration
@@ -45,9 +53,30 @@ watchUpdates conf update = do
45 watchTree manager providerDir (not . isRemove) $ \event -> do
53 watchTree manager providerDir (not . isRemove) $ \event -> do
46 () <- takeMVar lock
54 () <- takeMVar lock
47 allowed' <- allowed event
55 allowed' <- allowed event
48− when allowed' $ update >> return ()
56+ when allowed' $ update' ((encodeString providerDir) </> (eventPath event))
49 putMVar lock ()
57 putMVar lock ()
58+ where
59+#ifndef mingw32_HOST_OS
60+ update' _ = update >> return ()
61+#else
62+ update' path = waitOpen path ReadMode (\_ -> update) >> return ()
50
63
64+ -- continuously attempts to open the file in between sleep intervals
65+ -- handler is run only once it is able to open the file
66+ waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
67+ waitOpen path mode handler = do
68+ res <- try $ openFile path mode :: IO (Either IOException Handle)
69+ case res of
70+ Left ex -> if isPermissionError ex
71+ then do
72+ threadDelay 100000
73+ waitOpen path mode handler
74+ else throw ex
75+ Right h -> do
76+ handled <- handler h
77+ hClose h
78+ return handled
79+#endif
51
80
52--------------------------------------------------------------------------------
81--------------------------------------------------------------------------------
53eventPath :: Event -> FilePath
82eventPath :: Event -> FilePath