{-
 - Copyright (C) 2019  Koz Ross <koz.ross@retro-freedom.nz>
 -
 - This program is free software: you can redistribute it and/or modify
 - it under the terms of the GNU General Public License as published by
 - the Free Software Foundation, either version 3 of the License, or
 - (at your option) any later version.
 -
 - This program is distributed in the hope that it will be useful,
 - but WITHOUT ANY WARRANTY; without even the implied warranty of
 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 - GNU General Public License for more details.
 -
 - You should have received a copy of the GNU General Public License
 - along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}

{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module:        Streamly.FSNotify
-- Description:   Filesystem watching as Streamly streams. 
-- Copyright:     (C) Koz Ross 2019
-- License:       GPL version 3.0 or later
-- Maintainer:    koz.ross@retro-freedom.nz
-- Stability:     Experimental
-- Portability:   GHC only
--
-- __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, 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 Data.Semiring (Semiring(..))
import Control.Concurrent.Chan (newChan, readChan)
import Streamly (IsStream, MonadAsync)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bool (bool)
import Data.Time.Clock (UTCTime)
import Data.Text (Text, pack)
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.
{-# INLINE eventPath #-}
eventPath :: Event -> FsPath
eventPath :: Event -> FsPath
eventPath (Added p :: Path Absolute
p _ _) = Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
eventPath (Modified p :: Path Absolute
p _ _) = Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
eventPath (Removed p :: Path Absolute
p _ _) = Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p
eventPath (Other p :: Path Absolute
p _ _) = Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath Path Absolute
p

-- | Helper to retrieve an event's timestamp.
{-# INLINE eventTime #-}
eventTime :: Event -> UTCTime
eventTime :: Event -> UTCTime
eventTime (Added _ t :: UTCTime
t _) = UTCTime
t
eventTime (Modified _ t :: UTCTime
t _) = UTCTime
t
eventTime (Removed _ t :: UTCTime
t _) = UTCTime
t
eventTime (Other _ t :: UTCTime
t _) = 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).
{-# INLINE eventFSEntry #-}
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry (Added _ _ e :: FSEntryType
e) = FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
eventFSEntry (Modified _ _ e :: FSEntryType
e) = FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
eventFSEntry (Removed _ _ e :: FSEntryType
e) = FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
eventFSEntry 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
  {-# INLINE plus #-}
  (EventPredicate f :: Event -> Bool
f) plus :: EventPredicate -> EventPredicate -> EventPredicate
`plus` (EventPredicate g :: Event -> Bool
g) = (Event -> Bool) -> EventPredicate
EventPredicate (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)
  {-# INLINE zero #-}
  zero :: EventPredicate
zero = EventPredicate
nothing
  {-# INLINE times #-}
  (EventPredicate f :: Event -> Bool
f) times :: EventPredicate -> EventPredicate -> EventPredicate
`times` (EventPredicate g :: Event -> Bool
g) = (Event -> Bool) -> EventPredicate
EventPredicate (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)
  {-# INLINE one #-}
  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'.
{-# INLINE conj #-}
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'.
{-# INLINE disj #-}
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).
{-# INLINE everything #-}
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).
{-# INLINE nothing #-}
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.
{-# INLINE isDirectory #-}
isDirectory :: EventPredicate
isDirectory :: EventPredicate
isDirectory = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ \e :: Event
e -> case Event -> Maybe FSEntryType
eventFSEntry Event
e of
  Nothing -> Bool
False
  Just Dir -> Bool
True
  Just NotDir -> Bool
False

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

-- | Allows through only creation events.
{-# INLINE isCreation #-}
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
  _ -> Bool
False

-- | Allows through only modification events.
{-# INLINE isModification #-}
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
  _ -> Bool
False

-- | Allows through only deletion events.
{-# INLINE isDeletion #-}
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
  _ -> Bool
False

-- | Allows through only \'basic\' events (namely creation, modification and
-- deletion).
{-# INLINE isBasic #-}
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
  _ -> Bool
True

-- | \'Flips\' the predicate - what it used to allow through is now blocked, and
-- vice versa.
{-# INLINE invert #-}
invert :: EventPredicate -> EventPredicate
invert :: EventPredicate -> EventPredicate
invert (EventPredicate f :: Event -> Bool
f) = (Event -> Bool) -> EventPredicate
EventPredicate (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).
{-# INLINE watchDirectory #-}
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.
{-# INLINE watchDirectoryWith #-}
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).
{-# INLINE watchTree #-}
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.
{-# INLINE watchTreeWith #-}
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

-- Helpers
{-# INLINE watch #-}
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 f :: WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f conf :: WatchConfig
conf p :: FsPath
p predicate :: 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 (IO (Path Absolute) -> m (Path Absolute))
-> (FsPath -> IO (Path Absolute)) -> FsPath -> m (Path Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> IO (Path Absolute)
makeAbsolute (FsPath -> m (Path Absolute)) -> FsPath -> m (Path Absolute)
forall a b. (a -> b) -> a -> b
$ 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)
-> (EventChannel -> IO StopListening)
-> EventChannel
-> m StopListening
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening
f WatchManager
manager String
fp ActionPredicate
pred' (EventChannel -> m StopListening)
-> EventChannel -> m StopListening
forall a b. (a -> b) -> a -> b
$ 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 (IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event)
-> (EventChannel -> IO Event) -> EventChannel -> 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 -> IO Event)
-> (EventChannel -> IO Event) -> EventChannel -> IO Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventChannel -> IO Event
forall a. Chan a -> IO a
readChan (EventChannel -> m Event) -> EventChannel -> m Event
forall a b. (a -> b) -> a -> b
$ EventChannel
chan))

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

{-# INLINE isDir #-}
isDir :: Bool -> FSEntryType
isDir :: Bool -> FSEntryType
isDir = FSEntryType -> FSEntryType -> Bool -> FSEntryType
forall a. a -> a -> Bool -> a
bool FSEntryType
NotDir FSEntryType
Dir