fix preview functionality on windows
This commit is contained in:
parent
2430751164
commit
2fba64c5ad
1 changed files with 31 additions and 2 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue