From 5abc3d87e234c2f92b6c5481200d1f813ca2ce6f Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 23 Feb 2011 10:11:55 +0100 Subject: Add cabal flag for inotify --- hakyll.cabal | 21 ++++++++++--- src-inotify/Hakyll/Web/Preview/Poll.hs | 52 +++++++++++++++++++++++++++++++++ src-interval/Hakyll/Web/Preview/Poll.hs | 36 +++++++++++++++++++++++ src/Hakyll/Main.hs | 2 +- src/Hakyll/Web/Preview/INotify.hs | 52 --------------------------------- src/Hakyll/Web/Preview/Interval.hs | 36 ----------------------- 6 files changed, 106 insertions(+), 93 deletions(-) create mode 100644 src-inotify/Hakyll/Web/Preview/Poll.hs create mode 100644 src-interval/Hakyll/Web/Preview/Poll.hs delete mode 100644 src/Hakyll/Web/Preview/INotify.hs delete mode 100644 src/Hakyll/Web/Preview/Interval.hs diff --git a/hakyll.cabal b/hakyll.cabal index 57c6066..34d9cc2 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 2.4.1 +Version: 3.0.0.0 Synopsis: A simple static site generator library. Description: A simple static site generator library, mainly aimed at @@ -24,9 +24,20 @@ 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 + library ghc-options: -Wall hs-source-dirs: src + + if flag(inotify) + hs-source-dirs: src-inotify + else + hs-source-dirs: src-interval + build-depends: base >= 4 && < 5, filepath == 1.*, directory == 1.*, @@ -47,12 +58,14 @@ library utf8-string >= 0.3, hinotify >= 0.3, tagsoup >= 0.12, - hopenssl >= 1.4 + hopenssl >= 1.4, + unix >= 2.4, + strict-concurrency >= 0.2 exposed-modules: Hakyll Hakyll.Main Hakyll.Web.Util.String Hakyll.Web.Preview.Server - Hakyll.Web.Preview.INotify + Hakyll.Web.Preview.Poll Hakyll.Web.CompressCss Hakyll.Web.Template Hakyll.Web.Feed @@ -64,10 +77,10 @@ library Hakyll.Web.RelativizeUrls Hakyll.Web.Page.Read Hakyll.Web.Page.Metadata - Hakyll.Web Hakyll.Core.ResourceProvider.FileResourceProvider Hakyll.Core.Configuration Hakyll.Core.Identifier.Pattern + Hakyll.Core.UnixFilter Hakyll.Core.Util.Arrow Hakyll.Core.Util.File Hakyll.Core.ResourceProvider diff --git a/src-inotify/Hakyll/Web/Preview/Poll.hs b/src-inotify/Hakyll/Web/Preview/Poll.hs new file mode 100644 index 0000000..69370ac --- /dev/null +++ b/src-inotify/Hakyll/Web/Preview/Poll.hs @@ -0,0 +1,52 @@ +-- | Filesystem polling with an inotify backend. Works only on linux. +-- +module Hakyll.Web.Preview.Poll + ( previewPoll + ) where + +import Control.Monad (forM_, when) +import Data.Set (Set) +import qualified Data.Set as S +import System.FilePath (takeDirectory, ()) +import Data.List (isPrefixOf) + +import System.INotify + +import Hakyll.Core.Configuration +import Hakyll.Core.ResourceProvider +import Hakyll.Core.Identifier + +-- | Calls the given callback when the directory tree changes +-- +previewPoll :: HakyllConfiguration -- ^ Configuration + -> Set Resource -- ^ Resources to watch + -> IO () -- ^ Action called when something changes + -> IO () -- ^ Can block forever +previewPoll _ resources callback = do + -- Initialize inotify + inotify <- initINotify + + let -- A set of file paths + paths = S.map (toFilePath . unResource) resources + + -- A list of directories. Run it through a set so we have every + -- directory only once. + directories = S.toList $ S.map (notEmpty . takeDirectory) paths + + -- Problem: we can't add a watcher for "". So we make sure a directory + -- name is not empty + notEmpty "" = "." + notEmpty x = x + + -- Execute the callback when path is known + ifResource path = + let path' = if "./" `isPrefixOf` path then drop 2 path else path + in when (path' `S.member` paths) callback + + -- Add a watcher for every directory + forM_ directories $ \directory -> do + putStrLn $ "Adding watch for " ++ directory + _ <- addWatch inotify [Modify] directory $ \e -> case e of + (Modified _ (Just p)) -> ifResource $ directory p + _ -> return () + return () diff --git a/src-interval/Hakyll/Web/Preview/Poll.hs b/src-interval/Hakyll/Web/Preview/Poll.hs new file mode 100644 index 0000000..ec6df0c --- /dev/null +++ b/src-interval/Hakyll/Web/Preview/Poll.hs @@ -0,0 +1,36 @@ +-- | Interval-based implementation of preview polling, for the platforms which +-- are not supported by inotify. +-- +module Hakyll.Web.Preview.Poll + ( previewPoll + ) where + +import Control.Applicative ((<$>)) +import Control.Concurrent (threadDelay) +import Control.Monad (when) +import System.Time (getClockTime) +import Data.Set (Set) +import qualified Data.Set as S +import System.Directory (getModificationTime) + +import Hakyll.Core.Configuration +import Hakyll.Core.Identifier +import Hakyll.Core.ResourceProvider + +-- | A preview thread that periodically recompiles the site. +-- +previewPoll :: HakyllConfiguration -- ^ Configuration + -> Set Resource -- ^ Resources to watch + -> IO () -- ^ Action called when something changes + -> IO () -- ^ Can block forever +previewPoll _ resources callback = do + let files = map (toFilePath . unResource) $ S.toList resources + time <- getClockTime + loop files time + where + delay = 1000000 + loop files time = do + threadDelay delay + modified <- any (time <) <$> mapM getModificationTime files + when modified callback + loop files =<< getClockTime diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs index 13ec0dd..a44d9fa 100644 --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -14,7 +14,7 @@ import Hakyll.Core.Configuration import Hakyll.Core.Run import Hakyll.Core.Rules import Hakyll.Core.Rules.Internal -import Hakyll.Web.Preview.INotify +import Hakyll.Web.Preview.Poll import Hakyll.Web.Preview.Server -- | This usualy is the function with which the user runs the hakyll compiler diff --git a/src/Hakyll/Web/Preview/INotify.hs b/src/Hakyll/Web/Preview/INotify.hs deleted file mode 100644 index e21b767..0000000 --- a/src/Hakyll/Web/Preview/INotify.hs +++ /dev/null @@ -1,52 +0,0 @@ --- | Filesystem polling with an inotify backend. Works only on linux. --- -module Hakyll.Web.Preview.INotify - ( previewPoll - ) where - -import Control.Monad (forM_, when) -import Data.Set (Set) -import qualified Data.Set as S -import System.FilePath (takeDirectory, ()) -import Data.List (isPrefixOf) - -import System.INotify - -import Hakyll.Core.Configuration -import Hakyll.Core.ResourceProvider -import Hakyll.Core.Identifier - --- | Calls the given callback when the directory tree changes --- -previewPoll :: HakyllConfiguration -- ^ Configuration - -> Set Resource -- ^ Resources to watch - -> IO () -- ^ Action called when something changes - -> IO () -- ^ Can block forever -previewPoll _ resources callback = do - -- Initialize inotify - inotify <- initINotify - - let -- A set of file paths - paths = S.map (toFilePath . unResource) resources - - -- A list of directories. Run it through a set so we have every - -- directory only once. - directories = S.toList $ S.map (notEmpty . takeDirectory) paths - - -- Problem: we can't add a watcher for "". So we make sure a directory - -- name is not empty - notEmpty "" = "." - notEmpty x = x - - -- Execute the callback when path is known - ifResource path = - let path' = if "./" `isPrefixOf` path then drop 2 path else path - in when (path' `S.member` paths) callback - - -- Add a watcher for every directory - forM_ directories $ \directory -> do - putStrLn $ "Adding watch for " ++ directory - _ <- addWatch inotify [Modify] directory $ \e -> case e of - (Modified _ (Just p)) -> ifResource $ directory p - _ -> return () - return () diff --git a/src/Hakyll/Web/Preview/Interval.hs b/src/Hakyll/Web/Preview/Interval.hs deleted file mode 100644 index 5ab90e5..0000000 --- a/src/Hakyll/Web/Preview/Interval.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | Interval-based implementation of preview polling, for the platforms which --- are not supported by inotify. --- -module Hakyll.Web.Preview.Interval - ( previewPoll - ) where - -import Control.Applicative ((<$>)) -import Control.Concurrent (threadDelay) -import Control.Monad (when) -import System.Time (getClockTime) -import Data.Set (Set) -import qualified Data.Set as S -import System.Directory (getModificationTime) - -import Hakyll.Core.Configuration -import Hakyll.Core.Identifier -import Hakyll.Core.ResourceProvider - --- | A preview thread that periodically recompiles the site. --- -previewPoll :: HakyllConfiguration -- ^ Configuration - -> Set Resource -- ^ Resources to watch - -> IO () -- ^ Action called when something changes - -> IO () -- ^ Can block forever -previewPoll _ resources callback = do - let files = map (toFilePath . unResource) $ S.toList resources - time <- getClockTime - loop files time - where - delay = 1000000 - loop files time = do - threadDelay delay - modified <- any (time <) <$> mapM getModificationTime files - when modified callback - loop files =<< getClockTime -- cgit v1.2.3