git.iko.soy/hakyll
on master help sign in
Fix issue regarding preview server
06125eeJasper Van der Jeugt
src-interval/Hakyll/Web/Preview/Poll.hs+12−13
compare with master
unifiedsplit
@@ -7,30 +7,29 @@ module Hakyll.Web.Preview.Poll
7
7
8import Control.Applicative ((<$>))
8import Control.Applicative ((<$>))
9import Control.Concurrent (threadDelay)
9import Control.Concurrent (threadDelay)
10−import Control.Monad (when, filterM)
10+import Control.Monad (filterM)
11import System.Time (getClockTime)
11import System.Time (getClockTime)
12−import Data.Set (Set)
13−import qualified Data.Set as S
14import System.Directory (getModificationTime, doesFileExist)
12import System.Directory (getModificationTime, doesFileExist)
15
13
16import Hakyll.Core.Configuration
14import Hakyll.Core.Configuration
17−import Hakyll.Core.Resource
18
15
19-- | A preview thread that periodically recompiles the site.
16-- | A preview thread that periodically recompiles the site.
20--
17--
21previewPoll :: HakyllConfiguration -- ^ Configuration
18previewPoll :: HakyllConfiguration -- ^ Configuration
22− -> Set Resource -- ^ Resources to watch
19+ -> IO [FilePath] -- ^ Updating action
23− -> IO () -- ^ Action called when something changes
24 -> IO () -- ^ Can block forever
20 -> IO () -- ^ Can block forever
25−previewPoll _ resources callback = do
21+previewPoll _ update = do
26− let files = map unResource $ S.toList resources
27 time <- getClockTime
22 time <- getClockTime
28− loop files time
23+ loop time =<< update
29 where
24 where
30 delay = 1000000
25 delay = 1000000
31− loop files time = do
26+ loop time files = do
32 threadDelay delay
27 threadDelay delay
33 files' <- filterM doesFileExist files
28 files' <- filterM doesFileExist files
29+ filesTime <- case files' of
30+ [] -> return time
34− modified <- any (time <) <$> mapM getModificationTime files'
31+ _ -> maximum <$> mapM getModificationTime files'
35− when (modified || files' /= files) callback
32+
36− loop files' =<< getClockTime
33+ if filesTime > time || files' /= files
34+ then loop filesTime =<< update
35+ else loop time files'
src/Hakyll/Main.hs+26−28
@@ -5,12 +5,15 @@ module Hakyll.Main
5 , hakyllWith
5 , hakyllWith
6 ) where
6 ) where
7
7
8+import Control.Applicative ((<$>))
8import Control.Concurrent (forkIO)
9import Control.Concurrent (forkIO)
9import Control.Monad (when)
10import Control.Monad (when)
10import System.Environment (getProgName, getArgs)
11import System.Environment (getProgName, getArgs)
11import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
12import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
13+import qualified Data.Set as S
12
14
13import Hakyll.Core.Configuration
15import Hakyll.Core.Configuration
16+import Hakyll.Core.Resource
14import Hakyll.Core.Run
17import Hakyll.Core.Run
15import Hakyll.Core.Rules
18import Hakyll.Core.Rules
16import Hakyll.Core.Rules.Internal
19import Hakyll.Core.Rules.Internal
@@ -26,32 +29,32 @@ hakyll = hakyllWith defaultHakyllConfiguration
26-- configuration
29-- configuration
27--
30--
28hakyllWith :: HakyllConfiguration -> Rules -> IO ()
31hakyllWith :: HakyllConfiguration -> Rules -> IO ()
29−hakyllWith configuration rules = do
32+hakyllWith conf rules = do
30 args <- getArgs
33 args <- getArgs
31 case args of
34 case args of
32− ["build"] -> build configuration rules
35+ ["build"] -> build conf rules
33− ["clean"] -> clean configuration
36+ ["clean"] -> clean conf
34 ["help"] -> help
37 ["help"] -> help
35− ["preview"] -> preview configuration rules 8000
38+ ["preview"] -> preview conf rules 8000
36− ["preview", p] -> preview configuration rules (read p)
39+ ["preview", p] -> preview conf rules (read p)
37− ["rebuild"] -> rebuild configuration rules
40+ ["rebuild"] -> rebuild conf rules
38− ["server"] -> server configuration 8000
41+ ["server"] -> server conf 8000
39− ["server", p] -> server configuration (read p)
42+ ["server", p] -> server conf (read p)
40 _ -> help
43 _ -> help
41
44
42-- | Build the site
45-- | Build the site
43--
46--
44build :: HakyllConfiguration -> Rules -> IO ()
47build :: HakyllConfiguration -> Rules -> IO ()
45−build configuration rules = do
48+build conf rules = do
46− _ <- run configuration rules
49+ _ <- run conf rules
47 return ()
50 return ()
48
51
49-- | Remove the output directories
52-- | Remove the output directories
50--
53--
51clean :: HakyllConfiguration -> IO ()
54clean :: HakyllConfiguration -> IO ()
52−clean configuration = do
55+clean conf = do
53− remove $ destinationDirectory configuration
56+ remove $ destinationDirectory conf
54− remove $ storeDirectory configuration
57+ remove $ storeDirectory conf
55 where
58 where
56 remove dir = do
59 remove dir = do
57 putStrLn $ "Removing " ++ dir ++ "..."
60 putStrLn $ "Removing " ++ dir ++ "..."
@@ -82,32 +85,27 @@ help = do
82-- | Preview the site
85-- | Preview the site
83--
86--
84preview :: HakyllConfiguration -> Rules -> Int -> IO ()
87preview :: HakyllConfiguration -> Rules -> Int -> IO ()
85−preview configuration rules port = do
88+preview conf rules port = do
86− -- Build once, keep the rule set
87− ruleSet <- run configuration rules
88−
89− -- Get the resource list and a callback for the preview poll
90− let resources' = rulesResources ruleSet
91− callback = build configuration rules
92−
93 -- Fork a thread polling for changes
89 -- Fork a thread polling for changes
94− _ <- forkIO $ previewPoll configuration resources' callback
90+ _ <- forkIO $ previewPoll conf update
95
91
96 -- Run the server in the main thread
92 -- Run the server in the main thread
97− server configuration port
93+ server conf port
94+ where
95+ update = map unResource . S.toList . rulesResources <$> run conf rules
98
96
99-- | Rebuild the site
97-- | Rebuild the site
100--
98--
101rebuild :: HakyllConfiguration -> Rules -> IO ()
99rebuild :: HakyllConfiguration -> Rules -> IO ()
102−rebuild configuration rules = do
100+rebuild conf rules = do
103− clean configuration
101+ clean conf
104− build configuration rules
102+ build conf rules
105
103
106-- | Start a server
104-- | Start a server
107--
105--
108server :: HakyllConfiguration -> Int -> IO ()
106server :: HakyllConfiguration -> Int -> IO ()
109−server configuration port = do
107+server conf port = do
110− let destination = destinationDirectory configuration
108+ let destination = destinationDirectory conf
111 staticServer destination preServeHook port
109 staticServer destination preServeHook port
112 where
110 where
113 preServeHook _ = return ()
111 preServeHook _ = return ()