{- |
__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 System.FilePath ((</>))
> import Streamly.FSNotify (EventPredicate, hasExtension, isDirectory, invert, isDeletion, conj, watchTree)
> 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 "c" `conj` invert isDirectory
>
> notDeletion :: EventPredicate
> notDeletion = invert isDeletion
>
> srcPath :: FilePath
> srcPath = "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(stopWatching),
    eventPath, eventTime, eventFSEntry,
    -- * Events and predicates
    EventPredicate(..),
    everything, nothing, 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.Prelude (IsStream, MonadAsync)
import System.FilePath (isExtensionOf)

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
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
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]
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
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]
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 FilePath UTCTime FSEntryType -- ^ Creation event
    | Modified FilePath UTCTime FSEntryType -- ^ Modification event
    | Removed FilePath UTCTime FSEntryType -- ^ Deletion event
    | Other FilePath UTCTime Text -- ^ Some other kind of event
    deriving (Event -> Event -> Bool
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
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)

-- | An object, which, when executed with 'stopWatching', stops a file system watch.
newtype StopWatching m = StopWatching { forall (m :: * -> *). StopWatching m -> m ()
stopWatching :: m () }

-- | Helper to retrieve the file path associated with an event.
eventPath :: Event -> FilePath
eventPath :: Event -> String
eventPath = \case
    Added String
p UTCTime
_ FSEntryType
_ -> String
p
    Modified String
p UTCTime
_ FSEntryType
_ -> String
p
    Removed String
p UTCTime
_ FSEntryType
_ -> String
p
    Other String
p UTCTime
_ Text
_ -> String
p

-- | Helper to retrieve an event's timestamp.
eventTime :: Event -> UTCTime
eventTime :: Event -> UTCTime
eventTime = \case
    Added String
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Modified String
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Removed String
_ UTCTime
t FSEntryType
_ -> UTCTime
t
    Other String
_ 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 String
_ UTCTime
_ FSEntryType
e -> forall a. a -> Maybe a
Just FSEntryType
e
    Modified String
_ UTCTime
_ FSEntryType
e -> forall a. a -> Maybe a
Just FSEntryType
e
    Removed String
_ UTCTime
_ FSEntryType
e -> forall a. a -> Maybe a
Just FSEntryType
e
    Other{} -> 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 forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> Bool
f 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 forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> Bool
f 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 = 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 = forall a. Semiring a => a -> a -> a
plus

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

-- | The null predicate (allows no events through).
nothing :: EventPredicate
nothing :: EventPredicate
nothing = (Event -> Bool) -> EventPredicate
EventPredicate forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const 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 forall a b. (a -> b) -> a -> b
$ Event -> Maybe FSEntryType
eventFSEntry 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 :: FilePath -> EventPredicate
hasExtension :: String -> EventPredicate
hasExtension String
fe = (Event -> Bool) -> EventPredicate
EventPredicate forall a b. (a -> b) -> a -> b
$ (String
fe String -> String -> Bool
`isExtensionOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Added String
p UTCTime
_ FSEntryType
_ -> String
p
    Modified String
p UTCTime
_ FSEntryType
_ -> String
p
    Removed String
p UTCTime
_ FSEntryType
_ -> String
p
    Other String
p UTCTime
_ Text
_ -> String
p

-- | Allows through only creation events.
isCreation :: EventPredicate
isCreation :: EventPredicate
isCreation = (Event -> Bool) -> EventPredicate
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 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 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 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 forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not 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) => FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
String -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> 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 -> FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
WatchConfig
-> String -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> 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) => FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchTree :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
String -> EventPredicate -> m (StopWatching m, t m Event)
watchTree = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> 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 -> FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
WatchConfig
-> String -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> 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 -> FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watch :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadAsync m) =>
(WatchManager
 -> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> EventPredicate
-> m (StopWatching m, t m Event)
watch WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f WatchConfig
conf String
p EventPredicate
predicate = do
    WatchManager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WatchConfig -> IO WatchManager
FSN.startManagerConf WatchConfig
conf
    let pred' :: ActionPredicate
pred' = EventPredicate -> Event -> Bool
runPredicate EventPredicate
predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
mungeEvent
    EventChannel
chan <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (Chan a)
newChan
    StopListening
stop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f WatchManager
manager String
p ActionPredicate
pred' EventChannel
chan
    let reallyStop :: StopWatching m
reallyStop = forall (m :: * -> *). m () -> StopWatching m
StopWatching forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO StopListening
stop forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WatchManager -> StopListening
FSN.stopManager WatchManager
manager)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (StopWatching m
reallyStop, forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadAsync m) =>
m a -> t m a
SP.repeatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Event -> Event
mungeEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> String -> UTCTime -> FSEntryType -> Event
Added String
p UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Modified String
p UTCTime
t Bool
b -> String -> UTCTime -> FSEntryType -> Event
Modified String
p UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Removed String
p UTCTime
t Bool
b -> String -> UTCTime -> FSEntryType -> Event
Modified String
p UTCTime
t (Bool -> FSEntryType
isDir Bool
b)
    FSN.Unknown String
p UTCTime
t String
s -> String -> UTCTime -> Text -> Event
Other String
p UTCTime
t (String -> Text
pack String
s)

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