hakyll/src-inotify/Hakyll/Web/Preview/Poll.hs

52 lines
1.7 KiB
Haskell
Raw Normal View History

2011-02-10 19:05:50 +00:00
-- | Filesystem polling with an inotify backend. Works only on linux.
--
2011-02-23 09:11:55 +00:00
module Hakyll.Web.Preview.Poll
2011-02-10 19:05:50 +00:00
( previewPoll
) where
2011-02-18 17:15:52 +00:00
import Control.Monad (forM_, when)
import Data.Set (Set)
import qualified Data.Set as S
2011-02-19 09:39:29 +00:00
import System.FilePath (takeDirectory, (</>))
2011-02-19 16:04:50 +00:00
import Data.List (isPrefixOf)
2011-02-10 19:05:50 +00:00
import System.INotify
import Hakyll.Core.Configuration
2011-02-18 17:15:52 +00:00
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Identifier
2011-02-10 19:05:50 +00:00
-- | Calls the given callback when the directory tree changes
--
previewPoll :: HakyllConfiguration -- ^ Configuration
2011-02-18 17:15:52 +00:00
-> Set Resource -- ^ Resources to watch
2011-02-10 19:05:50 +00:00
-> IO () -- ^ Action called when something changes
-> IO () -- ^ Can block forever
2011-02-18 17:15:52 +00:00
previewPoll _ resources callback = do
2011-02-10 19:05:50 +00:00
-- Initialize inotify
inotify <- initINotify
2011-02-18 17:15:52 +00:00
let -- A set of file paths
paths = S.map (toFilePath . unResource) resources
2011-02-10 19:05:50 +00:00
2011-02-19 09:39:29 +00:00
-- A list of directories. Run it through a set so we have every
-- directory only once.
2011-02-18 17:15:52 +00:00
directories = S.toList $ S.map (notEmpty . takeDirectory) paths
2011-02-19 09:39:29 +00:00
-- Problem: we can't add a watcher for "". So we make sure a directory
-- name is not empty
2011-02-18 17:15:52 +00:00
notEmpty "" = "."
notEmpty x = x
-- Execute the callback when path is known
2011-02-19 16:04:50 +00:00
ifResource path =
let path' = if "./" `isPrefixOf` path then drop 2 path else path
in when (path' `S.member` paths) callback
2011-02-18 17:15:52 +00:00
-- Add a watcher for every directory
forM_ directories $ \directory -> do
2011-02-19 09:39:29 +00:00
_ <- addWatch inotify [Modify] directory $ \e -> case e of
(Modified _ (Just p)) -> ifResource $ directory </> p
2011-02-18 17:15:52 +00:00
_ -> return ()
2011-02-10 19:05:50 +00:00
return ()