git.iko.soy/hakyll
on master help sign in
Fix issue regarding preview server
commit06125ee07f546d67f2f8ba25c24f3b3b6857da33 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 27 May 2011, 21:00 (15 years ago) parent93276a4
2 files changed+38−41
compare with master
unifiedsplit
src-interval/Hakyll/Web/Preview/Poll.hs+12−13 src/Hakyll/Main.hs+26−28
src-interval/Hakyll/Web/Preview/Poll.hs+12−13
@@ -7,30 +7,29 @@ module Hakyll.Web.Preview.Poll
77
88import Control.Applicative ((<$>))
99import Control.Concurrent (threadDelay)
10−import Control.Monad (when, filterM)
10+import Control.Monad (filterM)
1111import System.Time (getClockTime)
12−import Data.Set (Set)
13−import qualified Data.Set as S
1412import System.Directory (getModificationTime, doesFileExist)
1513
1614import Hakyll.Core.Configuration
17−import Hakyll.Core.Resource
1815
1916-- | A preview thread that periodically recompiles the site.
2017--
2118previewPoll :: HakyllConfiguration -- ^ Configuration
22− -> Set Resource -- ^ Resources to watch
23− -> IO () -- ^ Action called when something changes
19+ -> IO [FilePath] -- ^ Updating action
2420 -> IO () -- ^ Can block forever
25−previewPoll _ resources callback = do
26− let files = map unResource $ S.toList resources
21+previewPoll _ update = do
2722 time <- getClockTime
28− loop files time
23+ loop time =<< update
2924 where
3025 delay = 1000000
31− loop files time = do
26+ loop time files = do
3227 threadDelay delay
3328 files' <- filterM doesFileExist files
34− modified <- any (time <) <$> mapM getModificationTime files'
35− when (modified || files' /= files) callback
36− loop files' =<< getClockTime
29+ filesTime <- case files' of
30+ [] -> return time
31+ _ -> maximum <$> mapM getModificationTime files'
32+
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
55 , hakyllWith
66 ) where
77
8+import Control.Applicative ((<$>))
89import Control.Concurrent (forkIO)
910import Control.Monad (when)
1011import System.Environment (getProgName, getArgs)
1112import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
13+import qualified Data.Set as S
1214
1315import Hakyll.Core.Configuration
16+import Hakyll.Core.Resource
1417import Hakyll.Core.Run
1518import Hakyll.Core.Rules
1619import Hakyll.Core.Rules.Internal
@@ -26,32 +29,32 @@ hakyll = hakyllWith defaultHakyllConfiguration
2629-- configuration
2730--
2831hakyllWith :: HakyllConfiguration -> Rules -> IO ()
29−hakyllWith configuration rules = do
32+hakyllWith conf rules = do
3033 args <- getArgs
3134 case args of
32− ["build"] -> build configuration rules
33− ["clean"] -> clean configuration
35+ ["build"] -> build conf rules
36+ ["clean"] -> clean conf
3437 ["help"] -> help
35− ["preview"] -> preview configuration rules 8000
36− ["preview", p] -> preview configuration rules (read p)
37− ["rebuild"] -> rebuild configuration rules
38− ["server"] -> server configuration 8000
39− ["server", p] -> server configuration (read p)
38+ ["preview"] -> preview conf rules 8000
39+ ["preview", p] -> preview conf rules (read p)
40+ ["rebuild"] -> rebuild conf rules
41+ ["server"] -> server conf 8000
42+ ["server", p] -> server conf (read p)
4043 _ -> help
4144
4245-- | Build the site
4346--
4447build :: HakyllConfiguration -> Rules -> IO ()
45−build configuration rules = do
46− _ <- run configuration rules
48+build conf rules = do
49+ _ <- run conf rules
4750 return ()
4851
4952-- | Remove the output directories
5053--
5154clean :: HakyllConfiguration -> IO ()
52−clean configuration = do
53− remove $ destinationDirectory configuration
54− remove $ storeDirectory configuration
55+clean conf = do
56+ remove $ destinationDirectory conf
57+ remove $ storeDirectory conf
5558 where
5659 remove dir = do
5760 putStrLn $ "Removing " ++ dir ++ "..."
@@ -82,32 +85,27 @@ help = do
8285-- | Preview the site
8386--
8487preview :: HakyllConfiguration -> Rules -> Int -> IO ()
85−preview configuration 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−
88+preview conf rules port = do
9389 -- Fork a thread polling for changes
94− _ <- forkIO $ previewPoll configuration resources' callback
90+ _ <- forkIO $ previewPoll conf update
9591
9692 -- 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
9896
9997-- | Rebuild the site
10098--
10199rebuild :: HakyllConfiguration -> Rules -> IO ()
102−rebuild configuration rules = do
103− clean configuration
104− build configuration rules
100+rebuild conf rules = do
101+ clean conf
102+ build conf rules
105103
106104-- | Start a server
107105--
108106server :: HakyllConfiguration -> Int -> IO ()
109−server configuration port = do
110− let destination = destinationDirectory configuration
107+server conf port = do
108+ let destination = destinationDirectory conf
111109 staticServer destination preServeHook port
112110 where
113111 preServeHook _ = return ()