module IHP.IDE.FileWatcher (withFileWatcher) where import IHP.Prelude import Control.Exception import Control.Concurrent (threadDelay) import Control.Concurrent.MVar import Control.Monad (filterM) import System.Directory (listDirectory, doesDirectoryExist) import qualified Data.Map as Map import qualified System.FSNotify as FS import IHP.IDE.Types import qualified Data.Time.Clock as Clock import qualified Data.List as List import IHP.IDE.LiveReloadNotificationServer (notifyAssetChange) withFileWatcher :: (?context :: Context) => IO () -> IO () withFileWatcher :: (?context::Context) => IO () -> IO () withFileWatcher IO () inner = IO Any -> (Async Any -> IO ()) -> IO () forall a b. IO a -> (Async a -> IO b) -> IO b withAsync IO Any forall {a}. IO a callback \Async Any _ -> IO () inner where callback :: IO a callback = WatchConfig -> (WatchManager -> IO a) -> IO a forall a. WatchConfig -> (WatchManager -> IO a) -> IO a FS.withManagerConf WatchConfig fileWatcherConfig \WatchManager manager -> do FileWatcherState state <- IO FileWatcherState newFileWatcherState (?context::Context) => WatchManager -> FileWatcherState -> IO (IO ()) WatchManager -> FileWatcherState -> IO (IO ()) watchRootDirectoryFiles WatchManager manager FileWatcherState state (?context::Context) => WatchManager -> FileWatcherState -> IO () WatchManager -> FileWatcherState -> IO () watchSubDirectories WatchManager manager FileWatcherState state IO () -> IO a forall (f :: * -> *) a b. Applicative f => f a -> f b forever (Int -> IO () threadDelay Int forall a. Bounded a => a maxBound) IO a -> IO () -> IO a forall a b. IO a -> IO b -> IO a `finally` WatchManager -> IO () FS.stopManager WatchManager manager watchRootDirectoryFiles :: WatchManager -> FileWatcherState -> IO (IO ()) watchRootDirectoryFiles WatchManager manager FileWatcherState state = WatchManager -> [Char] -> ActionPredicate -> Action -> IO (IO ()) FS.watchDir WatchManager manager [Char] "." ActionPredicate shouldActOnRootFileChange ((?context::Context) => WatchManager -> FileWatcherState -> Action WatchManager -> FileWatcherState -> Action handleRootFileChange WatchManager manager FileWatcherState state) watchSubDirectories :: WatchManager -> FileWatcherState -> IO () watchSubDirectories WatchManager manager FileWatcherState state = do [[Char]] directories <- IO [[Char]] listWatchableDirectories [[Char]] -> ([Char] -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [[Char]] directories \[Char] directory -> do (?context::Context) => WatchManager -> FileWatcherState -> [Char] -> IO () WatchManager -> FileWatcherState -> [Char] -> IO () startWatchingSubDirectory WatchManager manager FileWatcherState state [Char] directory type WatchedDirectories = Map FilePath FS.StopListening type FileWatcherState = MVar WatchedDirectories newFileWatcherState :: IO FileWatcherState newFileWatcherState :: IO FileWatcherState newFileWatcherState = WatchedDirectories -> IO FileWatcherState forall a. a -> IO (MVar a) newMVar WatchedDirectories forall a. Monoid a => a mempty startWatchingSubDirectory :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FilePath -> IO () startWatchingSubDirectory :: (?context::Context) => WatchManager -> FileWatcherState -> [Char] -> IO () startWatchingSubDirectory WatchManager manager FileWatcherState state [Char] path = do WatchedDirectories watchedDirectories <- FileWatcherState -> IO WatchedDirectories forall a. MVar a -> IO a readMVar FileWatcherState state case [Char] -> WatchedDirectories -> Maybe (IO ()) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup [Char] path WatchedDirectories watchedDirectories of Just IO () _ -> () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () Maybe (IO ()) Nothing -> do IO () stop <- WatchManager -> [Char] -> ActionPredicate -> Action -> IO (IO ()) FS.watchTree WatchManager manager [Char] path ActionPredicate shouldActOnFileChange (?context::Context) => Action Action handleFileChange FileWatcherState -> (WatchedDirectories -> IO WatchedDirectories) -> IO () forall a. MVar a -> (a -> IO a) -> IO () modifyMVar_ FileWatcherState state (\WatchedDirectories map -> WatchedDirectories -> IO WatchedDirectories forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([Char] -> IO () -> WatchedDirectories -> WatchedDirectories forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert [Char] path IO () stop WatchedDirectories map)) stopWatchingSubDirectory :: FileWatcherState -> FilePath -> IO () stopWatchingSubDirectory :: FileWatcherState -> [Char] -> IO () stopWatchingSubDirectory FileWatcherState state [Char] path = do WatchedDirectories watchedDirectories <- FileWatcherState -> IO WatchedDirectories forall a. MVar a -> IO a readMVar FileWatcherState state case [Char] -> WatchedDirectories -> Maybe (IO ()) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup [Char] path WatchedDirectories watchedDirectories of Just IO () stop -> do IO () stop FileWatcherState -> (WatchedDirectories -> IO WatchedDirectories) -> IO () forall a. MVar a -> (a -> IO a) -> IO () modifyMVar_ FileWatcherState state (\WatchedDirectories map -> WatchedDirectories -> IO WatchedDirectories forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([Char] -> WatchedDirectories -> WatchedDirectories forall k a. Ord k => k -> Map k a -> Map k a Map.delete [Char] path WatchedDirectories map)) Maybe (IO ()) Nothing -> () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () listWatchableDirectories :: IO [String] listWatchableDirectories :: IO [[Char]] listWatchableDirectories = do [[Char]] rootDirectoryContents <- [Char] -> IO [[Char]] listDirectory [Char] "." ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]] forall (m :: * -> *) a. Applicative m => (a -> m Bool) -> [a] -> m [a] filterM [Char] -> IO Bool shouldWatchDirectory [[Char]] rootDirectoryContents shouldWatchDirectory :: String -> IO Bool shouldWatchDirectory :: [Char] -> IO Bool shouldWatchDirectory [Char] path = do Bool isDirectory <- [Char] -> IO Bool doesDirectoryExist [Char] path Bool -> IO Bool forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Bool isDirectory Bool -> Bool -> Bool && [Char] -> Bool isDirectoryWatchable [Char] path isDirectoryWatchable :: String -> Bool isDirectoryWatchable :: [Char] -> Bool isDirectoryWatchable [Char] path = [Char] path [Char] -> [Char] -> Bool forall a. Eq a => a -> a -> Bool /= [Char] ".devenv" Bool -> Bool -> Bool && [Char] path [Char] -> [Char] -> Bool forall a. Eq a => a -> a -> Bool /= [Char] ".direnv" fileWatcherConfig :: FS.WatchConfig fileWatcherConfig :: WatchConfig fileWatcherConfig = WatchConfig FS.defaultConfig handleFileChange :: (?context :: Context) => FS.Event -> IO () handleFileChange :: (?context::Context) => Action handleFileChange Event event = do let filePath :: [Char] filePath = Event event.eventPath if [Char] -> Bool isHaskellFile [Char] filePath then (?context::Context) => Action -> IO () Action -> IO () dispatch Action HaskellFileChanged else if [Char] -> Bool isSchemaSQL [Char] filePath then (?context::Context) => Action -> IO () Action -> IO () dispatch Action SchemaChanged else if [Char] -> Bool isAssetFile [Char] filePath then IO () (?context::Context) => IO () notifyAssetChange else IO () forall a. Monoid a => a mempty handleRootFileChange :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FS.Event -> IO () handleRootFileChange :: (?context::Context) => WatchManager -> FileWatcherState -> Action handleRootFileChange WatchManager manager FileWatcherState state Event event = case Event event of FS.Added [Char] filePath UTCTime _ EventIsDirectory true -> if [Char] -> Bool isDirectoryWatchable [Char] filePath then do (?context::Context) => WatchManager -> FileWatcherState -> [Char] -> IO () WatchManager -> FileWatcherState -> [Char] -> IO () startWatchingSubDirectory WatchManager manager FileWatcherState state [Char] filePath else () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () FS.Removed [Char] filePath UTCTime _ EventIsDirectory true -> FileWatcherState -> [Char] -> IO () stopWatchingSubDirectory FileWatcherState state [Char] filePath Event _ -> (?context::Context) => Action Action handleFileChange Event event shouldActOnRootFileChange :: FS.ActionPredicate shouldActOnRootFileChange :: ActionPredicate shouldActOnRootFileChange Event event = if Event -> EventIsDirectory FS.eventIsDirectory Event event EventIsDirectory -> EventIsDirectory -> Bool forall a. Eq a => a -> a -> Bool == EventIsDirectory FS.IsDirectory then [Char] -> Bool isDirectoryWatchable Event event.eventPath else ActionPredicate shouldActOnFileChange Event event shouldActOnFileChange :: FS.ActionPredicate shouldActOnFileChange :: ActionPredicate shouldActOnFileChange Event event = let path :: [Char] path = Event event.eventPath in [Char] -> Bool isHaskellFile [Char] path Bool -> Bool -> Bool || [Char] -> Bool isAssetFile [Char] path Bool -> Bool -> Bool || [Char] -> Bool isSQLFile [Char] path isHaskellFile :: String -> Bool isHaskellFile :: [Char] -> Bool isHaskellFile = [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool List.isSuffixOf [Char] ".hs" isAssetFile :: String -> Bool isAssetFile :: [Char] -> Bool isAssetFile = [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool List.isSuffixOf [Char] ".css" isSQLFile :: String -> Bool isSQLFile :: [Char] -> Bool isSQLFile = [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool List.isSuffixOf [Char] ".sql" isSchemaSQL :: String -> Bool isSchemaSQL :: [Char] -> Bool isSchemaSQL = [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool List.isSuffixOf [Char] "Application/Schema.sql"