{-|
Module : Notify
Description : Filesystem notifications. This is a wrapper around rust's notify crate.
-}
module Notify
( Config(..)
, State
, watch
, force
, end
) where
import Control.Concurrent
import Control.Monad (when)
import Data.Foldable (null, traverse_)
import Data.Int
import qualified Data.Text as T
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr ()
import Foreign.Ptr
import Protolude hiding (State, force)
import System.FilePath
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types (ProcessID)
import System.Process ()
foreign import ccall "watch_for_changes" watchForChanges ::
CString ->
CInt ->
FunPtr (CString -> IO ()) -> FunPtr (CString -> IO ()) -> IO ()
foreign import ccall "wrapper" mkCallback ::
(CString -> IO ()) -> IO (FunPtr (CString -> IO ()))
{-| Internal state of the watcher.
We keep track of running processes and the config.
You might need this if you want to use `end` or `force`.
-}
data State = State
{ onChange :: IO ()
, mVar :: MVar (Maybe ProcessID)
}
{-| Configuration for a watcher.
-}
data Config = Config
{ pathToWatch :: FilePath -- Watch files recursivelly under this path.
, relevantExtensions :: [T.Text] -- Which extensions do we care about? Empty list will accept all.
, debounceInSecs :: Int -- Debounce next run by x seconds.
}
watch :: Config -> IO () -> (T.Text -> IO ()) -> IO State
watch config onChange onError = do
mVar <- newMVar Nothing
let state = State {onChange = onChange, mVar = mVar}
_ <- forkIO (start mVar config onChange onError)
pure state
force :: State -> IO ()
force State {mVar, onChange} = startProcess mVar onChange
end :: State -> IO ()
end State {mVar} = stopProcess mVar
start :: MVar (Maybe ProcessID) -> Config -> IO () -> (T.Text -> IO ()) -> IO ()
start mVar Config {pathToWatch, debounceInSecs, relevantExtensions} onChange onError = do
onChangeCb <- mkCallback $ callbackInProcess mVar onChange relevantExtensions
onErrorCb <- mkCallback $ onErrorCallback onError
pathCStr <- newCString pathToWatch
watchForChanges pathCStr (mkCInt debounceInSecs) onChangeCb onErrorCb
mkCInt :: Int -> CInt
mkCInt = fromIntegral
onErrorCallback :: (T.Text -> IO ()) -> CString -> IO ()
onErrorCallback cb msgC = do
msg <- peekCString msgC
cb (T.pack msg)
callbackInProcess ::
MVar (Maybe ProcessID) -> IO () -> [T.Text] -> CString -> IO ()
callbackInProcess mVar cb relevantExtensions pathC = do
eventForPath <- peekCString pathC
when (isRelevant eventForPath relevantExtensions || null relevantExtensions) $
startProcess mVar cb
startProcess :: MVar (Maybe ProcessID) -> IO () -> IO ()
startProcess mVar cb = do
stopProcess mVar
processId <- forkProcess cb
putMVar mVar (Just processId)
stopProcess :: MVar (Maybe ProcessID) -> IO ()
stopProcess mVar = do
runningProcess <- takeMVar mVar
traverse_ (signalProcess softwareTermination) runningProcess
traverse_ (getProcessStatus True False) runningProcess -- here be dragons, potentially
isRelevant :: FilePath -> [T.Text] -> Bool
isRelevant path = elem (T.pack (takeExtension path))