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.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
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)
data Event
= Added FilePath UTCTime FSEntryType
| Modified FilePath UTCTime FSEntryType
| Removed FilePath UTCTime FSEntryType
| Other FilePath UTCTime Text
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)
newtype StopWatching m = StopWatching { forall (m :: * -> *). 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 -> 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
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 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
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj :: EventPredicate -> EventPredicate -> EventPredicate
conj = forall a. Semiring a => a -> a -> a
times
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj :: EventPredicate -> EventPredicate -> EventPredicate
disj = forall a. Semiring a => a -> a -> a
plus
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
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
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
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
isCreation :: EventPredicate
isCreation :: EventPredicate
isCreation = (Event -> Bool) -> EventPredicate
EventPredicate forall a b. (a -> b) -> a -> b
$ \case
Added{} -> Bool
True
Event
_ -> Bool
False
isModification :: EventPredicate
isModification :: EventPredicate
isModification = (Event -> Bool) -> EventPredicate
EventPredicate forall a b. (a -> b) -> a -> b
$ \case
Modified{} -> Bool
True
Event
_ -> Bool
False
isDeletion :: EventPredicate
isDeletion :: EventPredicate
isDeletion = (Event -> Bool) -> EventPredicate
EventPredicate forall a b. (a -> b) -> a -> b
$ \case
Removed{} -> Bool
True
Event
_ -> Bool
False
isBasic :: EventPredicate
isBasic :: EventPredicate
isBasic = (Event -> Bool) -> EventPredicate
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 forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not 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 :: 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
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
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
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
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 EventIsDirectory
b -> String -> UTCTime -> FSEntryType -> Event
Added String
p UTCTime
t (EventIsDirectory -> FSEntryType
isDir EventIsDirectory
b)
FSN.Modified String
p UTCTime
t EventIsDirectory
b -> String -> UTCTime -> FSEntryType -> Event
Modified String
p UTCTime
t (EventIsDirectory -> FSEntryType
isDir EventIsDirectory
b)
FSN.Removed String
p UTCTime
t EventIsDirectory
b -> String -> UTCTime -> FSEntryType -> Event
Modified String
p UTCTime
t (EventIsDirectory -> FSEntryType
isDir EventIsDirectory
b)
FSN.Unknown String
p UTCTime
t EventIsDirectory
b String
s -> String -> UTCTime -> Text -> Event
Other String
p UTCTime
t (String -> Text
pack String
s)
Event
e -> String -> UTCTime -> Text -> Event
Other (Event -> String
FSN.eventPath Event
e) (Event -> UTCTime
FSN.eventTime Event
e) (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Event
e)
isDir :: FSN.EventIsDirectory -> FSEntryType
isDir :: EventIsDirectory -> FSEntryType
isDir = \case
EventIsDirectory
FSN.IsFile -> FSEntryType
NotDir
EventIsDirectory
FSN.IsDirectory -> FSEntryType
Dir