1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
--------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Hakyll.Preview.Poll
( watchUpdates
) where
--------------------------------------------------------------------------------
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (newEmptyMVar, takeMVar,
tryPutMVar)
import Control.Exception (AsyncException, fromException,
handle, throw)
import Control.Monad (forever, void, when)
import System.Directory (canonicalizePath)
import System.FilePath (pathSeparators)
import System.FSNotify (Event (..), startManager,
watchTree)
#ifdef mingw32_HOST_OS
import Control.Concurrent (threadDelay)
import Control.Exception (IOException, throw, try)
import System.Directory (doesFileExist)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (Handle, IOMode (ReadMode),
hClose, openFile)
import System.IO.Error (isPermissionError)
#endif
--------------------------------------------------------------------------------
import Hakyll.Core.Configuration
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
--------------------------------------------------------------------------------
-- | A thread that watches for updates in a 'providerDirectory' and recompiles
-- a site as soon as any changes occur
watchUpdates :: Configuration -> IO Pattern -> IO ()
watchUpdates conf update = do
let providerDir = providerDirectory conf
shouldBuild <- newEmptyMVar
pattern <- update
fullProviderDir <- canonicalizePath $ providerDirectory conf
manager <- startManager
let allowed event = do
-- Absolute path of the changed file. This must be inside provider
-- dir, since that's the only dir we're watching.
let path = eventPath event
relative = dropWhile (`elem` pathSeparators) $
drop (length fullProviderDir) path
identifier = fromFilePath relative
shouldIgnore <- shouldIgnoreFile conf path
return $ not shouldIgnore && matches pattern identifier
-- This thread continually watches the `shouldBuild` MVar and builds
-- whenever a value is present.
_ <- forkIO $ forever $ do
event <- takeMVar shouldBuild
handle
(\e -> case fromException e of
Nothing -> putStrLn (show e)
Just async -> throw (async :: AsyncException))
(update' event providerDir)
-- Send an event whenever something occurs so that the thread described
-- above will do a build.
void $ watchTree manager providerDir (not . isRemove) $ \event -> do
allowed' <- allowed event
when allowed' $ void $ tryPutMVar shouldBuild event
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
eventPath evt = evtPath evt
where
evtPath (Added p _) = p
evtPath (Modified p _) = p
evtPath (Removed p _) = p
--------------------------------------------------------------------------------
isRemove :: Event -> Bool
isRemove (Removed _ _) = True
isRemove _ = False
|
