fix preview functionality on windows

This commit is contained in:
Jorge Israel Peña 2013-05-22 01:20:43 -07:00
parent 2430751164
commit 2fba64c5ad

View file

@ -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