-- |
-- Module      : Streamly.Internal.FileSystem.Event.Linux
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- =Overview
--
-- Use 'watchPaths' with a list of file system paths you want to watch as
-- argument. It returns a stream of 'Event' representing the file system events
-- occurring under the watched paths.
--
-- @
-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchPaths' [Array.fromCString\# "dir"#]
-- @
--
-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)
-- provided in this module are used to determine the attributes of the event.
--
-- Identical successive events may be coalesced into a single event.
--
-- =Design notes
--
-- For reference documentation see:
--
-- * <https://man7.org/linux/man-pages/man7/inotify.7.html inotify man page>
--
-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
-- semantically and syntactically as close as possible.
--
-- =BUGs
--
-- When testing on Linux Kernel version @5.3.0-53-generic #47-Ubuntu@, the last
-- event for the root path seems to be delayed until one more event occurs.
--
-- = Differences between macOS and Linux APIs:
--
-- 1. macOS watch is based on the path provided to it, if the path is
-- deleted and recreated it will still be watched, if the path moves to another
-- path it won't be watched anymore. Whereas Linux watch is based on a handle
-- to the path, if the path is deleted and recreated it won't be watched, if
-- the path moves to another it can still be watched (though this is
-- configurable).
--
-- 2. macOS watches the directory hierarchy recursively, Linux watches only one
-- level of dir, recursive watch has to be built in user space by watching for
-- create events and adding the new directories to the watch. Not sure how this
-- will scale for too many paths.
--
-- 3. In macOS the path of the subject of the event is absolute, in Linux the
-- path is the name of the object inside the dir being watched.
--
-- 4. On Linux 'watchPaths' fails if a path does not exist, on macOS it does
-- not fail.

#include "config.h"

#if HAVE_DECL_IN_EXCL_UNLINK
module Streamly.Internal.FileSystem.Event.Linux
    (
    -- * Subscribing to events

    -- ** Default configuration
      Config (..)
    , Switch (..)
    , defaultConfig

    -- ** Watch Behavior
    , setRecursiveMode
    , setFollowSymLinks
    , setUnwatchMoved
    , setOneShot
    , setOnlyDir
    , WhenExists (..)
    , setWhenExists

    -- ** Events of Interest
    -- *** Root Path Events
    , setRootDeleted
    , setRootMoved
    , setRootPathEvents

    -- *** Item Level Metadata change
    , setAttrsModified

    -- *** Item Level Access
    , setAccessed
    , setOpened
    , setWriteClosed
    , setNonWriteClosed

    -- *** Item CRUD events
    , setCreated
    , setDeleted
    , setMovedFrom
    , setMovedTo
    , setModified

    , setAllEvents

    -- ** Watch APIs
    , watch
    , watchRecursive
    , watchWith

    -- Low level watch APIs
    , addToWatch
    , removeFromWatch

    -- * Handling Events
    , Event(..)
    , getRoot
    , getRelPath
    , getAbsPath
    , getCookie

    -- ** Root Level Events
    , isRootPathEvent
    , isRootUnwatched
    , isRootDeleted
    , isRootMoved
    , isRootUnmounted

    -- ** Item Level Metadata change
    , isAttrsModified

    -- ** Item Level Access
    , isAccessed
    , isOpened
    , isWriteClosed
    , isNonWriteClosed

    -- ** Item Level CRUD events
    , isCreated
    , isDeleted
    , isMovedFrom
    , isMovedTo
    , isMoved
    , isModified

    -- ** Item Path info
    , isDir

    -- ** Exception Conditions
    , isEventsLost

    -- * Debugging
    , showEvent
    )
where

import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.), (.&.), complement)
import Data.Char (ord)
import Data.Foldable (foldlM)
import Data.Functor.Identity (runIdentity)
import Data.IntMap.Lazy (IntMap)
import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
import Data.List.NonEmpty (NonEmpty)
#if !(MIN_VERSION_base(4,13,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word (Word8, Word32)
import Foreign.C.Error (throwErrnoIfMinus1)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..), CUInt(..))
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek, peekByteOff, sizeOf)
import GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.FD (fdFD, mkFD)
import GHC.IO.Handle.FD (mkHandleFromFD)
import Streamly.Prelude (SerialT)
import Streamly.Internal.Data.Parser (Parser)
import Streamly.Internal.Data.Array.Foreign.Type (Array(..), byteLength)
import System.Directory (doesDirectoryExist)
import System.IO (Handle, hClose, IOMode(ReadMode))
#if !MIN_VERSION_base(4,10,0)
import Control.Concurrent.MVar (readMVar)
import Data.Typeable (cast)
import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
import GHC.IO.FD (FD)
import GHC.IO.Handle.Types (Handle__(..), Handle(FileHandle, DuplexHandle))
#else
import GHC.IO.Handle.FD (handleToFd)
#endif

import qualified Data.IntMap.Lazy as Map
import qualified Data.List.NonEmpty as NonEmpty
import qualified Streamly.Internal.Data.Array.Foreign as A
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Stream.IsStream as S
import qualified Streamly.Internal.FileSystem.Dir as Dir
import qualified Streamly.Internal.FileSystem.Handle as FH
import qualified Streamly.Internal.Unicode.Stream as U

-------------------------------------------------------------------------------
-- Subscription to events
-------------------------------------------------------------------------------

-- | Watch configuration, used to specify the events of interest and the
-- behavior of the watch.
--
-- /Pre-release/
--
data Config = Config
    { Config -> Bool
watchRec :: Bool
    , Config -> Word32
createFlags :: Word32
    }

-------------------------------------------------------------------------------
-- Boolean settings
-------------------------------------------------------------------------------

-- | Whether a setting is 'On' or 'Off'.
--
-- /Pre-release/
--
data Switch = On | Off deriving (Int -> Switch -> ShowS
[Switch] -> ShowS
Switch -> String
(Int -> Switch -> ShowS)
-> (Switch -> String) -> ([Switch] -> ShowS) -> Show Switch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Switch] -> ShowS
$cshowList :: [Switch] -> ShowS
show :: Switch -> String
$cshow :: Switch -> String
showsPrec :: Int -> Switch -> ShowS
$cshowsPrec :: Int -> Switch -> ShowS
Show, Switch -> Switch -> Bool
(Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool) -> Eq Switch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Switch -> Switch -> Bool
$c/= :: Switch -> Switch -> Bool
== :: Switch -> Switch -> Bool
$c== :: Switch -> Switch -> Bool
Eq)

toggle :: Switch -> Switch
toggle :: Switch -> Switch
toggle Switch
On = Switch
Off
toggle Switch
Off = Switch
On

setFlag :: Word32 -> Switch -> Config -> Config
setFlag :: Word32 -> Switch -> Config -> Config
setFlag Word32
mask Switch
status cfg :: Config
cfg@Config{Bool
Word32
createFlags :: Word32
watchRec :: Bool
createFlags :: Config -> Word32
watchRec :: Config -> Bool
..} =
    let flags :: Word32
flags =
            case Switch
status of
                Switch
On -> Word32
createFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask
                Switch
Off -> Word32
createFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
mask
    in Config
cfg {createFlags :: Word32
createFlags = Word32
flags}

-------------------------------------------------------------------------------
-- Settings
-------------------------------------------------------------------------------

-- | Watch the whole directory tree recursively instead of watching just one
-- level of directory.
--
-- /default: Off/
--
-- /Pre-release/
--
setRecursiveMode :: Switch -> Config -> Config
setRecursiveMode :: Switch -> Config -> Config
setRecursiveMode Switch
rec cfg :: Config
cfg@Config{} = Config
cfg {watchRec :: Bool
watchRec = Switch
rec Switch -> Switch -> Bool
forall a. Eq a => a -> a -> Bool
== Switch
On}

foreign import capi
    "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32

-- | If the pathname to be watched is a symbolic link then watch the target of
-- the symbolic link instead of the symbolic link itself.
--
-- Note that the path location in the events is through the original symbolic
-- link path rather than the resolved path.
--
-- /default: On/
--
-- /Pre-release/
--
setFollowSymLinks :: Switch -> Config -> Config
setFollowSymLinks :: Switch -> Config -> Config
setFollowSymLinks Switch
s = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DONT_FOLLOW (Switch -> Switch
toggle Switch
s)

foreign import capi
    "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32

-- | If an object moves out of the directory being watched then stop watching
-- it.
--
-- /default: On/
--
-- /Pre-release/
--
setUnwatchMoved :: Switch -> Config -> Config
setUnwatchMoved :: Switch -> Config -> Config
setUnwatchMoved = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_EXCL_UNLINK

#if HAVE_DECL_IN_MASK_CREATE
foreign import capi
    "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
#endif

foreign import capi
    "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32

-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
-- called for a path.
--
-- /Pre-release/
--
data WhenExists =
      AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
    | ReplaceIfExists -- ^ Replace the existing settings with new settings
#if HAVE_DECL_IN_MASK_CREATE
    | FailIfExists -- ^ Fail the API
#endif

-- | When adding a new path to the watch, specify what to do if a watch already
-- exists on that path.
--
-- /default: FailIfExists/
--
-- /Pre-release/
--
setWhenExists :: WhenExists -> Config -> Config
setWhenExists :: WhenExists -> Config -> Config
setWhenExists WhenExists
val Config
cfg =
    case WhenExists
val of
        WhenExists
AddIfExists -> Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MASK_ADD Switch
On Config
cfg
        WhenExists
ReplaceIfExists -> Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MASK_ADD Switch
Off Config
cfg
#if HAVE_DECL_IN_MASK_CREATE
        FailIfExists -> setFlag iN_MASK_CREATE On cfg
#endif

foreign import capi
    "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32

-- | Watch the object only for one event and then remove it from the watch.
--
-- /default: Off/
--
-- /Pre-release/
--
setOneShot :: Switch -> Config -> Config
setOneShot :: Switch -> Config -> Config
setOneShot = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ONESHOT

foreign import capi
    "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32

-- | Watch the object only if it is a directory. This provides a race-free way
-- to ensure that the watched object is a directory.
--
-- /default: Off/
--
-- /Pre-release/
--
setOnlyDir :: Switch -> Config -> Config
setOnlyDir :: Switch -> Config -> Config
setOnlyDir = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ONLYDIR

-------------------------------------------------------------------------------
-- Event types that can occur
-------------------------------------------------------------------------------

foreign import capi
    "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32

-- | Report when the watched path itself gets deleted.
--
-- /default: On/
--
-- /Pre-release/
--
setRootDeleted :: Switch -> Config -> Config
setRootDeleted :: Switch -> Config -> Config
setRootDeleted = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DELETE_SELF

foreign import capi
    "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32

-- | Report when the watched root path itself gets renamed.
--
-- /default: On/
--
-- /Pre-release/
--
setRootMoved :: Switch -> Config -> Config
setRootMoved :: Switch -> Config -> Config
setRootMoved = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVE_SELF

-- | Report when the watched root path itself gets deleted or renamed.
--
-- /default: On/
--
-- /Pre-release/
--
setRootPathEvents :: Switch -> Config -> Config
setRootPathEvents :: Switch -> Config -> Config
setRootPathEvents = Word32 -> Switch -> Config -> Config
setFlag (Word32
iN_DELETE_SELF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF)

foreign import capi
    "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32

-- | Report when the metadata e.g. owner, permission modes, modifications times
-- of an object changes.
--
-- /default: On/
--
-- /Pre-release/
--
setAttrsModified :: Switch -> Config -> Config
setAttrsModified :: Switch -> Config -> Config
setAttrsModified = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ATTRIB

foreign import capi
    "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32

-- | Report when a file is accessed.
--
-- /default: On/
--
-- /Pre-release/
--
setAccessed :: Switch -> Config -> Config
setAccessed :: Switch -> Config -> Config
setAccessed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ACCESS

foreign import capi
    "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32

-- | Report when a file is opened.
--
-- /default: On/
--
-- /Pre-release/
--
setOpened :: Switch -> Config -> Config
setOpened :: Switch -> Config -> Config
setOpened = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_OPEN

foreign import capi
    "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32

-- | Report when a file that was opened for writes is closed.
--
-- /default: On/
--
-- /Pre-release/
--
setWriteClosed :: Switch -> Config -> Config
setWriteClosed :: Switch -> Config -> Config
setWriteClosed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CLOSE_WRITE

foreign import capi
    "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32

-- | Report when a file that was opened for not writing is closed.
--
-- /default: On/
--
-- /Pre-release/
--
setNonWriteClosed :: Switch -> Config -> Config
setNonWriteClosed :: Switch -> Config -> Config
setNonWriteClosed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CLOSE_NOWRITE

foreign import capi
    "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32

-- | Report when a file is created.
--
-- /default: On/
--
-- /Pre-release/
--
setCreated :: Switch -> Config -> Config
setCreated :: Switch -> Config -> Config
setCreated = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CREATE

foreign import capi
    "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32

-- | Report when a file is deleted.
--
-- /default: On/
--
-- /Pre-release/
--
setDeleted :: Switch -> Config -> Config
setDeleted :: Switch -> Config -> Config
setDeleted = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DELETE

foreign import capi
    "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32

-- | Report the source of a move.
--
-- /default: On/
--
-- /Pre-release/
--
setMovedFrom :: Switch -> Config -> Config
setMovedFrom :: Switch -> Config -> Config
setMovedFrom = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVED_FROM

foreign import capi
    "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32

-- | Report the target of a move.
--
-- /default: On/
--
-- /Pre-release/
--
setMovedTo :: Switch -> Config -> Config
setMovedTo :: Switch -> Config -> Config
setMovedTo = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVED_TO

foreign import capi
    "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32

-- | Report when a file is modified.
--
-- /default: On/
--
-- /Pre-release/
--
setModified :: Switch -> Config -> Config
setModified :: Switch -> Config -> Config
setModified = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MODIFY

-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
--
-- * setRootDeleted
-- * setRootMoved
-- * setAttrsModified
-- * setAccessed
-- * setOpened
-- * setWriteClosed
-- * setNonWriteClosed
-- * setCreated
-- * setDeleted
-- * setMovedFrom
-- * setMovedTo
-- * setModified
--
-- /Pre-release/
--
setAllEvents :: Switch -> Config -> Config
setAllEvents :: Switch -> Config -> Config
setAllEvents Switch
s =
      Switch -> Config -> Config
setRootDeleted Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setRootMoved Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setAttrsModified Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setAccessed Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setOpened Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setWriteClosed Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setNonWriteClosed Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setCreated Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setDeleted Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setMovedFrom Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setMovedTo Switch
s
    (Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setModified Switch
s

-------------------------------------------------------------------------------
-- Default config
-------------------------------------------------------------------------------

-- The defaults are set in such a way that the behavior on macOS and Linux is
-- as much compatible as possible.
--
-- | The default configuration settings are:
--
-- * 'setFollowSymLinks' 'On'
-- * 'setUnwatchMoved' 'On'
-- * 'setOneShot' 'Off'
-- * 'setOnlyDir' 'Off'
-- * 'setWhenExists' 'AddIfExists'
--
-- The tunable events enabled by default are:
--
-- * setCreated On
-- * setDeleted On
-- * setMovedFrom On
-- * setMovedTo On
-- * setModified On
--
-- /Pre-release/
--
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
      WhenExists -> Config -> Config
setWhenExists WhenExists
AddIfExists
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setCreated Switch
On
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setDeleted Switch
On
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setMovedFrom Switch
On
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setMovedTo Switch
On
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setModified Switch
On
    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config :: Bool -> Word32 -> Config
Config
        { watchRec :: Bool
watchRec = Bool
False
        , createFlags :: Word32
createFlags = Word32
0
        }

-------------------------------------------------------------------------------
-- Open an event stream
-------------------------------------------------------------------------------

-- | A handle for a watch.
data Watch =
    Watch
        Handle                  -- File handle for the watch
        (IORef
            (IntMap             -- Key is the watch descriptor
                ( Array Word8   -- Absolute path of the watch root
                , Array Word8   -- Path of subdir relative to watch root
                )
            )
        )

-- Instead of using the watch descriptor we can provide APIs that use the path
-- itself to identify the watch. That will require us to maintain a map from wd
-- to path in the Watch handle.

newtype WD = WD CInt deriving Int -> WD -> ShowS
[WD] -> ShowS
WD -> String
(Int -> WD -> ShowS)
-> (WD -> String) -> ([WD] -> ShowS) -> Show WD
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WD] -> ShowS
$cshowList :: [WD] -> ShowS
show :: WD -> String
$cshow :: WD -> String
showsPrec :: Int -> WD -> ShowS
$cshowsPrec :: Int -> WD -> ShowS
Show

foreign import ccall unsafe
    "sys/inotify.h inotify_init" c_inotify_init :: IO CInt

-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
-- monitored by this watch.
--
-- /Pre-release/
--
createWatch :: IO Watch
createWatch :: IO Watch
createWatch = do
    CInt
rawfd <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"createWatch" IO CInt
c_inotify_init
    -- we could use fdToHandle but it cannot determine the fd type
    -- automatically for the inotify fd
    (FD
fd, IODeviceType
fdType) <-
        CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
mkFD
            CInt
rawfd
            IOMode
ReadMode
            ((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
forall a. a -> Maybe a
Just (IODeviceType
Stream, CDev
0, CIno
0))  -- (IODeviceType, CDev, CIno)
            Bool
False                  -- not a socket
            Bool
False                  -- non-blocking is false
    let fdString :: String
fdString = String
"<createWatch file descriptor: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> String
forall a. Show a => a -> String
show FD
fd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
    Handle
h <-
        FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD
           FD
fd
           IODeviceType
fdType
           String
fdString
           IOMode
ReadMode
           Bool
True    -- use non-blocking IO
           Maybe TextEncoding
forall a. Maybe a
Nothing -- TextEncoding (binary)
    IORef (IntMap (Array Word8, Array Word8))
emptyMapRef <- IntMap (Array Word8, Array Word8)
-> IO (IORef (IntMap (Array Word8, Array Word8)))
forall a. a -> IO (IORef a)
newIORef IntMap (Array Word8, Array Word8)
forall a. IntMap a
Map.empty
    Watch -> IO Watch
forall (m :: * -> *) a. Monad m => a -> m a
return (Watch -> IO Watch) -> Watch -> IO Watch
forall a b. (a -> b) -> a -> b
$ Handle -> IORef (IntMap (Array Word8, Array Word8)) -> Watch
Watch Handle
h IORef (IntMap (Array Word8, Array Word8))
emptyMapRef

foreign import ccall unsafe
    "sys/inotify.h inotify_add_watch" c_inotify_add_watch
        :: CInt -> CString -> CUInt -> IO CInt

-- XXX we really do not know the path encoding, all we know is that it is "/"
-- separated bytes. So these may fail or convert the path in an unexpected
-- manner. We should ultimately remove all usage of these.

toUtf8 :: MonadIO m => String -> m (Array Word8)
toUtf8 :: String -> m (Array Word8)
toUtf8 = SerialT m Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
SerialT m a -> m (Array a)
A.fromStream (SerialT m Word8 -> m (Array Word8))
-> (String -> SerialT m Word8) -> String -> m (Array Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT m Char -> SerialT m Word8
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, IsStream t) =>
t m Char -> t m Word8
U.encodeUtf8 (SerialT m Char -> SerialT m Word8)
-> (String -> SerialT m Char) -> String -> SerialT m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SerialT m Char
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, IsStream t) =>
[a] -> t m a
S.fromList

utf8ToString :: Array Word8 -> String
utf8ToString :: Array Word8 -> String
utf8ToString = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (Array Word8 -> Identity String) -> Array Word8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT Identity Char -> Identity String
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList (SerialT Identity Char -> Identity String)
-> (Array Word8 -> SerialT Identity Char)
-> Array Word8
-> Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT Identity Word8 -> SerialT Identity Char
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, IsStream t) =>
t m Word8 -> t m Char
U.decodeUtf8' (SerialT Identity Word8 -> SerialT Identity Char)
-> (Array Word8 -> SerialT Identity Word8)
-> Array Word8
-> SerialT Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Word8 -> SerialT Identity Word8
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> SerialT m a
A.toStream

#if !MIN_VERSION_base(4,10,0)
-- | Turn an existing Handle into a file descriptor. This function throws an
-- IOError if the Handle does not reference a file descriptor.
handleToFd :: Handle -> IO FD
handleToFd h = case h of
    FileHandle _ mv -> do
      Handle__{haDevice = dev} <- readMVar mv
      case cast dev of
        Just fd -> return fd
        Nothing -> throwErr "not a file descriptor"
    DuplexHandle{} -> throwErr "not a file handle"

    where

    throwErr msg = ioException $ IOError (Just h)
      InappropriateType "handleToFd" msg Nothing Nothing
#endif

-- | Add a trailing "/" at the end of the path if there is none. Do not add a
-- "/" if the path is empty.
--
ensureTrailingSlash :: Array Word8 -> Array Word8
ensureTrailingSlash :: Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
path =
    if Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
path Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    then
        let mx :: Maybe Word8
mx = Array Word8 -> Int -> Maybe Word8
forall a. Storable a => Array a -> Int -> Maybe a
A.getIndex Array Word8
path (Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
         in case Maybe Word8
mx of
            Maybe Word8
Nothing -> String -> Array Word8
forall a. HasCallStack => String -> a
error String
"ensureTrailingSlash: Bug: Invalid index"
            Just Word8
x ->
                if Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'/')
                then Array Word8
path Array Word8 -> Array Word8 -> Array Word8
forall a. Semigroup a => a -> a -> a
<> Addr# -> Array Word8
A.fromCString# Addr#
"/"#
                else Array Word8
path
    else Array Word8
path

removeTrailingSlash :: Array Word8 -> Array Word8
removeTrailingSlash :: Array Word8 -> Array Word8
removeTrailingSlash Array Word8
path =
    if Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
path Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    then
        let n :: Int
n = Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            mx :: Maybe Word8
mx = Array Word8 -> Int -> Maybe Word8
forall a. Storable a => Array a -> Int -> Maybe a
A.getIndex Array Word8
path Int
n
         in case Maybe Word8
mx of
            Maybe Word8
Nothing -> String -> Array Word8
forall a. HasCallStack => String -> a
error String
"removeTrailingSlash: Bug: Invalid index"
            Just Word8
x ->
                if Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'/')
                then Int -> Int -> Array Word8 -> Array Word8
forall a. Storable a => Int -> Int -> Array a -> Array a
A.getSliceUnsafe Int
0 Int
n Array Word8
path
                else Array Word8
path
    else Array Word8
path

appendPaths :: Array Word8 -> Array Word8 -> Array Word8
appendPaths :: Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
a Array Word8
b
  | Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Array Word8
b
  | Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Array Word8
a
  | Bool
otherwise = Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
a Array Word8 -> Array Word8 -> Array Word8
forall a. Semigroup a => a -> a -> a
<> Array Word8
b

-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
-- being monitored under @root@ via the watch handle @watch@.  @root@ must be
-- an absolute path and @subpath@ must be relative to @root@.
--
-- /Pre-release/
--
addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch cfg :: Config
cfg@Config{Bool
Word32
createFlags :: Word32
watchRec :: Bool
createFlags :: Config -> Word32
watchRec :: Config -> Bool
..} watch0 :: Watch
watch0@(Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
wdMap) Array Word8
root0 Array Word8
path0 = do
    -- XXX do not add if the path is already added
    -- XXX if the watch is added by the scan and not via an event we can
    -- generate a create event assuming that the create may have been lost. We
    -- can also mark in the map that this entry was added by the scan. So if an
    -- actual create event later comes and tries to add this again then we can
    -- ignore that and drop the create event to avoid duplicate create, because
    -- we have already emitted it.
    --
    -- When a directory is added by the scan we should also emit create events
    -- for files that may have got added to the dir. However, such create
    -- events may get duplicated because of a race between the scan generated
    -- versus real events.
    --
    -- Or we may distinguish between scan generated events and real events so
    -- that the application can assume that other events may been lost and
    -- handle it. For example, if it is a dir create the application can read
    -- the dir to scan the files in it.
    --
    let root :: Array Word8
root = Array Word8 -> Array Word8
removeTrailingSlash Array Word8
root0
        path :: Array Word8
path = Array Word8 -> Array Word8
removeTrailingSlash Array Word8
path0
        absPath :: Array Word8
absPath = Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
root Array Word8
path
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"root = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" path = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" absPath = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
absPath

    FD
fd <- Handle -> IO FD
handleToFd Handle
handle

    -- XXX we need to tolerate an error where we are adding a watch for a
    -- non-existing file because the file may have got deleted by the time we
    -- added the watch. Perhaps we can have a flag in config for this and keep
    -- the default value to tolerate the error.
    --
    -- XXX The file may have even got deleted and then recreated which we will
    -- never get to know, document this.
    CInt
wd <- Array Word8 -> (CString -> IO CInt) -> IO CInt
forall a b. Array a -> (CString -> IO b) -> IO b
A.unsafeAsCString Array Word8
absPath ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
pathPtr ->
            String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 (String
"addToWatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
absPath) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
                CInt -> CString -> CUInt -> IO CInt
c_inotify_add_watch (FD -> CInt
fdFD FD
fd) CString
pathPtr (Word32 -> CUInt
CUInt Word32
createFlags)

    -- We add the parent first so that we start getting events for any new
    -- creates and add the new subdirectories on creates while we are adding
    -- the children.
    IORef (IntMap (Array Word8, Array Word8))
-> (IntMap (Array Word8, Array Word8)
    -> IntMap (Array Word8, Array Word8))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (IntMap (Array Word8, Array Word8))
wdMap (Int
-> (Array Word8, Array Word8)
-> IntMap (Array Word8, Array Word8)
-> IntMap (Array Word8, Array Word8)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
wd) (Array Word8
root, Array Word8
path))

    -- Now add the children. If we missed any creates while we were adding the
    -- parent, this will make sure they are added too.
    --
    -- XXX Ensure that we generate events that we may have missed while we were
    -- adding the dirs. That may generate spurious events though.
    --
    -- XXX toDirs currently uses paths as String, we need to convert it
    -- to "/" separated by byte arrays.
    Bool
pathIsDir <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ Array Word8 -> String
utf8ToString Array Word8
absPath
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
watchRec Bool -> Bool -> Bool
&& Bool
pathIsDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (Array Word8 -> IO ()) -> SerialT IO (Array Word8) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SerialT m a -> m ()
S.mapM_ (\Array Word8
p -> Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
watch0 Array Word8
root (Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
path Array Word8
p))
            (SerialT IO (Array Word8) -> IO ())
-> SerialT IO (Array Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> IO (Array Word8))
-> SerialT IO String -> SerialT IO (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m b
S.mapM String -> IO (Array Word8)
forall (m :: * -> *). MonadIO m => String -> m (Array Word8)
toUtf8
            (SerialT IO String -> SerialT IO (Array Word8))
-> SerialT IO String -> SerialT IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ String -> SerialT IO String
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
String -> t m String
Dir.toDirs (String -> SerialT IO String) -> String -> SerialT IO String
forall a b. (a -> b) -> a -> b
$ Array Word8 -> String
utf8ToString Array Word8
absPath

foreign import ccall unsafe
    "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
        :: CInt -> CInt -> IO CInt

-- | Remove an absolute root path from a 'Watch', if a path was moved after
-- adding you need to provide the original path which was used to add the
-- Watch.
--
-- /Pre-release/
--
removeFromWatch :: Watch -> Array Word8 -> IO ()
removeFromWatch :: Watch -> Array Word8 -> IO ()
removeFromWatch (Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
wdMap) Array Word8
path = do
    FD
fd <- Handle -> IO FD
handleToFd Handle
handle
    IntMap (Array Word8, Array Word8)
km <- IORef (IntMap (Array Word8, Array Word8))
-> IO (IntMap (Array Word8, Array Word8))
forall a. IORef a -> IO a
readIORef IORef (IntMap (Array Word8, Array Word8))
wdMap
    IntMap (Array Word8, Array Word8)
wdMap1 <- (IntMap (Array Word8, Array Word8)
 -> (Int, (Array Word8, Array Word8))
 -> IO (IntMap (Array Word8, Array Word8)))
-> IntMap (Array Word8, Array Word8)
-> [(Int, (Array Word8, Array Word8))]
-> IO (IntMap (Array Word8, Array Word8))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (FD
-> IntMap (Array Word8, Array Word8)
-> (Int, (Array Word8, Array Word8))
-> IO (IntMap (Array Word8, Array Word8))
forall b.
FD
-> IntMap (Array Word8, b)
-> (Int, (Array Word8, b))
-> IO (IntMap (Array Word8, b))
step FD
fd) IntMap (Array Word8, Array Word8)
forall a. IntMap a
Map.empty (IntMap (Array Word8, Array Word8)
-> [(Int, (Array Word8, Array Word8))]
forall a. IntMap a -> [(Int, a)]
Map.toList IntMap (Array Word8, Array Word8)
km)
    IORef (IntMap (Array Word8, Array Word8))
-> IntMap (Array Word8, Array Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap (Array Word8, Array Word8))
wdMap IntMap (Array Word8, Array Word8)
wdMap1

    where

    step :: FD
-> IntMap (Array Word8, b)
-> (Int, (Array Word8, b))
-> IO (IntMap (Array Word8, b))
step FD
fd IntMap (Array Word8, b)
newMap (Int
wd, (Array Word8, b)
v) = do
        if (Array Word8, b) -> Array Word8
forall a b. (a, b) -> a
fst (Array Word8, b)
v Array Word8 -> Array Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Array Word8
path
        then do
            let err :: String
err = String
"removeFromWatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString Array Word8
path)
                rm :: IO CInt
rm = CInt -> CInt -> IO CInt
c_inotify_rm_watch (FD -> CInt
fdFD FD
fd) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wd)
            IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
err IO CInt
rm
            IntMap (Array Word8, b) -> IO (IntMap (Array Word8, b))
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap (Array Word8, b)
newMap
        else IntMap (Array Word8, b) -> IO (IntMap (Array Word8, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (Array Word8, b) -> IO (IntMap (Array Word8, b)))
-> IntMap (Array Word8, b) -> IO (IntMap (Array Word8, b))
forall a b. (a -> b) -> a -> b
$ Int
-> (Array Word8, b)
-> IntMap (Array Word8, b)
-> IntMap (Array Word8, b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
wd (Array Word8, b)
v IntMap (Array Word8, b)
newMap

-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start
-- monitoring the paths for file system events. Returns a 'Watch' handle which
-- can then be used to read the event stream or to close the watch.
--
-- /Pre-release/
--
openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
openWatch Config
cfg NonEmpty (Array Word8)
paths = do
    Watch
w <- IO Watch
createWatch
    (Array Word8 -> IO ()) -> [Array Word8] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        (\Array Word8
root -> Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
w Array Word8
root ([Word8] -> Array Word8
forall a. Storable a => [a] -> Array a
A.fromList []))
        ([Array Word8] -> IO ()) -> [Array Word8] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (Array Word8) -> [Array Word8]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Array Word8)
paths
    Watch -> IO Watch
forall (m :: * -> *) a. Monad m => a -> m a
return Watch
w

-- | Close a 'Watch' handle.
--
-- /Pre-release/
--
closeWatch :: Watch -> IO ()
closeWatch :: Watch -> IO ()
closeWatch (Watch Handle
h IORef (IntMap (Array Word8, Array Word8))
_) = Handle -> IO ()
hClose Handle
h

-------------------------------------------------------------------------------
-- Raw events read from the watch file handle
-------------------------------------------------------------------------------

newtype Cookie = Cookie Word32 deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq)

-- | An Event generated by the file system. Use the accessor functions to
-- examine the event.
--
-- /Pre-release/
--
data Event = Event
   { Event -> CInt
eventWd :: CInt
   , Event -> Word32
eventFlags :: Word32
   , Event -> Word32
eventCookie :: Word32
   , Event -> Array Word8
eventRelPath :: Array Word8
   , Event -> IntMap (Array Word8, Array Word8)
eventMap :: IntMap (Array Word8, Array Word8)
   } deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

-- The inotify event struct from the man page/header file:
--
--            struct inotify_event {
--                int      wd;       /* Watch descriptor */
--                uint32_t mask;     /* Mask describing event */
--                uint32_t cookie;   /* Unique cookie associating related
--                                      events (for rename(2)) */
--                uint32_t len;      /* Size of name field */
--                char     name[];   /* Optional null-terminated name */
--            };
--
-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
-- to measure the perf.
--
readOneEvent :: Config -> Watch -> Parser IO Word8 Event
readOneEvent :: Config -> Watch -> Parser IO Word8 Event
readOneEvent Config
cfg  wt :: Watch
wt@(Watch Handle
_ IORef (IntMap (Array Word8, Array Word8))
wdMap) = do
    let headerLen :: Int
headerLen = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12
    Array Word8
arr <- Int -> Fold IO Word8 (Array Word8) -> Parser IO Word8 (Array Word8)
forall (m :: * -> *) a b.
MonadCatch m =>
Int -> Fold m a b -> Parser m a b
PR.takeEQ Int
headerLen (Int -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
A.writeN Int
headerLen)
    (Word8
ewd, Word32
eflags, Word32
cookie, Int
pathLen) <- IO (Word8, Word32, Word32, Int)
-> Parser IO Word8 (Word8, Word32, Word32, Int)
forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect (IO (Word8, Word32, Word32, Int)
 -> Parser IO Word8 (Word8, Word32, Word32, Int))
-> IO (Word8, Word32, Word32, Int)
-> Parser IO Word8 (Word8, Word32, Word32, Int)
forall a b. (a -> b) -> a -> b
$ Array Word8
-> (Ptr Word8 -> IO (Word8, Word32, Word32, Int))
-> IO (Word8, Word32, Word32, Int)
forall (m :: * -> *) a b.
MonadIO m =>
Array a -> (Ptr a -> m b) -> m b
A.asPtrUnsafe Array Word8
arr Ptr Word8 -> IO (Word8, Word32, Word32, Int)
forall b c d.
(Storable b, Storable c, Num d) =>
Ptr Word8 -> IO (Word8, b, c, d)
readHeader
    -- XXX need the "initial" in parsers to return a step type so that "take 0"
    -- can return without an input. otherwise if pathLen is 0 we will keep
    -- waiting to read one more char before we return this event.
    Array Word8
path <-
        if Int
pathLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then do
            -- XXX takeEndBy_ drops the separator so assumes a null
            -- terminated path, we should use a takeWhile nested inside a
            -- takeP
            Array Word8
pth <-
                Fold IO Word8 (Array Word8) -> Parser IO Word8 (Array Word8)
forall (m :: * -> *) a b.
MonadCatch m =>
Fold m a b -> Parser m a b
PR.fromFold
                    (Fold IO Word8 (Array Word8) -> Parser IO Word8 (Array Word8))
-> Fold IO Word8 (Array Word8) -> Parser IO Word8 (Array Word8)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
FL.takeEndBy_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
                    (Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8))
-> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall a b. (a -> b) -> a -> b
$ Int -> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
pathLen (Int -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
A.writeN Int
pathLen)
            let remaining :: Int
remaining = Int
pathLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
pth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            Bool -> Parser IO Word8 () -> Parser IO Word8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
remaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Parser IO Word8 () -> Parser IO Word8 ())
-> Parser IO Word8 () -> Parser IO Word8 ()
forall a b. (a -> b) -> a -> b
$ Int -> Fold IO Word8 () -> Parser IO Word8 ()
forall (m :: * -> *) a b.
MonadCatch m =>
Int -> Fold m a b -> Parser m a b
PR.takeEQ Int
remaining Fold IO Word8 ()
forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
            Array Word8 -> Parser IO Word8 (Array Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Array Word8
pth
        else Array Word8 -> Parser IO Word8 (Array Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Word8 -> Parser IO Word8 (Array Word8))
-> Array Word8 -> Parser IO Word8 (Array Word8)
forall a b. (a -> b) -> a -> b
$ [Word8] -> Array Word8
forall a. Storable a => [a] -> Array a
A.fromList []
    IntMap (Array Word8, Array Word8)
wdm <- IO (IntMap (Array Word8, Array Word8))
-> Parser IO Word8 (IntMap (Array Word8, Array Word8))
forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect (IO (IntMap (Array Word8, Array Word8))
 -> Parser IO Word8 (IntMap (Array Word8, Array Word8)))
-> IO (IntMap (Array Word8, Array Word8))
-> Parser IO Word8 (IntMap (Array Word8, Array Word8))
forall a b. (a -> b) -> a -> b
$ IORef (IntMap (Array Word8, Array Word8))
-> IO (IntMap (Array Word8, Array Word8))
forall a. IORef a -> IO a
readIORef IORef (IntMap (Array Word8, Array Word8))
wdMap
    let (Array Word8
root, Array Word8
sub) =
            case Int
-> IntMap (Array Word8, Array Word8)
-> Maybe (Array Word8, Array Word8)
forall a. Int -> IntMap a -> Maybe a
Map.lookup (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd) IntMap (Array Word8, Array Word8)
wdm of
                    Just (Array Word8, Array Word8)
pair -> (Array Word8, Array Word8)
pair
                    Maybe (Array Word8, Array Word8)
Nothing ->
                        String -> (Array Word8, Array Word8)
forall a. HasCallStack => String -> a
error (String -> (Array Word8, Array Word8))
-> String -> (Array Word8, Array Word8)
forall a b. (a -> b) -> a -> b
$ String
"readOneEvent: "
                                  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Unknown watch descriptor: "
                                  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
ewd
    let sub1 :: Array Word8
sub1 = Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
sub Array Word8
path
        -- Check for "ISDIR" first because it is less likely
        isDirCreate :: Bool
isDirCreate = Word32
eflags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
iN_ISDIR Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
&& Word32
eflags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
iN_CREATE Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
    Bool -> Parser IO Word8 () -> Parser IO Word8 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
watchRec Config
cfg Bool -> Bool -> Bool
&& Bool
isDirCreate)
        (Parser IO Word8 () -> Parser IO Word8 ())
-> Parser IO Word8 () -> Parser IO Word8 ()
forall a b. (a -> b) -> a -> b
$ IO () -> Parser IO Word8 ()
forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect (IO () -> Parser IO Word8 ()) -> IO () -> Parser IO Word8 ()
forall a b. (a -> b) -> a -> b
$ Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
wt Array Word8
root Array Word8
sub1
    -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
    -- IN_MOVED_TO
    -- What if a large dir tree gets moved in to our hierarchy? Do we get a
    -- single event for the top level dir in this case?
    Event -> Parser IO Word8 Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Parser IO Word8 Event) -> Event -> Parser IO Word8 Event
forall a b. (a -> b) -> a -> b
$ Event :: CInt
-> Word32
-> Word32
-> Array Word8
-> IntMap (Array Word8, Array Word8)
-> Event
Event
        { eventWd :: CInt
eventWd = Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd
        , eventFlags :: Word32
eventFlags = Word32
eflags
        , eventCookie :: Word32
eventCookie = Word32
cookie
        , eventRelPath :: Array Word8
eventRelPath = Array Word8
sub1
        , eventMap :: IntMap (Array Word8, Array Word8)
eventMap = IntMap (Array Word8, Array Word8)
wdm
        }

    where

    readHeader :: Ptr Word8 -> IO (Word8, b, c, d)
readHeader (Ptr Word8
ptr :: Ptr Word8) = do
        let len :: Int
len = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
        Word8
ewd <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        b
eflags <- Ptr Word8 -> Int -> IO b
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
len
        c
cookie <- Ptr Word8 -> Int -> IO c
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
        Word32
pathLen :: Word32 <- Ptr Word8 -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)
        (Word8, b, c, d) -> IO (Word8, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ewd, b
eflags, c
cookie, Word32 -> d
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pathLen)

watchToStream :: Config -> Watch -> SerialT IO Event
watchToStream :: Config -> Watch -> SerialT IO Event
watchToStream Config
cfg wt :: Watch
wt@(Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
_) = do
    -- Do not use too small a buffer. As per inotify man page:
    --
    -- The behavior when the buffer given to read(2) is too small to return
    -- information about the next event depends on the kernel version: in
    -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
    -- fails with the error EINVAL.  Specifying a buffer of size
    --
    --          sizeof(struct inotify_event) + NAME_MAX + 1
    --
    -- will be sufficient to read at least one event.
    Parser IO Word8 Event -> SerialT IO Word8 -> SerialT IO Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadThrow m) =>
Parser m a b -> t m a -> t m b
S.parseMany (Config -> Watch -> Parser IO Word8 Event
readOneEvent Config
cfg Watch
wt) (SerialT IO Word8 -> SerialT IO Event)
-> SerialT IO Word8 -> SerialT IO Event
forall a b. (a -> b) -> a -> b
$ Unfold IO Handle Word8 -> Handle -> SerialT IO Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold Unfold IO Handle Word8
forall (m :: * -> *). MonadIO m => Unfold m Handle Word8
FH.read Handle
handle

-- XXX We should not go across the mount points of network file systems or file
-- systems that are known to not generate any events.
--
-- | Start monitoring a list of file system paths for file system events with
-- the supplied configuration operation over the 'defaultConfig'. The
-- paths could be files or directories.  When recursive mode is set and the
-- path is a directory, the whole directory tree under it is watched
-- recursively. Monitoring starts from the current time onwards.  The paths are
-- specified as UTF-8 encoded 'Array' of 'Word8'.
--
-- /Non-existing Paths:/ the API fails if a watch is started on a non-exsting
-- path.
--
-- /Performance:/ Note that recursive watch on a large directory tree could be
-- expensive. When starting a watch, the whole tree must be read and watches
-- are started on each directory in the tree. The initial time to start the
-- watch as well as the memory required is proportional to the number of
-- directories in the tree.
--
-- /Bugs:/ When new directories are created under the tree they are added to
-- the watch on receiving the directory create event. However, the creation of
-- a dir and adding a watch for it is not atomic.  The implementation takes
-- care of this and makes sure that watches are added for all directories.
-- However, In the mean time, the directory may have received more events which
-- may get lost.  Handling of any such lost events is yet to be implemented.
--
-- See the Linux __inotify__ man page for more details.
--
-- @
-- watchwith
--      ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
--      [Array.fromCString\# "dir"#]
-- @
--
-- /Pre-release/
--
watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith Config -> Config
f NonEmpty (Array Word8)
paths = IO Watch
-> (Watch -> IO ())
-> (Watch -> SerialT IO Event)
-> SerialT IO Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) b c a.
(IsStream t, MonadAsync m, MonadCatch m) =>
m b -> (b -> m c) -> (b -> t m a) -> t m a
S.bracket IO Watch
before Watch -> IO ()
after (Config -> Watch -> SerialT IO Event
watchToStream Config
cfg)

    where

    cfg :: Config
cfg = Config -> Config
f Config
defaultConfig
    before :: IO Watch
before = IO Watch -> IO Watch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Watch -> IO Watch) -> IO Watch -> IO Watch
forall a b. (a -> b) -> a -> b
$ Config -> NonEmpty (Array Word8) -> IO Watch
openWatch Config
cfg NonEmpty (Array Word8)
paths
    after :: Watch -> IO ()
after = IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (Watch -> IO ()) -> Watch -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Watch -> IO ()
closeWatch

-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
--
-- >>> watchRecursive = watchWith (setRecursiveMode On)
--
-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
--
-- /Pre-release/
--
watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
watchRecursive = (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith (Switch -> Config -> Config
setRecursiveMode Switch
On)

-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
--
-- >>> watch = watchWith id
--
-- /Pre-release/
--
watch :: NonEmpty (Array Word8) -> SerialT IO Event
watch :: NonEmpty (Array Word8) -> SerialT IO Event
watch = (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith Config -> Config
forall a. a -> a
id

-------------------------------------------------------------------------------
-- Examine event stream
-------------------------------------------------------------------------------

-- | Get the watch root corresponding to the 'Event'.
--
-- Note that if a path was moved after adding to the watch, this will give the
-- original path and not the new path after moving.
--
-- TBD: we can possibly update the watch root on a move self event.
--
-- /Pre-release/
--
getRoot :: Event -> Array Word8
getRoot :: Event -> Array Word8
getRoot Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} =
    if CInt
eventWd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
1
    then
        case Int
-> IntMap (Array Word8, Array Word8)
-> Maybe (Array Word8, Array Word8)
forall a. Int -> IntMap a -> Maybe a
Map.lookup (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
eventWd) IntMap (Array Word8, Array Word8)
eventMap of
            Just (Array Word8, Array Word8)
path -> (Array Word8, Array Word8) -> Array Word8
forall a b. (a, b) -> a
fst (Array Word8, Array Word8)
path
            Maybe (Array Word8, Array Word8)
Nothing ->
                String -> Array Word8
forall a. HasCallStack => String -> a
error (String -> Array Word8) -> String -> Array Word8
forall a b. (a -> b) -> a -> b
$ String
"Bug: getRoot: No path found corresponding to the "
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"watch descriptor " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
eventWd
    else [Word8] -> Array Word8
forall a. Storable a => [a] -> Array a
A.fromList []

-- XXX should we use a Maybe here?
-- | Get the file system object path for which the event is generated, relative
-- to the watched root. The path is a "/" separated array of bytes.
--
-- /Pre-release/
--
getRelPath :: Event -> Array Word8
getRelPath :: Event -> Array Word8
getRelPath Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Array Word8
eventRelPath

-- | Get the absolute file system object path for which the event is generated.
--
-- When the watch root is a symlink, the absolute path returned is via the
-- original symlink and not through the resolved path.
--
-- /Pre-release/
--
getAbsPath :: Event -> Array Word8
getAbsPath :: Event -> Array Word8
getAbsPath Event
ev =
    let relpath :: Array Word8
relpath = Event -> Array Word8
getRelPath Event
ev
        root :: Array Word8
root = Event -> Array Word8
getRoot Event
ev
    in  if Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
relpath Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
root Array Word8 -> Array Word8 -> Array Word8
forall a. Semigroup a => a -> a -> a
<> Array Word8
relpath
        else Array Word8 -> Array Word8
removeTrailingSlash Array Word8
root

-- XXX should we use a Maybe?
-- | Cookie is set when a rename occurs. The cookie value can be used to
-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
-- to the same move operation then they will have the same cookie value.
--
-- /Pre-release/
--
getCookie :: Event -> Cookie
getCookie :: Event -> Cookie
getCookie Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Word32 -> Cookie
Cookie Word32
eventCookie

-------------------------------------------------------------------------------
-- Event types
-------------------------------------------------------------------------------

getFlag :: Word32 -> Event -> Bool
getFlag :: Word32 -> Event -> Bool
getFlag Word32
mask Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Word32
eventFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0

-------------------------------------------------------------------------------
-- Error events
-------------------------------------------------------------------------------

foreign import capi
    "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32

-- XXX rename to isQOverflowed or hasOverflowed?
--
-- macOS overflow API is more specific, it tells which paths have lost the
-- events due to overflow.
--
-- | Event queue overflowed (WD is invalid for this event) and we may have lost
-- some events..  The user application must scan everything under the watched
-- paths to know the current state.
--
-- /Pre-release/
--
isEventsLost :: Event -> Bool
isEventsLost :: Event -> Bool
isEventsLost = Word32 -> Event -> Bool
getFlag Word32
iN_Q_OVERFLOW

-------------------------------------------------------------------------------
-- Events affecting the watched path only
-------------------------------------------------------------------------------

foreign import capi
    "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32

-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
--
-- | A path was removed from the watch explicitly using 'removeFromWatch' or
-- automatically (file was deleted, or filesystem was unmounted).
--
-- Note that in recursive watch mode all the subdirectories are watch roots,
-- therefore, they will all generate this event.
--
-- /Occurs only for a watched path/
--
-- /Pre-release/
--
isRootUnwatched :: Event -> Bool
isRootUnwatched :: Event -> Bool
isRootUnwatched = Word32 -> Event -> Bool
getFlag Word32
iN_IGNORED

-- | Watched file/directory was itself deleted.  (This event also occurs if an
-- object is moved to another filesystem, since mv(1) in effect copies the file
-- to the other filesystem and then deletes it from the original filesystem.)
-- In addition, an 'isRootUnwatched' event will subsequently be generated
-- for the watch descriptor.
--
-- Note that in recursive watch mode all the subdirectories are watch roots,
-- therefore, they will all generate this event.
--
-- /Occurs only for a watched path/
--
-- /Pre-release/
--
isRootDeleted :: Event -> Bool
isRootDeleted :: Event -> Bool
isRootDeleted = Word32 -> Event -> Bool
getFlag Word32
iN_DELETE_SELF

-- | Watched file/directory was itself moved within the file system.
--
-- Note that in recursive watch mode all the subdirectories are watch roots,
-- therefore, they will all generate this event.
--
-- /Occurs only for a watched path/
--
-- /Pre-release/
--
isRootMoved :: Event -> Bool
isRootMoved :: Event -> Bool
isRootMoved = Word32 -> Event -> Bool
getFlag Word32
iN_MOVE_SELF

foreign import capi
    "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32

-- | Filesystem containing watched object was unmounted.  In addition, an
-- 'isRootUnwatched' event will subsequently be generated for the watch
-- descriptor.
--
-- /Occurs only for a watched path/
--
-- /Pre-release/
--
isRootUnmounted :: Event -> Bool
isRootUnmounted :: Event -> Bool
isRootUnmounted = Word32 -> Event -> Bool
getFlag Word32
iN_UNMOUNT

-- | Determine whether the event indicates a change of path of the monitored
-- object itself. Note that the object may become unreachable or deleted after
-- a change of path.
--
-- /Occurs only for a watched path/
--
-- /Pre-release/
--
isRootPathEvent :: Event -> Bool
isRootPathEvent :: Event -> Bool
isRootPathEvent = Word32 -> Event -> Bool
getFlag (Word32
iN_DELETE_SELF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
iN_UNMOUNT)

-------------------------------------------------------------------------------
-- Metadata change Events
-------------------------------------------------------------------------------

-- macOS has multiple APIs for metadata change for different metadata.
--
-- | Determine whether the event indicates inode metadata change for an object
-- contained within the monitored path.
--
-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
-- user/group ID (e.g., chown(2)).
--
-- /Can occur for watched path or a file inside it/
--
-- /Pre-release/
--
isAttrsModified :: Event -> Bool
isAttrsModified :: Event -> Bool
isAttrsModified = Word32 -> Event -> Bool
getFlag Word32
iN_ATTRIB

-------------------------------------------------------------------------------
-- Access
-------------------------------------------------------------------------------

-- | File was accessed (e.g. read, execve).
--
-- /Occurs only for a file inside the watched directory/
--
-- /Pre-release/
--
isAccessed :: Event -> Bool
isAccessed :: Event -> Bool
isAccessed = Word32 -> Event -> Bool
getFlag Word32
iN_ACCESS

-- | File or directory was opened.
--
-- /Occurs only for a file inside the watched directory/
--
-- /Pre-release/
--
isOpened :: Event -> Bool
isOpened :: Event -> Bool
isOpened = Word32 -> Event -> Bool
getFlag Word32
iN_OPEN

-- | File opened for writing was closed.
--
-- /Occurs only for a file inside the watched directory/
--
-- /Pre-release/
--
isWriteClosed :: Event -> Bool
isWriteClosed :: Event -> Bool
isWriteClosed = Word32 -> Event -> Bool
getFlag Word32
iN_CLOSE_WRITE

-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
-- mode was not write? A dir open comes in this category?
--
-- | File or directory opened for read but not write was closed.
--
-- /Can occur for watched path or a file inside it/
--
-- /Pre-release/
--
isNonWriteClosed :: Event -> Bool
isNonWriteClosed :: Event -> Bool
isNonWriteClosed = Word32 -> Event -> Bool
getFlag Word32
iN_CLOSE_NOWRITE

-------------------------------------------------------------------------------
-- CRUD Events
-------------------------------------------------------------------------------

-- On macOS this is not generated on hard linking but on Linux it is.
--
-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isCreated :: Event -> Bool
isCreated :: Event -> Bool
isCreated = Word32 -> Event -> Bool
getFlag Word32
iN_CREATE

-- | File/directory deleted from watched directory.
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isDeleted :: Event -> Bool
isDeleted :: Event -> Bool
isDeleted = Word32 -> Event -> Bool
getFlag Word32
iN_DELETE

-- XXX what if an object is moved in from outside or moved out of the monitored
-- dir?
--
-- | Generated for the original path when an object is moved from under a
-- monitored directory.
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isMovedFrom :: Event -> Bool
isMovedFrom :: Event -> Bool
isMovedFrom = Word32 -> Event -> Bool
getFlag Word32
iN_MOVED_FROM

-- | Generated for the new path when an object is moved under a monitored
-- directory.
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isMovedTo :: Event -> Bool
isMovedTo :: Event -> Bool
isMovedTo = Word32 -> Event -> Bool
getFlag Word32
iN_MOVED_TO

-- | Generated for a path that is moved from or moved to the monitored
-- directory.
--
-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isMoved :: Event -> Bool
isMoved :: Event -> Bool
isMoved Event
ev = Event -> Bool
isMovedFrom Event
ev Bool -> Bool -> Bool
|| Event -> Bool
isMovedTo Event
ev

-- | Determine whether the event indicates modification of an object within the
-- monitored path. This event is generated only for files and not directories.
--
-- /Occurs only for an object inside the watched directory/
--
-- /Pre-release/
--
isModified :: Event -> Bool
isModified :: Event -> Bool
isModified = Word32 -> Event -> Bool
getFlag Word32
iN_MODIFY

-------------------------------------------------------------------------------
-- Information about path type (applicable only when 'setFileEvents' is 'On')
-------------------------------------------------------------------------------

foreign import capi
    "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32

-- | Determine whether the event is for a directory path.
--
-- /Pre-release/
--
isDir :: Event -> Bool
isDir :: Event -> Bool
isDir = Word32 -> Event -> Bool
getFlag Word32
iN_ISDIR

-------------------------------------------------------------------------------
-- Debugging
-------------------------------------------------------------------------------

-- | Convert an 'Event' record to a String representation.
showEvent :: Event -> String
showEvent :: Event -> String
showEvent ev :: Event
ev@Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} =
       String
"--------------------------"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nWd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
eventWd
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nRoot = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString (Array Word8 -> String) -> Array Word8 -> String
forall a b. (a -> b) -> a -> b
$ Event -> Array Word8
getRoot Event
ev)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nPath = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString (Array Word8 -> String) -> Array Word8 -> String
forall a b. (a -> b) -> a -> b
$ Event -> Array Word8
getRelPath Event
ev)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nCookie = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cookie -> String
forall a. Show a => a -> String
show (Event -> Cookie
getCookie Event
ev)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nFlags " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
eventFlags

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isEventsLost String
"Overflow"

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnwatched String
"RootUnwatched"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootDeleted String
"RootDeleted"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootMoved String
"RootMoved"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnmounted String
"RootUnmounted"

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAttrsModified String
"AttrsModified"

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAccessed String
"Accessed"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isOpened String
"Opened"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isWriteClosed String
"WriteClosed"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isNonWriteClosed String
"NonWriteClosed"

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isCreated String
"Created"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDeleted String
"Deleted"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isModified String
"Modified"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedFrom String
"MovedFrom"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedTo String
"MovedTo"

    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDir String
"Dir"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

        where showev :: (Event -> Bool) -> ShowS
showev Event -> Bool
f String
str = if Event -> Bool
f Event
ev then String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str else String
""
#else
#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
module Streamly.Internal.FileSystem.Event.Linux () where
#endif