{-|
Module: Reflex.FSNotify
Description: Watch for filesystem changes in reflex
-}

{-# LANGUAGE FlexibleContexts #-}
module Reflex.FSNotify
  ( watchDirectory
  , watchDir
  , watchDirs
  , watchTree
  , wrapWatch
  , listDirectories
  , watchDirectoryTree
  , FSEvent
  ) where

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Reflex
import qualified System.FSNotify as FS

import Data.Set (Set)
import qualified Data.Set as Set
import System.Directory
import System.FilePath ((</>))

-- A type synonym to disambiguate Reflex 'Event's from 'System.FSNotify.Event'
type FSEvent = FS.Event

-- | Watch a directory for changes
{-# DEPRECATED watchDirectory "Use `watchDir cfg path (const True)` instead" #-}
watchDirectory
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => FS.WatchConfig
  -> Event t FilePath
  -> m (Event t FS.Event)
watchDirectory :: WatchConfig -> Event t FilePath -> m (Event t Event)
watchDirectory WatchConfig
cfg Event t FilePath
path = WatchConfig
-> Event t FilePath -> ActionPredicate -> m (Event t Event)
forall t (m :: * -> *).
(Reflex t, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
WatchConfig
-> Event t FilePath -> ActionPredicate -> m (Event t Event)
watchDir WatchConfig
cfg Event t FilePath
path (Bool -> ActionPredicate
forall a b. a -> b -> a
const Bool
True)

wrapWatch
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => (FS.WatchManager -> pathinfo -> FS.Action -> IO a)
  -> FS.WatchConfig
  -> Event t pathinfo
  -> m (Event t FSEvent)
wrapWatch :: (WatchManager -> pathinfo -> Action -> IO a)
-> WatchConfig -> Event t pathinfo -> m (Event t Event)
wrapWatch WatchManager -> pathinfo -> Action -> IO a
f WatchConfig
cfg Event t pathinfo
path =
  Event t (Action -> Performable m ()) -> m (Event t Event)
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event t (Action -> Performable m ()) -> m (Event t Event))
-> Event t (Action -> Performable m ()) -> m (Event t Event)
forall a b. (a -> b) -> a -> b
$ Event t pathinfo
-> (pathinfo -> Action -> Performable m ())
-> Event t (Action -> Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t pathinfo
path ((pathinfo -> Action -> Performable m ())
 -> Event t (Action -> Performable m ()))
-> (pathinfo -> Action -> Performable m ())
-> Event t (Action -> Performable m ())
forall a b. (a -> b) -> a -> b
$ \pathinfo
p Action
cb -> IO () -> Performable m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Performable m ()) -> IO () -> Performable m ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
    WatchConfig -> (WatchManager -> IO ()) -> IO ()
forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
FS.withManagerConf WatchConfig
cfg ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> do
      a
_ <- WatchManager -> pathinfo -> Action -> IO a
f WatchManager
mgr pathinfo
p Action
cb
      IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000

watchDir
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => FS.WatchConfig
  -> Event t FilePath
  -> FS.ActionPredicate
  -> m (Event t FSEvent)
watchDir :: WatchConfig
-> Event t FilePath -> ActionPredicate -> m (Event t Event)
watchDir WatchConfig
cfg Event t FilePath
path ActionPredicate
evFilter = (WatchManager -> FilePath -> Action -> IO (IO ()))
-> WatchConfig -> Event t FilePath -> m (Event t Event)
forall t (m :: * -> *) pathinfo a.
(Reflex t, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(WatchManager -> pathinfo -> Action -> IO a)
-> WatchConfig -> Event t pathinfo -> m (Event t Event)
wrapWatch (\WatchManager
mgr FilePath
p -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
FS.watchDir WatchManager
mgr FilePath
p ActionPredicate
evFilter) WatchConfig
cfg Event t FilePath
path

watchDirs
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => FS.WatchConfig
  -> Event t [FilePath]
  -> FS.ActionPredicate
  -> m (Event t FSEvent)
watchDirs :: WatchConfig
-> Event t [FilePath] -> ActionPredicate -> m (Event t Event)
watchDirs WatchConfig
cfg Event t [FilePath]
path ActionPredicate
evFilter = (WatchManager -> [FilePath] -> Action -> IO ())
-> WatchConfig -> Event t [FilePath] -> m (Event t Event)
forall t (m :: * -> *) pathinfo a.
(Reflex t, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(WatchManager -> pathinfo -> Action -> IO a)
-> WatchConfig -> Event t pathinfo -> m (Event t Event)
wrapWatch (\WatchManager
mgr [FilePath]
ps Action
cb -> [FilePath] -> (FilePath -> IO (IO ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
ps ((FilePath -> IO (IO ())) -> IO ())
-> (FilePath -> IO (IO ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
p ->
  WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
FS.watchDir WatchManager
mgr FilePath
p ActionPredicate
evFilter Action
cb) WatchConfig
cfg Event t [FilePath]
path

watchTree
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => FS.WatchConfig
  -> Event t FilePath
  -> FS.ActionPredicate
  -> m (Event t FSEvent)
watchTree :: WatchConfig
-> Event t FilePath -> ActionPredicate -> m (Event t Event)
watchTree WatchConfig
cfg Event t FilePath
path ActionPredicate
evFilter = (WatchManager -> FilePath -> Action -> IO (IO ()))
-> WatchConfig -> Event t FilePath -> m (Event t Event)
forall t (m :: * -> *) pathinfo a.
(Reflex t, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(WatchManager -> pathinfo -> Action -> IO a)
-> WatchConfig -> Event t pathinfo -> m (Event t Event)
wrapWatch (\WatchManager
mgr FilePath
p -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
FS.watchTree WatchManager
mgr FilePath
p ActionPredicate
evFilter) WatchConfig
cfg Event t FilePath
path

listDirectories
  :: FilePath
  -> IO (Set FilePath)
listDirectories :: FilePath -> IO (Set FilePath)
listDirectories FilePath
start = do
  FilePath
start' <- FilePath -> IO FilePath
canonicalizePath FilePath
start
  FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => a -> Set a -> Set a
Set.insert FilePath
start' (Set FilePath -> Set FilePath)
-> IO (Set FilePath) -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set FilePath -> FilePath -> IO (Set FilePath)
listDirectories' Set FilePath
forall a. Set a
Set.empty FilePath
start'
  where
    listDirectories' :: Set FilePath -> FilePath -> IO (Set FilePath)
    listDirectories' :: Set FilePath -> FilePath -> IO (Set FilePath)
listDirectories' Set FilePath
seen FilePath
dir0 = do
      let canonicalize :: FilePath -> IO FilePath
canonicalize FilePath
p = FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir0 FilePath -> FilePath -> FilePath
</> FilePath
p
      [FilePath]
contents <- (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
canonicalize ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
dir0
      [FilePath]
dirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
contents
      let newDirs :: [FilePath]
newDirs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Set FilePath -> Bool)
-> Set FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Set FilePath
seen) [FilePath]
dirs
          newSeen :: Set FilePath
newSeen = Set FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set FilePath
seen (Set FilePath -> Set FilePath) -> Set FilePath -> Set FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
newDirs
      [Set FilePath]
allDirs <- (FilePath -> IO (Set FilePath)) -> [FilePath] -> IO [Set FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Set FilePath -> FilePath -> IO (Set FilePath)
listDirectories' Set FilePath
newSeen) [FilePath]
newDirs
      Set FilePath -> IO (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ [Set FilePath] -> Set FilePath
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set FilePath] -> Set FilePath) -> [Set FilePath] -> Set FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
dirs Set FilePath -> [Set FilePath] -> [Set FilePath]
forall a. a -> [a] -> [a]
: [Set FilePath]
allDirs

-- | Like 'watchTree' except that it tries to avoid symlink loops and calls
-- 'watchDir' on each directory found
watchDirectoryTree
  :: (Reflex t, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
  => FS.WatchConfig
  -> Event t FilePath
  -> FS.ActionPredicate
  -> m (Event t FSEvent)
watchDirectoryTree :: WatchConfig
-> Event t FilePath -> ActionPredicate -> m (Event t Event)
watchDirectoryTree WatchConfig
cfg Event t FilePath
root ActionPredicate
evFilter =
  let f :: WatchManager -> FilePath -> Action -> IO ()
f WatchManager
mgr FilePath
p Action
cb = do
        Set FilePath
dirs <- FilePath -> IO (Set FilePath)
listDirectories FilePath
p
        (FilePath -> IO (IO ())) -> Set FilePath -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
dir -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
FS.watchDir WatchManager
mgr FilePath
dir ActionPredicate
evFilter Action
cb) Set FilePath
dirs
  in (WatchManager -> FilePath -> Action -> IO ())
-> WatchConfig -> Event t FilePath -> m (Event t Event)
forall t (m :: * -> *) pathinfo a.
(Reflex t, TriggerEvent t m, PerformEvent t m,
 MonadIO (Performable m)) =>
(WatchManager -> pathinfo -> Action -> IO a)
-> WatchConfig -> Event t pathinfo -> m (Event t Event)
wrapWatch WatchManager -> FilePath -> Action -> IO ()
f WatchConfig
cfg Event t FilePath
root