module Streamly.FSNotify (
FSEntryType(..), Event(..), StopWatching,
eventPath, eventTime, eventFSEntry,
EventPredicate(..),
isDirectory, hasExtension, isCreation, isModification, isDeletion, isBasic, invert, conj, disj,
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
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)
data Event
= Added (Path Absolute) UTCTime FSEntryType
| Modified (Path Absolute) UTCTime FSEntryType
| Removed (Path Absolute) UTCTime FSEntryType
| Other (Path Absolute) UTCTime Text
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)
type StopWatching m = m ()
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
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
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
newtype EventPredicate = EventPredicate { EventPredicate -> Event -> Bool
runPredicate :: Event -> Bool }
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
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj = EventPredicate -> EventPredicate -> EventPredicate
forall a. Semiring a => a -> a -> a
times
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj = EventPredicate -> EventPredicate -> EventPredicate
forall a. Semiring a => a -> a -> a
plus
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
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
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
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
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
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
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
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
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
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
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
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
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
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