Merge branch 'master' into type-safe-identifiers

This commit is contained in:
Jasper Van der Jeugt 2011-05-27 21:02:52 +02:00
commit 73c93cc908
3 changed files with 46 additions and 46 deletions

View file

@ -1,5 +1,5 @@
Name: hakyll
Version: 3.1.2.5
Version: 3.1.2.6
Synopsis: A simple static site generator library.
Description: A simple static site generator library, mainly aimed at
@ -26,10 +26,13 @@ source-repository head
type: git
location: git://github.com/jaspervdj/hakyll.git
flag inotify
description: Use the inotify bindings for the preview server. Better, but
only works on Linux.
default: False
-- Disabled while inotify is broken with GHC 7. If you're interested in fixing,
-- contact me!
--
-- flag inotify
-- description: Use the inotify bindings for the preview server. Better,
-- but only works on Linux.
-- default: False
library
ghc-options: -Wall

View file

@ -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'

View file

@ -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 ()