{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}

{- |
Helpers for watching files for changes and taking action in the event of a
change.
-}
module Core.Program.Notify (
  -- * Notify
  waitForChange,
) where

import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
import Control.Monad.IO.Class (liftIO)
import Core.Data.Structures
import Core.Program.Execute
import Core.Program.Logging
import Core.Program.Unlift
import Data.Foldable (foldrM)
import System.Directory (canonicalizePath)
import System.FSNotify (Event (..), eventPath, watchDir, withManager)
import System.FilePath (dropFileName)

{- |
Watch for changes to a given list of files.

Before continuing we insert a 100ms pause to allow whatever the editor was to
finish its write and switcheroo sequence.
-}

--
-- Ideally we'd just set up inotifies on these individual files, but that
-- doesn't work when programs like vim move the original file, save a new one,
-- then delete the renamed original.
--
-- From previous work we know that @CLOSE_WRITE@ is emitted reliably by inotify
-- on Linux through these sequences. We need to continue testing to assure
-- ourselves that the __fsnotify__ package's @Modify@ represents this
-- accurately.
--
waitForChange :: [FilePath] -> Program τ ()
waitForChange :: [FilePath] -> Program τ ()
waitForChange [FilePath]
files =
  let f :: FilePath -> Set FilePath -> Set FilePath
      f :: FilePath -> Set FilePath -> Set FilePath
f FilePath
path Set FilePath
acc = FilePath -> Set FilePath -> Set FilePath
forall ε. Key ε => ε -> Set ε -> Set ε
insertElement FilePath
path Set FilePath
acc

      g :: FilePath -> Set FilePath -> Set FilePath
      g :: FilePath -> Set FilePath -> Set FilePath
g FilePath
path Set FilePath
acc = FilePath -> Set FilePath -> Set FilePath
forall ε. Key ε => ε -> Set ε -> Set ε
insertElement (FilePath -> FilePath
dropFileName FilePath
path) Set FilePath
acc
   in do
        Rope -> Program τ ()
forall τ. Rope -> Program τ ()
info Rope
"Watching for changes"

        [FilePath]
canonical <- (FilePath -> Program τ FilePath)
-> [FilePath] -> Program τ [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO FilePath -> Program τ FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Program τ FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> Program τ FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath) [FilePath]
files
        let paths :: Set FilePath
paths = (FilePath -> Set FilePath -> Set FilePath)
-> Set FilePath -> [FilePath] -> Set FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> Set FilePath -> Set FilePath
f Set FilePath
forall ε. Key ε => Set ε
emptySet [FilePath]
canonical
        let dirs :: Set FilePath
dirs = (FilePath -> Set FilePath -> Set FilePath)
-> Set FilePath -> [FilePath] -> Set FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> Set FilePath -> Set FilePath
g Set FilePath
forall ε. Key ε => Set ε
emptySet [FilePath]
files

        ((forall β. Program τ β -> IO β) -> IO ()) -> Program τ ()
forall τ α.
((forall β. Program τ β -> IO β) -> IO α) -> Program τ α
withContext (((forall β. Program τ β -> IO β) -> IO ()) -> Program τ ())
-> ((forall β. Program τ β -> IO β) -> IO ()) -> Program τ ()
forall a b. (a -> b) -> a -> b
$ \forall β. Program τ β -> IO β
runProgram -> do
          MVar Bool
block <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
          (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
manager -> do
            -- setup watches
            [IO ()]
stoppers <-
              (FilePath -> [IO ()] -> IO [IO ()])
-> [IO ()] -> Set FilePath -> IO [IO ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
                ( \FilePath
dir [IO ()]
acc -> do
                    Program τ () -> IO ()
forall β. Program τ β -> IO β
runProgram (Rope -> FilePath -> Program τ ()
forall α τ. Show α => Rope -> α -> Program τ ()
debugS Rope
"watching" FilePath
dir)
                    IO ()
stopper <-
                      WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchDir
                        WatchManager
manager
                        FilePath
dir
                        ( \Event
trigger -> case Event
trigger of
                            Modified FilePath
file UTCTime
_ Bool
_ -> do
                              if FilePath -> Set FilePath -> Bool
forall ε. Key ε => ε -> Set ε -> Bool
containsElement FilePath
file Set FilePath
paths
                                then Bool
True
                                else Bool
False
                            Event
_ -> Bool
False
                        )
                        ( \Event
trigger -> do
                            Program τ () -> IO ()
forall β. Program τ β -> IO β
runProgram (Rope -> FilePath -> Program τ ()
forall α τ. Show α => Rope -> α -> Program τ ()
debugS Rope
"trigger" (Event -> FilePath
eventPath Event
trigger))
                            MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
block Bool
False
                        )
                    [IO ()] -> IO [IO ()]
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ()
stopper IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
: [IO ()]
acc)
                )
                []
                Set FilePath
dirs

            -- wait
            Bool
_ <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
readMVar MVar Bool
block

            [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
stoppers
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        Rational -> Program τ ()
forall τ. Rational -> Program τ ()
sleepThread Rational
0.1