{-# LANGUAGE ForeignFunctionInterface #-}
-- | This module wraps Linux's inotify interface for directory change
--   notification. This Haddock doesn't provide full documentation about the
--   semantics of this system. For that you should read the manual pages for
--   inotify which can be found at <http://linux.die.net/man/7/inotify>
module System.Inotify
  ( ChangeEvent(..)
  , Option(..)
  , Alert(..)
  , Event(..)
  , Inotify
  , Watch
  , inotify
  , addWatch
  , next
  , allChangeEvents
  ) where

import Control.Concurrent (threadWaitRead)
import Control.Concurrent.MVar
import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as B
import Data.IORef
import Data.Word (Word32)
import System.Posix.Types (Fd(..))
import Foreign.C.Error
import Foreign.C.Types
import Foreign.C.String (withCString)
import Foreign.Ptr
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Storable

#include <sys/inotify.h>

-- | These are the events which can be observed
data ChangeEvent = Accessed
                 | Modified
                 | AttributeModified
                 | WritableClosed  -- ^ writable file was closed
                 | Closed  -- ^ non writable file was closed
                 | Opened
                 | MovedFrom
                 | MovedTo
                 | SelfMoved  -- ^ the watched directory/file was moved
                 | Created
                 | Deleted  -- ^ subfile was deleted
                 | SelfDeleted  -- ^ the watch directory/file was deleted
                 deriving (Show, Eq, Enum)

-- | When registering a watch, you can also give a number of options
data Option = DontFollow  -- ^ don't dereference target if it's a symbolic link
            | MaskAdd  -- ^ Add events to a watch if that given path is already being watched
            | Oneshot  -- ^ Monitor for one event only
            | OnlyDir  -- ^ Only watch if the target is a directory
            deriving (Show, Eq, Enum)

-- | The kernel can also report one of these alerts
data Alert = Ignored  -- ^ watch was implicitly removed
           | QueueOverflowed
           | Unmounted
           deriving (Show, Eq, Enum)

-- | A list containing all change events
allChangeEvents :: [ChangeEvent]
allChangeEvents = enumFromTo Accessed SelfDeleted

-- | Convert a 'ChangeEvent' to the kernel's ABI value for that event
eventValue :: ChangeEvent -> Word32
eventValue Accessed = (#const IN_ACCESS)
eventValue Modified = (#const IN_MODIFY)
eventValue AttributeModified = (#const IN_ATTRIB)
eventValue WritableClosed = (#const IN_CLOSE_WRITE)
eventValue Closed = (#const IN_CLOSE_NOWRITE)
eventValue Opened = (#const IN_OPEN)
eventValue MovedFrom = (#const IN_MOVED_FROM)
eventValue MovedTo = (#const IN_MOVED_TO)
eventValue SelfMoved = (#const IN_MOVE_SELF)
eventValue Created = (#const IN_CREATE)
eventValue Deleted = (#const IN_DELETE)
eventValue SelfDeleted = (#const IN_DELETE_SELF)

optionValue :: Option -> Word32
optionValue DontFollow = (#const IN_DONT_FOLLOW)
optionValue MaskAdd = (#const IN_MASK_ADD)
optionValue Oneshot = (#const IN_ONESHOT)
optionValue OnlyDir = (#const IN_ONLYDIR)

alertValue :: Alert -> Word32
alertValue Ignored = (#const IN_IGNORED)
alertValue QueueOverflowed = (#const IN_Q_OVERFLOW)
alertValue Unmounted = (#const IN_UNMOUNT)

-- | Convert a list of 'ChangeEvent's to a mask for those events
eventsToMask :: [ChangeEvent] -> Word32
eventsToMask = foldl (.|.) 0 . map eventValue

-- | Convert a list of 'ChangeEvent's to a mask for those events
optionsToMask :: [Option] -> Word32
optionsToMask = foldl (.|.) 0 . map optionValue

-- | Convert a mask into events and alerts
decodeMask :: Word32 -> ([ChangeEvent], [Alert])
decodeMask mask = (events, alerts) where
  events = filter (\ev -> mask .&. eventValue ev /= 0) $ enumFromTo Accessed SelfDeleted
  alerts = filter (\al -> mask .&. alertValue al /= 0) $ enumFromTo Ignored Unmounted

foreign import ccall unsafe "inotify_init"
  _init :: IO CInt
foreign import ccall unsafe "inotify_add_watch"
  _add_watch :: CInt -> Ptr CChar -> Word32 -> IO CInt
foreign import ccall unsafe "inotify_rm_watch"
  _rm_watch :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "close"
  _close :: CInt -> IO ()
foreign import ccall unsafe "read"
  _read :: CInt -> Ptr CChar -> CSize -> IO CInt

newtype Watch = Watch CInt deriving (Show, Eq)
data Inotify = Inotify (IORef [Event]) (MVar CInt)

-- | Create a new Inotify object. Each inotify object has its own stream of
--   events which can be read and it's own Watch namespace (so n.b. that
--   'Watch' objects from different Inotify's can compare equal).
inotify :: IO Inotify
inotify = do
  fd <- _init
  mv <- newMVar fd
  addMVarFinalizer mv (_close fd)
  buffer <- newIORef []
  return $ Inotify buffer mv

-- | Add a watch on a file or directory
addWatch :: Inotify -> FilePath -> [ChangeEvent] -> [Option] -> IO Watch
addWatch (Inotify _ mv) path events options = do
  fd <- readMVar mv
  withCString path $ \ptr -> do
    watch <- _add_watch fd ptr (optionsToMask options .|. eventsToMask events)
    return $ Watch watch

-- | These are the events which the kernel reports back to us.
data Event = Event { evwatch :: Watch
                   , evevents :: [ChangeEvent]
                   , evalerts :: [Alert]
                   , evcookie :: Word32
                   , evname :: B.ByteString
                   } deriving (Show)

-- | Extract an Event from a buffer
eventFromBuffer :: Ptr CChar -> IO Event
eventFromBuffer ptr = do
  namelen <- ((#peek struct inotify_event, len) ptr) :: IO Word32
  name <- if namelen > 0
             then B.packCString (ptr `plusPtr` (#offset struct inotify_event, name))
             else return B.empty
  watchno <- (#peek struct inotify_event, wd) ptr
  mask <- (#peek struct inotify_event, mask) ptr
  cookie <- (#peek struct inotify_event, cookie) ptr

  let (events, alerts) = decodeMask mask

  return $ Event (Watch watchno) events alerts cookie name

-- | Return the length of the event object, pointed to by the given pointer
eventLength :: Ptr CChar -> IO Int
eventLength ptr = do
  namelen <- ((#peek struct inotify_event, len) ptr) :: IO Word32

  return $ (#size struct inotify_event) + fromIntegral namelen

unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM f b = do
  r <- f b
  case r of
       Just (a, new_b) -> do
         next <- unfoldrM f new_b
         return $ a : next
       Nothing -> return []

unfoldEvents :: Int -> (Int, Ptr CChar) -> IO (Maybe (Event, (Int, Ptr CChar)))
unfoldEvents length (done, ptr)
  | done == length = return Nothing
  | otherwise = do
      event <- eventFromBuffer ptr
      len <- eventLength ptr
      return $ Just (event, (done + len, ptr `plusPtr` len))

-- | Read the next event from an 'Inotify'
next :: Inotify -> IO Event
next i@(Inotify buffer mv) = do
  previousEvents <- readIORef buffer
  case previousEvents of
       x:xs -> do
         writeIORef buffer xs
         return x
       [] -> do
         fd <- readMVar mv
         threadWaitRead $ Fd fd
         let bufsize = (#size struct inotify_event) + 1024
         allocaBytes bufsize $ \ptr -> do
           n <- _read fd ptr $ fromIntegral bufsize
           case n of
                (-1) -> do
                  errno <- getErrno
                  if errno == eINTR
                     then next i
                     else throwErrno "Inotify next"
                0 -> next i
                _ -> do
                  events <- unfoldrM (unfoldEvents $ fromIntegral n) (0, ptr)
                  case events of
                       [] -> next i
                       [x] -> return x
                       x:xs -> writeIORef buffer xs >> return x