Notify.hs

{-# 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 qualified Data.ByteString.Char8 as C (ByteString, pack)
import Data.Foldable (foldr, foldrM)
import System.FilePath.Posix (dropFileName)
import System.INotify (EventVariety(..), Event(..), withINotify
    , addWatch, removeWatch)

import Core.Data.Structures
import Core.Program.Execute
import Core.Program.Logging
import Core.Program.Unlift

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

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 through these sequences, so we can just
check to see if a that happens on a filename we care about (rather then the
original inodes those files were stored in).

Before continuing we insert a 100ms pause to allow whatever the editor was
to finish its write and switcheroo sequence.
-}
waitForChange :: [FilePath] -> Program τ ()
waitForChange files =
  let
    f :: FilePath -> Set C.ByteString -> Set C.ByteString
    f path acc = insertElement (C.pack path) acc

    g :: FilePath -> Set C.ByteString -> Set C.ByteString
    g path acc = insertElement (C.pack (dropFileName path)) acc
  in do
    event "Watching for changes"

    let paths = foldr f emptySet files
    let dirs  = foldr g emptySet files

    withContext $ \runProgram -> do
        block <- newEmptyMVar
        withINotify $ \notify -> do
            -- setup inotifies
            watches <- foldrM (\dir acc -> do
                runProgram (debugS "watching" dir)
                watch <- addWatch notify [CloseWrite] dir (\trigger ->
                    case trigger of
                        Closed _ (Just file) _  -> do
                            let path = if dir == "./"
                                        then file
                                        else dir <> file
                            runProgram (debugS "changed" path)
                            if containsElement path paths
                                then do
                                    runProgram (debugS "trigger" path)
                                    putMVar block False
                                else
                                    return ()
                        _ -> return ())
                return (watch:acc)) [] dirs

            -- wait
            _ <- readMVar block

            -- cleanup
            mapM_ removeWatch watches

    sleep 0.1