summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src-interval/Hakyll/Web/Preview/Poll.hs25
-rw-r--r--src/Hakyll/Main.hs54
2 files changed, 38 insertions, 41 deletions
diff --git a/src-interval/Hakyll/Web/Preview/Poll.hs b/src-interval/Hakyll/Web/Preview/Poll.hs
index 0c9f771..68ea8d4 100644
--- a/src-interval/Hakyll/Web/Preview/Poll.hs
+++ b/src-interval/Hakyll/Web/Preview/Poll.hs
@@ -7,30 +7,29 @@ module Hakyll.Web.Preview.Poll
import Control.Applicative ((<$>))
import Control.Concurrent (threadDelay)
-import Control.Monad (when, filterM)
+import Control.Monad (filterM)
import System.Time (getClockTime)
-import Data.Set (Set)
-import qualified Data.Set as S
import System.Directory (getModificationTime, doesFileExist)
import Hakyll.Core.Configuration
-import Hakyll.Core.Resource
-- | A preview thread that periodically recompiles the site.
--
previewPoll :: HakyllConfiguration -- ^ Configuration
- -> Set Resource -- ^ Resources to watch
- -> IO () -- ^ Action called when something changes
+ -> IO [FilePath] -- ^ Updating action
-> IO () -- ^ Can block forever
-previewPoll _ resources callback = do
- let files = map unResource $ S.toList resources
+previewPoll _ update = do
time <- getClockTime
- loop files time
+ loop time =<< update
where
delay = 1000000
- loop files time = do
+ loop time files = do
threadDelay delay
files' <- filterM doesFileExist files
- modified <- any (time <) <$> mapM getModificationTime files'
- when (modified || files' /= files) callback
- loop files' =<< getClockTime
+ filesTime <- case files' of
+ [] -> return time
+ _ -> maximum <$> mapM getModificationTime files'
+
+ if filesTime > time || files' /= files
+ then loop filesTime =<< update
+ else loop time files'
diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs
index c51bd47..49a34ec 100644
--- a/src/Hakyll/Main.hs
+++ b/src/Hakyll/Main.hs
@@ -5,12 +5,15 @@ module Hakyll.Main
, hakyllWith
) where
+import Control.Applicative ((<$>))
import Control.Concurrent (forkIO)
import Control.Monad (when)
import System.Environment (getProgName, getArgs)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
+import qualified Data.Set as S
import Hakyll.Core.Configuration
+import Hakyll.Core.Resource
import Hakyll.Core.Run
import Hakyll.Core.Rules
import Hakyll.Core.Rules.Internal
@@ -26,32 +29,32 @@ hakyll = hakyllWith defaultHakyllConfiguration
-- configuration
--
hakyllWith :: HakyllConfiguration -> Rules -> IO ()
-hakyllWith configuration rules = do
+hakyllWith conf rules = do
args <- getArgs
case args of
- ["build"] -> build configuration rules
- ["clean"] -> clean configuration
+ ["build"] -> build conf rules
+ ["clean"] -> clean conf
["help"] -> help
- ["preview"] -> preview configuration rules 8000
- ["preview", p] -> preview configuration rules (read p)
- ["rebuild"] -> rebuild configuration rules
- ["server"] -> server configuration 8000
- ["server", p] -> server configuration (read p)
+ ["preview"] -> preview conf rules 8000
+ ["preview", p] -> preview conf rules (read p)
+ ["rebuild"] -> rebuild conf rules
+ ["server"] -> server conf 8000
+ ["server", p] -> server conf (read p)
_ -> help
-- | Build the site
--
build :: HakyllConfiguration -> Rules -> IO ()
-build configuration rules = do
- _ <- run configuration rules
+build conf rules = do
+ _ <- run conf rules
return ()
-- | Remove the output directories
--
clean :: HakyllConfiguration -> IO ()
-clean configuration = do
- remove $ destinationDirectory configuration
- remove $ storeDirectory configuration
+clean conf = do
+ remove $ destinationDirectory conf
+ remove $ storeDirectory conf
where
remove dir = do
putStrLn $ "Removing " ++ dir ++ "..."
@@ -82,32 +85,27 @@ help = do
-- | Preview the site
--
preview :: HakyllConfiguration -> Rules -> Int -> IO ()
-preview configuration rules port = do
- -- Build once, keep the rule set
- ruleSet <- run configuration rules
-
- -- Get the resource list and a callback for the preview poll
- let resources' = rulesResources ruleSet
- callback = build configuration rules
-
+preview conf rules port = do
-- Fork a thread polling for changes
- _ <- forkIO $ previewPoll configuration resources' callback
+ _ <- forkIO $ previewPoll conf update
-- Run the server in the main thread
- server configuration port
+ server conf port
+ where
+ update = map unResource . S.toList . rulesResources <$> run conf rules
-- | Rebuild the site
--
rebuild :: HakyllConfiguration -> Rules -> IO ()
-rebuild configuration rules = do
- clean configuration
- build configuration rules
+rebuild conf rules = do
+ clean conf
+ build conf rules
-- | Start a server
--
server :: HakyllConfiguration -> Int -> IO ()
-server configuration port = do
- let destination = destinationDirectory configuration
+server conf port = do
+ let destination = destinationDirectory conf
staticServer destination preServeHook port
where
preServeHook _ = return ()