Merge branch 'hakyll3'

Conflicts:
	hakyll.cabal
	src/Text/Hakyll/Tags.hs

1 files changed, 51 insertions, 0 deletions

diff --git a/src-inotify/Hakyll/Web/Preview/Poll.hs b/src-inotify/Hakyll/Web/Preview/Poll.hs
new file mode 100644
index 0000000..686f045
--- /dev/null
+++ b/src-inotify/Hakyll/Web/Preview/Poll.hs
@@ -0,0 +1,51 @@
+-- | 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
+        _ <- addWatch inotify [Modify] directory $ \e -> case e of
+            (Modified _ (Just p)) -> ifResource $ directory </> p
+            _                     -> return ()
+        return ()