summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2013-05-24 00:47:06 -0700
committerJasper Van der Jeugt <jaspervdj@gmail.com>2013-05-24 00:47:06 -0700
commit0409d6110cecb264a9dc120bb6a1e6877c4b2409 (patch)
tree2ec402d7182145bff69a8b5c021619143fd84ee0
parentec1fefba4a24639af4b238ddbe424ccedf323d22 (diff)
parent294c48ea4819c98270a7373e2c0598ab15d82419 (diff)
downloadhakyll-0409d6110cecb264a9dc120bb6a1e6877c4b2409.tar.gz
Merge pull request #155 from blaenk/win32-preview-fix
fix preview functionality on windows
-rw-r--r--src/Hakyll/Preview/Poll.hs46
1 files changed, 43 insertions, 3 deletions
diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs
index 7dd266b..ab183f7 100644
--- a/src/Hakyll/Preview/Poll.hs
+++ b/src/Hakyll/Preview/Poll.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
--------------------------------------------------------------------------------
module Hakyll.Preview.Poll
( watchUpdates
@@ -6,13 +8,22 @@ 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)
+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)
+import System.Exit (exitFailure)
+import System.Directory (doesFileExist)
+#endif
--------------------------------------------------------------------------------
import Hakyll.Core.Configuration
@@ -45,9 +56,38 @@ watchUpdates conf update = do
watchTree manager providerDir (not . isRemove) $ \event -> do
() <- takeMVar lock
allowed' <- allowed event
- when allowed' $ update >> return ()
+ when allowed' $ update' event (encodeString providerDir)
putMVar lock ()
+ where
+#ifndef mingw32_HOST_OS
+ update' _ _ = void update
+#else
+ update' event provider = do
+ let path = provider </> eventPath event
+ -- on windows, a 'Modified' event is also sent on file deletion
+ 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) -> 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 (retries - 1)
+ else throw ex
+ Right h -> do
+ handled <- handler h
+ hClose h
+ return handled
+#endif
--------------------------------------------------------------------------------
eventPath :: Event -> FilePath