{-# LINE 1 "System/Inotify.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Inotify.hsc" #-}
-- | 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


{-# LINE 34 "System/Inotify.hsc" #-}

-- | 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 = (1)
{-# LINE 70 "System/Inotify.hsc" #-}
eventValue Modified = (2)
{-# LINE 71 "System/Inotify.hsc" #-}
eventValue AttributeModified = (4)
{-# LINE 72 "System/Inotify.hsc" #-}
eventValue WritableClosed = (8)
{-# LINE 73 "System/Inotify.hsc" #-}
eventValue Closed = (16)
{-# LINE 74 "System/Inotify.hsc" #-}
eventValue Opened = (32)
{-# LINE 75 "System/Inotify.hsc" #-}
eventValue MovedFrom = (64)
{-# LINE 76 "System/Inotify.hsc" #-}
eventValue MovedTo = (128)
{-# LINE 77 "System/Inotify.hsc" #-}
eventValue SelfMoved = (2048)
{-# LINE 78 "System/Inotify.hsc" #-}
eventValue Created = (256)
{-# LINE 79 "System/Inotify.hsc" #-}
eventValue Deleted = (512)
{-# LINE 80 "System/Inotify.hsc" #-}
eventValue SelfDeleted = (1024)
{-# LINE 81 "System/Inotify.hsc" #-}

optionValue :: Option -> Word32
optionValue DontFollow = (33554432)
{-# LINE 84 "System/Inotify.hsc" #-}
optionValue MaskAdd = (536870912)
{-# LINE 85 "System/Inotify.hsc" #-}
optionValue Oneshot = (2147483648)
{-# LINE 86 "System/Inotify.hsc" #-}
optionValue OnlyDir = (16777216)
{-# LINE 87 "System/Inotify.hsc" #-}

alertValue :: Alert -> Word32
alertValue Ignored = (32768)
{-# LINE 90 "System/Inotify.hsc" #-}
alertValue QueueOverflowed = (16384)
{-# LINE 91 "System/Inotify.hsc" #-}
alertValue Unmounted = (8192)
{-# LINE 92 "System/Inotify.hsc" #-}

-- | 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 <- (((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr) :: IO Word32
{-# LINE 152 "System/Inotify.hsc" #-}
  name <- if namelen > 0
             then B.packCString (ptr `plusPtr` ((16)))
{-# LINE 154 "System/Inotify.hsc" #-}
             else return B.empty
  watchno <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 156 "System/Inotify.hsc" #-}
  mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 157 "System/Inotify.hsc" #-}
  cookie <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 158 "System/Inotify.hsc" #-}

  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 <- (((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr) :: IO Word32
{-# LINE 167 "System/Inotify.hsc" #-}

  return $ ((16)) + fromIntegral namelen
{-# LINE 169 "System/Inotify.hsc" #-}

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 = ((16)) + 1024
{-# LINE 199 "System/Inotify.hsc" #-}
         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