{- |
__Introduction__

This provides file watching as a Streamly stream. You can either watch recursively (namely, a directory's contents and
all its subdirectories as well), or not. You can also filter out file system events you are not interested in. Lastly,
we provide a compositional scheme for constructing filters for file system events.

__Example__

This example program watches @\/home\/koz\/c-project@ (and any of its subdirectories) for added or modified files with a
@.c@ extension, and emits the change to the terminal, along with a timestamp of when it happened, forever:

> {-# LANGUAGE LambdaCase #-}
>
> import Streamly.FSNotify (EventPredicate, hasExtension, isDirectory, invert, isDeletion, conj, watchTree)
> import System.Path (FsPath, FileExt(FileExt), fromFilePath)
> import qualified Streamly.Prelude as SP
>
> -- conj -> both must be true
> -- invert -> true when the argument would be false and vice versa
> isCSourceFile :: EventPredicate
> isCSourceFile = hasExtension (FileExt "c") `conj` invert isDirectory
>
> notDeletion :: EventPredicate
> notDeletion = invert isDeletion
>
> srcPath :: FsPath
> srcPath = fromFilePath "/home/koz/c-project"
>
> -- first value given by watchTree stops the watcher
> -- we don't use it here, but if you want to, just call it
> main :: IO ()
> main = do
>     (_, stream) <- watchTree srcPath (isCSourceFile `conj` notDeletion)
>     SP.drain . SP.mapM go $ stream
>   where
>     go = \case
>         Added p t _ -> putStrLn $ "Created: " ++ show p ++ " at " ++ show t
>         Modified p t _ -> putStrLn $ "Modified: " ++ show p ++ " at " ++ show t
>         _ -> pure ()
-}
module Streamly.FSNotify (
    -- * Basic types
    FSEntryType(..), Event(..), StopWatching,
    eventPath, eventTime, eventFSEntry,
    -- * Events and predicates
    EventPredicate(..),
    isDirectory, hasExtension, isCreation, isModification, isDeletion, isBasic, invert, conj, disj,
    -- * Watchers
    watchDirectory, watchDirectoryWith, watchTree, watchTreeWith,
) where

import Control.Arrow ((>>>))
import Control.Concurrent.Chan (newChan, readChan)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bool (bool)
import Data.Semiring (Semiring(..))
import Data.Text (Text, pack)
import Data.Time.Clock (UTCTime)
import Streamly (IsStream, MonadAsync)
import System.Path (Path, FsPath(..), FileExt, Absolute, isExtensionOf, toFilePath, makeAbsolute, fromAbsoluteFilePath)

import qualified Streamly.Prelude as SP
import qualified System.FSNotify as FSN


-- | Allows us to designate 'Event's as being fired by a directory or a non-directory entry.
data FSEntryType = Dir | NotDir
    deriving (FSEntryType -> FSEntryType -> Bool
(FSEntryType -> FSEntryType -> Bool)
-> (FSEntryType -> FSEntryType -> Bool) -> Eq FSEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FSEntryType -> FSEntryType -> Bool
$c/= :: FSEntryType -> FSEntryType -> Bool
== :: FSEntryType -> FSEntryType -> Bool
$c== :: FSEntryType -> FSEntryType -> Bool
Eq, Int -> FSEntryType -> ShowS
[FSEntryType] -> ShowS
FSEntryType -> String
(Int -> FSEntryType -> ShowS)
-> (FSEntryType -> String)
-> ([FSEntryType] -> ShowS)
-> Show FSEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FSEntryType] -> ShowS
$cshowList :: [FSEntryType] -> ShowS
show :: FSEntryType -> String
$cshow :: FSEntryType -> String
showsPrec :: Int -> FSEntryType -> ShowS
$cshowsPrec :: Int -> FSEntryType -> ShowS
Show, ReadPrec [FSEntryType]
ReadPrec FSEntryType
Int -> ReadS FSEntryType
ReadS [FSEntryType]
(Int -> ReadS FSEntryType)
-> ReadS [FSEntryType]
-> ReadPrec FSEntryType
-> ReadPrec [FSEntryType]
-> Read FSEntryType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FSEntryType]
$creadListPrec :: ReadPrec [FSEntryType]
readPrec :: ReadPrec FSEntryType
$creadPrec :: ReadPrec FSEntryType
readList :: ReadS [FSEntryType]
$creadList :: ReadS [FSEntryType]
readsPrec :: Int -> ReadS FSEntryType
$creadsPrec :: Int -> ReadS FSEntryType
Read, FSEntryType
FSEntryType -> FSEntryType -> Bounded FSEntryType
forall a. a -> a -> Bounded a
maxBound :: FSEntryType
$cmaxBound :: FSEntryType
minBound :: FSEntryType
$cminBound :: FSEntryType
Bounded, Int -> FSEntryType
FSEntryType -> Int
FSEntryType -> [FSEntryType]
FSEntryType -> FSEntryType
FSEntryType -> FSEntryType -> [FSEntryType]
FSEntryType -> FSEntryType -> FSEntryType -> [FSEntryType]
(FSEntryType -> FSEntryType)
-> (FSEntryType -> FSEntryType)
-> (Int -> FSEntryType)
-> (FSEntryType -> Int)
-> (FSEntryType -> [FSEntryType])
-> (FSEntryType -> FSEntryType -> [FSEntryType])
-> (FSEntryType -> FSEntryType -> [FSEntryType])
-> (FSEntryType -> FSEntryType -> FSEntryType -> [FSEntryType])
-> Enum FSEntryType
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 :: FSEntryType -> FSEntryType -> FSEntryType -> [FSEntryType]
$cenumFromThenTo :: FSEntryType -> FSEntryType -> FSEntryType -> [FSEntryType]
enumFromTo :: FSEntryType -> FSEntryType -> [FSEntryType]
$cenumFromTo :: FSEntryType -> FSEntryType -> [FSEntryType]
enumFromThen :: FSEntryType -> FSEntryType -> [FSEntryType]
$cenumFromThen :: FSEntryType -> FSEntryType -> [FSEntryType]
enumFrom :: FSEntryType -> [FSEntryType]
$cenumFrom :: FSEntryType -> [FSEntryType]
fromEnum :: FSEntryType -> Int
$cfromEnum :: FSEntryType -> Int
toEnum :: Int -> FSEntryType
$ctoEnum :: Int -> FSEntryType
pred :: FSEntryType -> FSEntryType
$cpred :: FSEntryType -> FSEntryType
succ :: FSEntryType -> FSEntryType
$csucc :: FSEntryType -> FSEntryType
Enum)

-- | A file system notification.
data Event
    = Added (Path Absolute) UTCTime FSEntryType -- ^ Creation event
    | Modified (Path Absolute) UTCTime FSEntryType -- ^ Modification event
    | Removed (Path Absolute) UTCTime FSEntryType -- ^ Deletion event
    | Other (Path Absolute) UTCTime Text -- ^ Some other kind of event
    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, 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)

-- | A function, which, when executed, stops a file system watch.
type StopWatching m = m ()

-- | Helper to retrieve the file path associated with an event.
eventPath :: Event -> FsPath
eventPath :: Event -> FsPath
eventPath = \case
    Added Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
    Modified Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
    Removed Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
    Other Path Absolute
p UTCTime
_ Text
_ -> Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p

-- | Helper to retrieve an event's timestamp.
eventTime :: Event -> UTCTime
eventTime :: Event -> UTCTime
eventTime = \case
    Added Path Absolute
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Modified Path Absolute
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Removed Path Absolute
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Other Path Absolute
_ UTCTime
t Text
_ -> UTCTime
t

-- | Helper to retrieve whether the event stems from a directory or not.
-- Returns 'Nothing' if the event is not \'basic\' (that is, not a creation, modification or deletion).
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry = \case
    Added Path Absolute
_ UTCTime
_ FSEntryType
e -> FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
    Modified Path Absolute
_ UTCTime
_ FSEntryType
e -> FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
    Removed Path Absolute
_ UTCTime
_ FSEntryType
e -> FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
    Other{} -> Maybe FSEntryType
forall a. Maybe a
Nothing


{- Predicates -}

-- | A \'test\' for whether we want to \'notice\' an event. Should return 'True' for events we care about.
newtype EventPredicate = EventPredicate { EventPredicate -> Event -> Bool
runPredicate :: Event -> Bool }

{- | 'EventPredicate' can be a 'Semigroup' in two ways:

- Under logical conjunction (both of the conditions must be met); and
- Under logical disjunction (either of the conditions must be met).

Both of these can be made into a 'Monoid' by using the trivial predicate (always true) for the first case, and the null
predicate (always false) for the second. This makes it a valid candidate to be a semiring, which allows our users to
compose 'EventPredicate's using both of these methods, as they see fit.

If you want an instance of 'Semigroup' and 'Monoid' with one of these behaviours, you can use 'Data.Semiring.Add' (for
the logical disjunction behaviour) or 'Data.Semiring.Mul' (for the logical conjunction behaviour).
-}
instance Semiring EventPredicate where
    (EventPredicate Event -> Bool
f) plus :: EventPredicate -> EventPredicate -> EventPredicate
`plus` (EventPredicate Event -> Bool
g) = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (Event -> Bool) -> Event -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> Bool
f (Event -> Bool -> Bool) -> (Event -> Bool) -> Event -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Event -> Bool
g
    zero :: EventPredicate
zero = EventPredicate
nothing
    (EventPredicate Event -> Bool
f) times :: EventPredicate -> EventPredicate -> EventPredicate
`times` (EventPredicate Event -> Bool
g) = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Event -> Bool) -> Event -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> Bool
f (Event -> Bool -> Bool) -> (Event -> Bool) -> Event -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Event -> Bool
g
    one :: EventPredicate
one = EventPredicate
everything

-- | Predicate conjunction (meaning that /both/ have to be true for the result to be true).
-- Synonym for 'Data.Semigroup.times'.
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj = EventPredicate -> EventPredicate -> EventPredicate
forall a. Semiring a => a -> a -> a
times

-- | Predicate disjunction (meaning that /either/ has to be true for the result to be true).
-- Synonym for 'Data.Semigroup.plus'.
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj = EventPredicate -> EventPredicate -> EventPredicate
forall a. Semiring a => a -> a -> a
plus

-- | The trivial predicate (allows any event through).
everything :: EventPredicate
everything :: EventPredicate
everything = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Bool -> Event -> Bool) -> Bool -> EventPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Event -> Bool
forall a b. a -> b -> a
const (Bool -> EventPredicate) -> Bool -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool
True

-- | The null predicate (allows no events through).
nothing :: EventPredicate
nothing :: EventPredicate
nothing = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Bool -> Event -> Bool) -> Bool -> EventPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Event -> Bool
forall a b. a -> b -> a
const (Bool -> EventPredicate) -> Bool -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool
False

-- | Allows through events that are caused by directories.
-- Note that this will assume that non-\'basic\' events (that is, not creations, modifications or deletions) do not stem
-- from directories; use with care.
isDirectory :: EventPredicate
isDirectory :: EventPredicate
isDirectory = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Event -> Maybe FSEntryType
eventFSEntry (Event -> Maybe FSEntryType)
-> (Maybe FSEntryType -> Bool) -> Event -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Maybe FSEntryType
Nothing -> Bool
False
    Just FSEntryType
Dir -> Bool
True
    Just FSEntryType
NotDir -> Bool
False

-- | Allows through events triggered by file system entries with a specific
-- extension.
hasExtension :: FileExt -> EventPredicate
hasExtension :: FileExt -> EventPredicate
hasExtension FileExt
fe = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ FileExt -> Path Absolute -> Bool
forall a. FileExt -> Path a -> Bool
isExtensionOf FileExt
fe (Path Absolute -> Bool)
-> (Event -> Path Absolute) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Added Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute
p
    Modified Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute
p
    Removed Path Absolute
p UTCTime
_ FSEntryType
_ -> Path Absolute
p
    Other Path Absolute
p UTCTime
_ Text
_ -> Path Absolute
p

-- | Allows through only creation events.
isCreation :: EventPredicate
isCreation :: EventPredicate
isCreation = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ \case
    Added{} -> Bool
True
    Event
_ -> Bool
False

-- | Allows through only modification events.
isModification :: EventPredicate
isModification :: EventPredicate
isModification = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ \case
    Modified{} -> Bool
True
    Event
_ -> Bool
False

-- | Allows through only deletion events.
isDeletion :: EventPredicate
isDeletion :: EventPredicate
isDeletion = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ \case
    Removed{} -> Bool
True
    Event
_ -> Bool
False

-- | Allows through only \'basic\' events (namely creation, modification and deletion).
isBasic :: EventPredicate
isBasic :: EventPredicate
isBasic = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ \case
    Other{} -> Bool
False
    Event
_ -> Bool
True

-- | \'Flips\' the predicate - what it used to allow through is now blocked, and vice versa.
invert :: EventPredicate -> EventPredicate
invert :: EventPredicate -> EventPredicate
invert (EventPredicate Event -> Bool
f) = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Event -> Bool) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Bool
f


{- Watchers -}

-- | Watch a given directory, but only at one level (thus, subdirectories will __not__ be watched recursively).
watchDirectory :: (IsStream t, MonadAsync m) => FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory :: FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory = (WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
FSN.watchDirChan WatchConfig
FSN.defaultConfig

-- | As 'watchDirectory', but with a specified set of watch options.
watchDirectoryWith :: (IsStream t, MonadAsync m) =>
    FSN.WatchConfig -> FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith :: WatchConfig
-> FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith = (WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
FSN.watchDirChan

-- | Watch a given directory recursively (thus, subdirectories will also have their contents watched).
watchTree :: (IsStream t, MonadAsync m) => FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchTree :: FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchTree = (WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
FSN.watchTreeChan WatchConfig
FSN.defaultConfig

-- | As 'watchTree', but with a specified set of watch options.
watchTreeWith :: (IsStream t, MonadAsync m) => FSN.WatchConfig -> FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith :: WatchConfig
-> FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith = (WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
FSN.watchTreeChan


{- Util -}

watch :: (IsStream t, MonadAsync m) =>
    (FSN.WatchManager -> FilePath -> FSN.ActionPredicate -> FSN.EventChannel -> IO FSN.StopListening) ->
    FSN.WatchConfig -> FsPath -> EventPredicate -> m (StopWatching m, t m Event)
watch :: (WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> FsPath
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f WatchConfig
conf FsPath
p EventPredicate
predicate = do
    WatchManager
manager <- IO WatchManager -> m WatchManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WatchManager -> m WatchManager)
-> (WatchConfig -> IO WatchManager)
-> WatchConfig
-> m WatchManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchConfig -> IO WatchManager
FSN.startManagerConf (WatchConfig -> m WatchManager) -> WatchConfig -> m WatchManager
forall a b. (a -> b) -> a -> b
$ WatchConfig
conf
    String
fp <- Path Absolute -> String
toFilePath (Path Absolute -> String) -> m (Path Absolute) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Path Absolute) -> m (Path Absolute)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FsPath -> IO (Path Absolute)
makeAbsolute FsPath
p)
    let pred' :: ActionPredicate
pred' = EventPredicate -> Event -> Bool
runPredicate EventPredicate
predicate (Event -> Bool) -> (Event -> Event) -> ActionPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
mungeEvent
    EventChannel
chan <- IO EventChannel -> m EventChannel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO EventChannel
forall a. IO (Chan a)
newChan
    StopListening
stop <- IO StopListening -> m StopListening
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StopListening -> m StopListening)
-> IO StopListening -> m StopListening
forall a b. (a -> b) -> a -> b
$ WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f WatchManager
manager String
fp ActionPredicate
pred' EventChannel
chan
    let reallyStop :: StopWatching m
reallyStop = StopListening -> StopWatching m
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO StopListening
stop StopWatching m -> StopWatching m -> StopWatching m
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StopListening -> StopWatching m
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WatchManager -> StopListening
FSN.stopManager WatchManager
manager)
    (StopWatching m, t m Event) -> m (StopWatching m, t m Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StopWatching m
reallyStop, m Event -> t m Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadAsync m) =>
m a -> t m a
SP.repeatM (m Event -> t m Event)
-> (IO Event -> m Event) -> IO Event -> t m Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event)
-> (IO Event -> IO Event) -> IO Event -> m Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Event) -> IO Event -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Event
mungeEvent (IO Event -> t m Event) -> IO Event -> t m Event
forall a b. (a -> b) -> a -> b
$ EventChannel -> IO Event
forall a. Chan a -> IO a
readChan EventChannel
chan)

mungeEvent :: FSN.Event -> Event
mungeEvent :: Event -> Event
mungeEvent = \case
    FSN.Added String
p UTCTime
t Bool
b-> Path Absolute -> UTCTime -> FSEntryType -> Event
Added (String -> Path Absolute
fromAbsoluteFilePath String
p) UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Modified String
p UTCTime
t Bool
b-> Path Absolute -> UTCTime -> FSEntryType -> Event
Modified (String -> Path Absolute
fromAbsoluteFilePath String
p) UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Removed String
p UTCTime
t Bool
b-> Path Absolute -> UTCTime -> FSEntryType -> Event
Modified (String -> Path Absolute
fromAbsoluteFilePath String
p) UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Unknown String
p UTCTime
t String
s-> Path Absolute -> UTCTime -> Text -> Event
Other (String -> Path Absolute
fromAbsoluteFilePath String
p) UTCTime
t (String -> Text
pack String
s)

isDir :: Bool -> FSEntryType
isDir :: Bool -> FSEntryType
isDir = FSEntryType -> FSEntryType -> Bool -> FSEntryType
forall a. a -> a -> Bool -> a
bool FSEntryType
NotDir FSEntryType
Dir