module Streamly.FSNotify (
FSEntryType(..), Event(..), StopWatching(stopWatching),
eventPath, eventTime, eventFSEntry,
EventPredicate(..),
everything, nothing, 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.FilePath (isExtensionOf)
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 FilePath UTCTime FSEntryType
| Modified FilePath UTCTime FSEntryType
| Removed FilePath UTCTime FSEntryType
| Other FilePath 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)
newtype StopWatching m = StopWatching { StopWatching m -> m ()
stopWatching :: m () }
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
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
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry :: Event -> Maybe FSEntryType
eventFSEntry = \case
Added String
_ UTCTime
_ FSEntryType
e -> FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
Modified String
_ UTCTime
_ FSEntryType
e -> FSEntryType -> Maybe FSEntryType
forall a. a -> Maybe a
Just FSEntryType
e
Removed String
_ 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)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool -> Event -> Bool
forall a b. a -> b -> a
const Bool
True
nothing :: EventPredicate
nothing :: EventPredicate
nothing = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ Bool -> Event -> Bool
forall a b. a -> b -> a
const 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 :: FilePath -> EventPredicate
hasExtension :: String -> EventPredicate
hasExtension String
fe = (Event -> Bool) -> EventPredicate
EventPredicate ((Event -> Bool) -> EventPredicate)
-> (Event -> Bool) -> EventPredicate
forall a b. (a -> b) -> a -> b
$ (String
fe String -> String -> Bool
`isExtensionOf`) (String -> Bool) -> (Event -> String) -> Event -> Bool
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
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) => FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory :: String -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectory = (WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> EventPredicate
-> m (StopWatching m, t m Event)
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
watchDirectoryWith :: (IsStream t, MonadAsync m) =>
FSN.WatchConfig -> FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith :: WatchConfig
-> String -> EventPredicate -> m (StopWatching m, t m Event)
watchDirectoryWith = (WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> EventPredicate
-> m (StopWatching m, t m Event)
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
watchTree :: (IsStream t, MonadAsync m) => FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchTree :: String -> EventPredicate -> m (StopWatching m, t m Event)
watchTree = (WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> EventPredicate
-> m (StopWatching m, t m Event)
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
watchTreeWith :: (IsStream t, MonadAsync m) => FSN.WatchConfig -> FilePath -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith :: WatchConfig
-> String -> EventPredicate -> m (StopWatching m, t m Event)
watchTreeWith = (WatchManager
-> String -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchConfig
-> String
-> EventPredicate
-> m (StopWatching m, t m Event)
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
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 :: (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 <- IO WatchManager -> m WatchManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WatchManager -> m WatchManager)
-> IO WatchManager -> m WatchManager
forall a b. (a -> b) -> a -> b
$ WatchConfig -> IO WatchManager
FSN.startManagerConf WatchConfig
conf
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
p ActionPredicate
pred' EventChannel
chan
let reallyStop :: StopWatching m
reallyStop = m () -> StopWatching m
forall (m :: * -> *). m () -> StopWatching m
StopWatching (m () -> StopWatching m) -> m () -> StopWatching m
forall a b. (a -> b) -> a -> b
$ StopListening -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO StopListening
stop m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StopListening -> 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) -> m Event -> t m Event
forall a b. (a -> b) -> a -> b
$ IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ Event -> Event
mungeEvent (Event -> Event) -> IO Event -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 -> 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 = FSEntryType -> FSEntryType -> Bool -> FSEntryType
forall a. a -> a -> Bool -> a
bool FSEntryType
NotDir FSEntryType
Dir