{-# LANGUAGE PatternGuards, TemplateHaskell #-}

module System.Directory.Watcher (
	EventType(..), Event(..), eventType, eventPath, eventTime,
	Watcher(..),
	withWatcher,
	watchDir, watchDir_, unwatchDir, isWatchingDir,
	watchTree, watchTree_, unwatchTree, isWatchingTree,
	-- * Working with events
	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)

-- | Event type
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)

-- | Event
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

-- | Directories watcher
data Watcher a = Watcher {
	-- | Map from directory to watch stopper
	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) }

-- | Create watcher
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

-- | Watch directory
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 ()

-- | Unwatch directory, return @False@, if not watched
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

-- | Check if we are watching dir
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'

-- | Watch directory tree
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 ()

-- | Unwatch directory tree
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

-- | Check if we are watching tree
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'

-- | Read next event
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

-- | Get event group
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'

-- | Process all events
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

-- | Process all events
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)