{-|
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, state)
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))