{-# LANGUAGE PatternGuards, TemplateHaskell #-}
module System.Directory.Watcher (
EventType(..), Event(..), eventType, eventPath, eventTime,
Watcher(..),
withWatcher,
watchDir, watchDir_, unwatchDir, isWatchingDir,
watchTree, watchTree_, unwatchTree, isWatchingTree,
readEvent, eventGroup, onEvents, onEvents_
) where
import Control.Lens (makeLenses)
import Control.Arrow
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (isJust)
import Data.Ratio ((%))
import Data.String (fromString)
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Clock.POSIX
import System.FilePath (takeDirectory, isDrive)
import System.Directory
import qualified System.FSNotify as FS
import HsDev.Util (uniqueBy)
data EventType = Added | Modified | Removed deriving (EventType -> EventType -> Bool
(EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool) -> Eq EventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c== :: EventType -> EventType -> Bool
Eq, Eq EventType
Eq EventType
-> (EventType -> EventType -> Ordering)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> EventType)
-> (EventType -> EventType -> EventType)
-> Ord EventType
EventType -> EventType -> Bool
EventType -> EventType -> Ordering
EventType -> EventType -> EventType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EventType -> EventType -> EventType
$cmin :: EventType -> EventType -> EventType
max :: EventType -> EventType -> EventType
$cmax :: EventType -> EventType -> EventType
>= :: EventType -> EventType -> Bool
$c>= :: EventType -> EventType -> Bool
> :: EventType -> EventType -> Bool
$c> :: EventType -> EventType -> Bool
<= :: EventType -> EventType -> Bool
$c<= :: EventType -> EventType -> Bool
< :: EventType -> EventType -> Bool
$c< :: EventType -> EventType -> Bool
compare :: EventType -> EventType -> Ordering
$ccompare :: EventType -> EventType -> Ordering
$cp1Ord :: Eq EventType
Ord, Int -> EventType
EventType -> Int
EventType -> [EventType]
EventType -> EventType
EventType -> EventType -> [EventType]
EventType -> EventType -> EventType -> [EventType]
(EventType -> EventType)
-> (EventType -> EventType)
-> (Int -> EventType)
-> (EventType -> Int)
-> (EventType -> [EventType])
-> (EventType -> EventType -> [EventType])
-> (EventType -> EventType -> [EventType])
-> (EventType -> EventType -> EventType -> [EventType])
-> Enum EventType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EventType -> EventType -> EventType -> [EventType]
$cenumFromThenTo :: EventType -> EventType -> EventType -> [EventType]
enumFromTo :: EventType -> EventType -> [EventType]
$cenumFromTo :: EventType -> EventType -> [EventType]
enumFromThen :: EventType -> EventType -> [EventType]
$cenumFromThen :: EventType -> EventType -> [EventType]
enumFrom :: EventType -> [EventType]
$cenumFrom :: EventType -> [EventType]
fromEnum :: EventType -> Int
$cfromEnum :: EventType -> Int
toEnum :: Int -> EventType
$ctoEnum :: Int -> EventType
pred :: EventType -> EventType
$cpred :: EventType -> EventType
succ :: EventType -> EventType
$csucc :: EventType -> EventType
Enum, EventType
EventType -> EventType -> Bounded EventType
forall a. a -> a -> Bounded a
maxBound :: EventType
$cmaxBound :: EventType
minBound :: EventType
$cminBound :: EventType
Bounded, ReadPrec [EventType]
ReadPrec EventType
Int -> ReadS EventType
ReadS [EventType]
(Int -> ReadS EventType)
-> ReadS [EventType]
-> ReadPrec EventType
-> ReadPrec [EventType]
-> Read EventType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EventType]
$creadListPrec :: ReadPrec [EventType]
readPrec :: ReadPrec EventType
$creadPrec :: ReadPrec EventType
readList :: ReadS [EventType]
$creadList :: ReadS [EventType]
readsPrec :: Int -> ReadS EventType
$creadsPrec :: Int -> ReadS EventType
Read, Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
(Int -> EventType -> ShowS)
-> (EventType -> String)
-> ([EventType] -> ShowS)
-> Show EventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> String
$cshow :: EventType -> String
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show)
data Event = Event {
Event -> EventType
_eventType :: EventType,
Event -> String
_eventPath :: FilePath,
Event -> POSIXTime
_eventTime :: POSIXTime }
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)
makeLenses ''Event
data Watcher a = Watcher {
Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs :: MVar (Map FilePath (Bool, IO ())),
Watcher a -> WatchManager
watcherMan :: FS.WatchManager,
Watcher a -> Chan (a, Event)
watcherChan :: Chan (a, Event) }
withWatcher :: (Watcher a -> IO b) -> IO b
withWatcher :: (Watcher a -> IO b) -> IO b
withWatcher Watcher a -> IO b
act = (WatchManager -> IO b) -> IO b
forall a. (WatchManager -> IO a) -> IO a
FS.withManager ((WatchManager -> IO b) -> IO b) -> (WatchManager -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \WatchManager
man -> do
Chan (a, Event)
ch <- IO (Chan (a, Event))
forall a. IO (Chan a)
newChan
MVar (Map String (Bool, IO ()))
dirs <- Map String (Bool, IO ()) -> IO (MVar (Map String (Bool, IO ())))
forall a. a -> IO (MVar a)
newMVar Map String (Bool, IO ())
forall k a. Map k a
M.empty
Watcher a -> IO b
act (Watcher a -> IO b) -> Watcher a -> IO b
forall a b. (a -> b) -> a -> b
$ MVar (Map String (Bool, IO ()))
-> WatchManager -> Chan (a, Event) -> Watcher a
forall a.
MVar (Map String (Bool, IO ()))
-> WatchManager -> Chan (a, Event) -> Watcher a
Watcher MVar (Map String (Bool, IO ()))
dirs WatchManager
man Chan (a, Event)
ch
watchDir :: Watcher a -> FilePath -> (Event -> Bool) -> a -> IO ()
watchDir :: Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchDir Watcher a
w String
f Event -> Bool
p a
v = do
Bool
e <- String -> IO Bool
doesDirectoryExist String
f
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String
f' <- String -> IO String
canonicalizePath String
f
Bool
watching <- Watcher a -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
isWatchingDir Watcher a
w String
f'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
watching (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
stop <- WatchManager -> String -> ActionPredicate -> Action -> IO (IO ())
FS.watchDir
(Watcher a -> WatchManager
forall a. Watcher a -> WatchManager
watcherMan Watcher a
w)
(ShowS
forall a. IsString a => String -> a
fromString String
f')
(Event -> Bool
p (Event -> Bool) -> (Event -> Event) -> ActionPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
fromEvent)
(Chan (a, Event) -> (a, Event) -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Watcher a -> Chan (a, Event)
forall a. Watcher a -> Chan (a, Event)
watcherChan Watcher a
w) ((a, Event) -> IO ()) -> (Event -> (a, Event)) -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
v (Event -> (a, Event)) -> (Event -> Event) -> Event -> (a, Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
fromEvent)
MVar (Map String (Bool, IO ()))
-> (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w) ((Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ())
-> (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Map String (Bool, IO ()) -> IO (Map String (Bool, IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> (Map String (Bool, IO ()) -> Map String (Bool, IO ()))
-> Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Bool, IO ())
-> Map String (Bool, IO ())
-> Map String (Bool, IO ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
f' (Bool
False, IO ()
stop)
watchDir_ :: Watcher () -> FilePath -> (Event -> Bool) -> IO ()
watchDir_ :: Watcher () -> String -> (Event -> Bool) -> IO ()
watchDir_ Watcher ()
w String
f Event -> Bool
p = Watcher () -> String -> (Event -> Bool) -> () -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchDir Watcher ()
w String
f Event -> Bool
p ()
unwatchDir :: Watcher a -> FilePath -> IO Bool
unwatchDir :: Watcher a -> String -> IO Bool
unwatchDir Watcher a
w String
f = do
String
f' <- String -> IO String
canonicalizePath String
f
Maybe (Bool, IO ())
stop <- MVar (Map String (Bool, IO ()))
-> (Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ()))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w) ((Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ())))
-> (Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ()))
forall a b. (a -> b) -> a -> b
$ (Map String (Bool, IO ()), Maybe (Bool, IO ()))
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map String (Bool, IO ()), Maybe (Bool, IO ()))
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> (Map String (Bool, IO ())
-> (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String (Bool, IO ()) -> Map String (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
f' (Map String (Bool, IO ()) -> Map String (Bool, IO ()))
-> (Map String (Bool, IO ()) -> Maybe (Bool, IO ()))
-> Map String (Bool, IO ())
-> (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> Map String (Bool, IO ()) -> Maybe (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
f')
IO () -> ((Bool, IO ()) -> IO ()) -> Maybe (Bool, IO ()) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Bool, IO ()) -> IO ()
forall a b. (a, b) -> b
snd Maybe (Bool, IO ())
stop
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, IO ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Bool, IO ())
stop
isWatchingDir :: Watcher a -> FilePath -> IO Bool
isWatchingDir :: Watcher a -> String -> IO Bool
isWatchingDir Watcher a
w String
f = do
String
f' <- String -> IO String
canonicalizePath String
f
Map String (Bool, IO ())
dirs <- MVar (Map String (Bool, IO ())) -> IO (Map String (Bool, IO ()))
forall a. MVar a -> IO a
readMVar (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Map String (Bool, IO ()) -> String -> Bool
isWatchingDir' Map String (Bool, IO ())
dirs String
f'
watchTree :: Watcher a -> FilePath -> (Event -> Bool) -> a -> IO ()
watchTree :: Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchTree Watcher a
w String
f Event -> Bool
p a
v = do
Bool
e <- String -> IO Bool
doesDirectoryExist String
f
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String
f' <- String -> IO String
canonicalizePath String
f
Bool
watching <- Watcher a -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
isWatchingTree Watcher a
w String
f'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
watching (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
stop <- WatchManager -> String -> ActionPredicate -> Action -> IO (IO ())
FS.watchTree
(Watcher a -> WatchManager
forall a. Watcher a -> WatchManager
watcherMan Watcher a
w)
(ShowS
forall a. IsString a => String -> a
fromString String
f')
(Event -> Bool
p (Event -> Bool) -> (Event -> Event) -> ActionPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
fromEvent)
(Chan (a, Event) -> (a, Event) -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Watcher a -> Chan (a, Event)
forall a. Watcher a -> Chan (a, Event)
watcherChan Watcher a
w) ((a, Event) -> IO ()) -> (Event -> (a, Event)) -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
v (Event -> (a, Event)) -> (Event -> Event) -> Event -> (a, Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
fromEvent)
MVar (Map String (Bool, IO ()))
-> (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w) ((Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ())
-> (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Map String (Bool, IO ()) -> IO (Map String (Bool, IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String (Bool, IO ()) -> IO (Map String (Bool, IO ())))
-> (Map String (Bool, IO ()) -> Map String (Bool, IO ()))
-> Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Bool, IO ())
-> Map String (Bool, IO ())
-> Map String (Bool, IO ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
f' (Bool
True, IO ()
stop)
watchTree_ :: Watcher () -> FilePath -> (Event -> Bool) -> IO ()
watchTree_ :: Watcher () -> String -> (Event -> Bool) -> IO ()
watchTree_ Watcher ()
w String
f Event -> Bool
p = Watcher () -> String -> (Event -> Bool) -> () -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchTree Watcher ()
w String
f Event -> Bool
p ()
unwatchTree :: Watcher a -> FilePath -> IO Bool
unwatchTree :: Watcher a -> String -> IO Bool
unwatchTree Watcher a
w String
f = do
String
f' <- String -> IO String
canonicalizePath String
f
Maybe (Bool, IO ())
stop <- MVar (Map String (Bool, IO ()))
-> (Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ()))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w) ((Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ())))
-> (Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> IO (Maybe (Bool, IO ()))
forall a b. (a -> b) -> a -> b
$ (Map String (Bool, IO ()), Maybe (Bool, IO ()))
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map String (Bool, IO ()), Maybe (Bool, IO ()))
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> (Map String (Bool, IO ())
-> (Map String (Bool, IO ()), Maybe (Bool, IO ())))
-> Map String (Bool, IO ())
-> IO (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String (Bool, IO ()) -> Map String (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
f' (Map String (Bool, IO ()) -> Map String (Bool, IO ()))
-> (Map String (Bool, IO ()) -> Maybe (Bool, IO ()))
-> Map String (Bool, IO ())
-> (Map String (Bool, IO ()), Maybe (Bool, IO ()))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> Map String (Bool, IO ()) -> Maybe (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
f')
IO () -> ((Bool, IO ()) -> IO ()) -> Maybe (Bool, IO ()) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Bool, IO ()) -> IO ()
forall a b. (a, b) -> b
snd Maybe (Bool, IO ())
stop
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, IO ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Bool, IO ())
stop
isWatchingTree :: Watcher a -> FilePath -> IO Bool
isWatchingTree :: Watcher a -> String -> IO Bool
isWatchingTree Watcher a
w String
f = do
String
f' <- String -> IO String
canonicalizePath String
f
Map String (Bool, IO ())
dirs <- MVar (Map String (Bool, IO ())) -> IO (Map String (Bool, IO ()))
forall a. MVar a -> IO a
readMVar (Watcher a -> MVar (Map String (Bool, IO ()))
forall a. Watcher a -> MVar (Map String (Bool, IO ()))
watcherDirs Watcher a
w)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Map String (Bool, IO ()) -> String -> Bool
isWatchingTree' Map String (Bool, IO ())
dirs String
f'
readEvent :: Watcher a -> IO (a, Event)
readEvent :: Watcher a -> IO (a, Event)
readEvent = Chan (a, Event) -> IO (a, Event)
forall a. Chan a -> IO a
readChan (Chan (a, Event) -> IO (a, Event))
-> (Watcher a -> Chan (a, Event)) -> Watcher a -> IO (a, Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Watcher a -> Chan (a, Event)
forall a. Watcher a -> Chan (a, Event)
watcherChan
eventGroup :: Watcher a -> NominalDiffTime -> ([(a, Event)] -> IO ()) -> IO ()
eventGroup :: Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
eventGroup Watcher a
w POSIXTime
tm [(a, Event)] -> IO ()
onGroup = do
TMVar [(a, Event)]
groupVar <- [(a, Event)] -> IO (TMVar [(a, Event)])
forall a. a -> IO (TMVar a)
newTMVarIO []
TMVar ()
syncVar <- IO (TMVar ())
forall a. IO (TMVar a)
newEmptyTMVarIO
Async Any
_ <- IO Any -> IO (Async Any)
forall a. IO a -> IO (Async a)
async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
(a, Event)
ev <- Chan (a, Event) -> IO (a, Event)
forall a. Chan a -> IO a
readChan (Watcher a -> Chan (a, Event)
forall a. Watcher a -> Chan (a, Event)
watcherChan Watcher a
w)
Bool
_ <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar () -> () -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar ()
syncVar ()
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[(a, Event)]
evs <- TMVar [(a, Event)] -> STM [(a, Event)]
forall a. TMVar a -> STM a
takeTMVar TMVar [(a, Event)]
groupVar
TMVar [(a, Event)] -> [(a, Event)] -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar [(a, Event)]
groupVar ((a, Event)
ev (a, Event) -> [(a, Event)] -> [(a, Event)]
forall a. a -> [a] -> [a]
: [(a, Event)]
evs)
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
()
_ <- STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> STM ()
forall a. TMVar a -> STM a
takeTMVar TMVar ()
syncVar
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime
tm POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1e6)
[(a, Event)]
evs' <- STM [(a, Event)] -> IO [(a, Event)]
forall a. STM a -> IO a
atomically (STM [(a, Event)] -> IO [(a, Event)])
-> STM [(a, Event)] -> IO [(a, Event)]
forall a b. (a -> b) -> a -> b
$ do
[(a, Event)]
evs <- TMVar [(a, Event)] -> STM [(a, Event)]
forall a. TMVar a -> STM a
takeTMVar TMVar [(a, Event)]
groupVar
TMVar [(a, Event)] -> [(a, Event)] -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar [(a, Event)]
groupVar []
Maybe ()
_ <- TMVar () -> STM (Maybe ())
forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar ()
syncVar
[(a, Event)] -> STM [(a, Event)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Event)] -> STM [(a, Event)])
-> [(a, Event)] -> STM [(a, Event)]
forall a b. (a -> b) -> a -> b
$ [(a, Event)] -> [(a, Event)]
forall a. [a] -> [a]
reverse [(a, Event)]
evs
[(a, Event)] -> IO ()
onGroup ([(a, Event)] -> IO ()) -> [(a, Event)] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((a, Event) -> (EventType, String)) -> [(a, Event)] -> [(a, Event)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy (\(a
_, Event
ev') -> (Event -> EventType
_eventType Event
ev', Event -> String
_eventPath Event
ev')) [(a, Event)]
evs'
onEvents :: Watcher a -> NominalDiffTime -> ([(a, Event)] -> IO ()) -> IO ()
onEvents :: Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
onEvents = Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
forall a.
Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
eventGroup
onEvents_ :: Watcher a -> ([(a, Event)] -> IO ()) -> IO ()
onEvents_ :: Watcher a -> ([(a, Event)] -> IO ()) -> IO ()
onEvents_ Watcher a
w = Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
forall a.
Watcher a -> POSIXTime -> ([(a, Event)] -> IO ()) -> IO ()
onEvents Watcher a
w (Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
5))
fromEvent :: FS.Event -> Event
fromEvent :: Event -> Event
fromEvent Event
e = EventType -> String -> POSIXTime -> Event
Event EventType
t (Event -> String
FS.eventPath Event
e) (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime) -> UTCTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Event -> UTCTime
FS.eventTime Event
e) where
t :: EventType
t = case Event
e of
FS.Added{} -> EventType
Added
FS.Modified{} -> EventType
Modified
FS.Removed{} -> EventType
Removed
isWatchingDir' :: Map FilePath (Bool, IO ()) -> FilePath -> Bool
isWatchingDir' :: Map String (Bool, IO ()) -> String -> Bool
isWatchingDir' Map String (Bool, IO ())
m String
dir
| Just (Bool
_, IO ()
_) <- String -> Map String (Bool, IO ()) -> Maybe (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
dir Map String (Bool, IO ())
m = Bool
True
| String -> Bool
isDrive String
dir = Bool
False
| Bool
otherwise = Map String (Bool, IO ()) -> String -> Bool
isWatchingTree' Map String (Bool, IO ())
m (ShowS
takeDirectory String
dir)
isWatchingTree' :: Map FilePath (Bool, IO ()) -> FilePath -> Bool
isWatchingTree' :: Map String (Bool, IO ()) -> String -> Bool
isWatchingTree' Map String (Bool, IO ())
m String
dir
| Just (Bool
True, IO ()
_) <- String -> Map String (Bool, IO ()) -> Maybe (Bool, IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
dir Map String (Bool, IO ())
m = Bool
True
| String -> Bool
isDrive String
dir = Bool
False
| Bool
otherwise = Map String (Bool, IO ()) -> String -> Bool
isWatchingTree' Map String (Bool, IO ())
m (ShowS
takeDirectory String
dir)