{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Implementation of filesystem watching functionality for linux based on
--   inotify.
module Data.CAS.ContentStore.Notify.Linux
  ( Notifier,
    initNotifier,
    killNotifier,
    Watch,
    addDirWatch,
    removeDirWatch,
  )
where

import Control.Exception.Safe (catch)
#if MIN_VERSION_hinotify(0,3,10)
import qualified Data.ByteString.Char8 as BS
#endif
import System.INotify

type Notifier = INotify

initNotifier :: IO Notifier
initNotifier :: IO Notifier
initNotifier = IO Notifier
initINotify

killNotifier :: Notifier -> IO ()
killNotifier :: Notifier -> IO ()
killNotifier = Notifier -> IO ()
killINotify

type Watch = WatchDescriptor

addDirWatch :: Notifier -> FilePath -> IO () -> IO Watch
addDirWatch :: Notifier -> FilePath -> IO () -> IO Watch
addDirWatch Notifier
inotify FilePath
dir IO ()
f = Notifier
-> [EventVariety] -> RawFilePath -> (Event -> IO ()) -> IO Watch
addWatch Notifier
inotify [EventVariety]
mask RawFilePath
dir' ((Event -> IO ()) -> IO Watch) -> (Event -> IO ()) -> IO Watch
forall a b. (a -> b) -> a -> b
$ \case
  Attributes Bool
True Maybe RawFilePath
Nothing -> IO ()
f
  MovedSelf Bool
True -> IO ()
f
  Event
DeletedSelf -> IO ()
f
  Event
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    mask :: [EventVariety]
mask = [EventVariety
Attrib, EventVariety
MoveSelf, EventVariety
DeleteSelf, EventVariety
OnlyDir]

#if MIN_VERSION_hinotify(0,3,10)
    dir' :: RawFilePath
dir' = FilePath -> RawFilePath
BS.pack FilePath
dir
#else
    dir' = dir
#endif

removeDirWatch :: Watch -> IO ()
removeDirWatch :: Watch -> IO ()
removeDirWatch Watch
w =
  -- When calling `addWatch` on a path that is already being watched,
  -- inotify will not create a new watch, but amend the existing watch
  -- and return the same watch descriptor.
  -- Therefore, the watch might already have been removed at this point,
  -- which will cause an 'IOError'.
  -- Fortunately, all event handlers to a file are called at once.
  -- So, that removing the watch here will not cause another handler
  -- to miss out on the event.
  -- Note, that this may change when adding different event handlers,
  -- that remove the watch under different conditions.
  Watch -> IO ()
removeWatch Watch
w
    IO () -> (IOError -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(IOError
_ :: IOError) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()