module System.Hiernotify.Polling
( mkPollNotifier
, Configuration (..)
, DifferenceP (..)
, Difference
, Notifier (..)
) where
import Control.Applicative ((<$>))
import Control.Monad (forever)
import Control.Concurrent (forkIO, threadDelay, ThreadId)
import Control.Concurrent.STM (newTVar, readTVar, writeTVar, atomically)
import Data.Maybe (catMaybes)
import Control.Concurrent.STM.TMonoid (TMonoid, newTMonoid, readTMonoid, writeTMonoid)
import System.Hiernotify.Controller (Controller (..), mkNotifier, NextDiff (..), getRecursiveContents)
import System.Hiernotify (Configuration (..), Notifier (..), DifferenceP (..), Difference)
import Data.List ((\\))
import Control.Concurrent.Killable (kill)
checkDifference :: (FilePath -> Bool)
-> FilePath
-> IO (IO Difference)
checkDifference g top' = do
t <- atomically $ newTVar []
return $ do
xs <- getRecursiveContents g top'
ws <- atomically $ do
ws <- readTVar t
writeTVar t xs
return ws
let
news' = map fst xs \\ map fst ws
deleteds' = map fst ws \\ map fst xs
modified' = catMaybes $ do
(x,y) <- xs
return $ lookup x ws >>= \y' -> if y /= y' then Just x else Nothing
return $ DifferenceP news' deleteds' modified'
trackPollFiles :: Int
-> (FilePath -> Bool)
-> FilePath
-> TMonoid Difference
-> IO ThreadId
trackPollFiles n g top' tm = do
s <- checkDifference g top'
k <- forkIO . forever $ threadDelay (1000000 * n) >> s >>= atomically . writeTMonoid tm
return k
mkPollNotifier :: Int
-> Configuration
-> IO Notifier
mkPollNotifier n (Configuration t s g) = do
tm <- atomically newTMonoid
p <- trackPollFiles n g t tm
let f = NextDiff $ (, f) `fmap` atomically (readTMonoid tm)
ps0 <- map fst <$> getRecursiveContents g t
Notifier no k <- mkNotifier s $ Controller ps0 f
return $ Notifier no $ kill p >> k