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"