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