--
-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module System.FSNotify.Linux (
  FileListener(..)
  , NativeManager
  ) where

import Control.Concurrent.MVar
import Control.Exception.Safe as E
import Control.Monad
import qualified Data.ByteString as BS
import Data.Function
import Data.Monoid
import Data.String
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX
import qualified GHC.Foreign as F
import GHC.IO.Encoding (getFileSystemEncoding)
import Prelude hiding (FilePath)
import System.Directory (canonicalizePath)
import System.FSNotify.Find
import System.FSNotify.Listener
import System.FSNotify.Types
import System.FilePath (FilePath, (</>))
import qualified System.INotify as INo
import System.Posix.ByteString (RawFilePath)
import System.Posix.Directory.ByteString (openDirStream, readDirStream, closeDirStream)
import System.Posix.Files (getFileStatus, isDirectory, modificationTimeHiRes)


data INotifyListener = INotifyListener { INotifyListener -> INotify
listenerINotify :: INo.INotify }

type NativeManager = INotifyListener

data EventVarietyMismatchException = EventVarietyMismatchException deriving (Int -> EventVarietyMismatchException -> ShowS
[EventVarietyMismatchException] -> ShowS
EventVarietyMismatchException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventVarietyMismatchException] -> ShowS
$cshowList :: [EventVarietyMismatchException] -> ShowS
show :: EventVarietyMismatchException -> String
$cshow :: EventVarietyMismatchException -> String
showsPrec :: Int -> EventVarietyMismatchException -> ShowS
$cshowsPrec :: Int -> EventVarietyMismatchException -> ShowS
Show, Typeable)
instance Exception EventVarietyMismatchException


fsnEvents :: RawFilePath -> UTCTime -> INo.Event -> IO [Event]
fsnEvents :: RawFilePath -> UTCTime -> Event -> IO [Event]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.Attributes (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) (Just RawFilePath
raw)) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
ModifiedAttributes (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.Modified (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) (Just RawFilePath
raw)) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
Modified (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.Closed (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) (Just RawFilePath
raw) Bool
True) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
CloseWrite (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.Created (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) RawFilePath
raw) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
Added (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.MovedOut (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) RawFilePath
raw Cookie
_cookie) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
Removed (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.MovedIn (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) RawFilePath
raw Cookie
_cookie) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
Added (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp (INo.Deleted (Bool -> EventIsDirectory
boolToIsDirectory -> EventIsDirectory
isDir) RawFilePath
raw) = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  RawFilePath -> IO String
fromHinotifyPath RawFilePath
raw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
name -> forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
Removed (String
basePath String -> ShowS
</> String
name) UTCTime
timestamp EventIsDirectory
isDir]
fsnEvents RawFilePath
basePath' UTCTime
timestamp Event
INo.DeletedSelf = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> Event
WatchedDirectoryRemoved String
basePath UTCTime
timestamp EventIsDirectory
IsDirectory]
fsnEvents RawFilePath
_ UTCTime
_ Event
INo.Ignored = forall (m :: * -> *) a. Monad m => a -> m a
return []
fsnEvents RawFilePath
basePath' UTCTime
timestamp Event
inoEvent = do
  String
basePath <- RawFilePath -> IO String
fromRawFilePath RawFilePath
basePath'
  forall (m :: * -> *) a. Monad m => a -> m a
return [String -> UTCTime -> EventIsDirectory -> String -> Event
Unknown String
basePath UTCTime
timestamp EventIsDirectory
IsFile (forall a. Show a => a -> String
show Event
inoEvent)]

handleInoEvent :: ActionPredicate -> EventCallback -> RawFilePath -> MVar Bool -> INo.Event -> IO ()
handleInoEvent :: ActionPredicate
-> EventCallback -> RawFilePath -> MVar Bool -> Event -> IO ()
handleInoEvent ActionPredicate
actPred EventCallback
callback RawFilePath
basePath MVar Bool
watchStillExistsVar Event
inoEvent = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event
INo.DeletedSelf forall a. Eq a => a -> a -> Bool
== Event
inoEvent) forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
watchStillExistsVar forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  UTCTime
currentTime <- IO UTCTime
getCurrentTime
  [Event]
events <- RawFilePath -> UTCTime -> Event -> IO [Event]
fsnEvents RawFilePath
basePath UTCTime
currentTime Event
inoEvent
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Event]
events forall a b. (a -> b) -> a -> b
$ \Event
event -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActionPredicate
actPred Event
event) forall a b. (a -> b) -> a -> b
$ EventCallback
callback Event
event

varieties :: [INo.EventVariety]
varieties :: [EventVariety]
varieties = [EventVariety
INo.Create, EventVariety
INo.Delete, EventVariety
INo.MoveIn, EventVariety
INo.MoveOut, EventVariety
INo.Attrib, EventVariety
INo.Modify, EventVariety
INo.CloseWrite, EventVariety
INo.DeleteSelf]

instance FileListener INotifyListener () where
  initSession :: () -> IO (Either Text INotifyListener)
initSession ()
_ = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (\(IOException
e :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show IOException
e) forall a b. (a -> b) -> a -> b
$ do
    INotify
inotify <- IO INotify
INo.initINotify
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ INotify -> INotifyListener
INotifyListener INotify
inotify

  killSession :: INotifyListener -> IO ()
killSession (INotifyListener {INotify
listenerINotify :: INotify
listenerINotify :: INotifyListener -> INotify
listenerINotify}) = INotify -> IO ()
INo.killINotify INotify
listenerINotify

  listen :: ListenFn INotifyListener ()
listen WatchConfig
_conf (INotifyListener {INotify
listenerINotify :: INotify
listenerINotify :: INotifyListener -> INotify
listenerINotify}) String
path ActionPredicate
actPred EventCallback
callback = do
    RawFilePath
rawPath <- String -> IO RawFilePath
toRawFilePath String
path
    RawFilePath
canonicalRawPath <- RawFilePath -> IO RawFilePath
canonicalizeRawDirPath RawFilePath
rawPath
    MVar Bool
watchStillExistsVar <- forall a. a -> IO (MVar a)
newMVar Bool
True
    RawFilePath
hinotifyPath <- RawFilePath -> IO RawFilePath
rawToHinotifyPath RawFilePath
canonicalRawPath
    WatchDescriptor
wd <- INotify
-> [EventVariety]
-> RawFilePath
-> (Event -> IO ())
-> IO WatchDescriptor
INo.addWatch INotify
listenerINotify [EventVariety]
varieties RawFilePath
hinotifyPath (ActionPredicate
-> EventCallback -> RawFilePath -> MVar Bool -> Event -> IO ()
handleInoEvent ActionPredicate
actPred EventCallback
callback RawFilePath
canonicalRawPath MVar Bool
watchStillExistsVar)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
watchStillExistsVar forall a b. (a -> b) -> a -> b
$ \Bool
wse -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wse forall a b. (a -> b) -> a -> b
$ WatchDescriptor -> IO ()
INo.removeWatch WatchDescriptor
wd
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  listenRecursive :: ListenFn INotifyListener ()
listenRecursive WatchConfig
_conf INotifyListener
listener String
initialPath ActionPredicate
actPred EventCallback
callback = do
    -- wdVar stores the list of created watch descriptors. We use it to
    -- cancel the whole recursive listening task.
    --
    -- To avoid a race condition (when a new watch is added right after
    -- we've stopped listening), we replace the MVar contents with Nothing
    -- to signify that the listening task is cancelled, and no new watches
    -- should be added.
    MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar <- forall a. a -> IO (MVar a)
newMVar (forall a. a -> Maybe a
Just [])

    let
      removeWatches :: t (WatchDescriptor, MVar Bool) -> IO ()
removeWatches t (WatchDescriptor, MVar Bool)
wds = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (WatchDescriptor, MVar Bool)
wds forall a b. (a -> b) -> a -> b
$ \(WatchDescriptor
wd, MVar Bool
watchStillExistsVar) ->
        forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
watchStillExistsVar forall a b. (a -> b) -> a -> b
$ \Bool
wse -> do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wse forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(SomeException
e :: SomeException) -> String -> IO ()
putStrLn (String
"Error removing watch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show WatchDescriptor
wd forall a. Semigroup a => a -> a -> a
<> String
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SomeException
e forall a. Semigroup a => a -> a -> a
<> String
")"))
                   (WatchDescriptor -> IO ()
INo.removeWatch WatchDescriptor
wd)
          forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

      stopListening :: IO ()
stopListening = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar forall a b. (a -> b) -> a -> b
$ \Maybe [(WatchDescriptor, MVar Bool)]
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall {t :: * -> *}.
Foldable t =>
t (WatchDescriptor, MVar Bool) -> IO ()
removeWatches Maybe [(WatchDescriptor, MVar Bool)]
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    -- Add watches to this directory plus every sub-directory
    RawFilePath
rawInitialPath <- String -> IO RawFilePath
toRawFilePath String
initialPath
    RawFilePath
rawCanonicalInitialPath <- RawFilePath -> IO RawFilePath
canonicalizeRawDirPath RawFilePath
rawInitialPath
    INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> ActionPredicate
-> EventCallback
-> Bool
-> RawFilePath
-> IO ()
watchDirectoryRecursively INotifyListener
listener MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar ActionPredicate
actPred EventCallback
callback Bool
True RawFilePath
rawCanonicalInitialPath
    RawFilePath -> (RawFilePath -> IO ()) -> IO ()
traverseAllDirs RawFilePath
rawCanonicalInitialPath forall a b. (a -> b) -> a -> b
$ \RawFilePath
subPath ->
      INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> ActionPredicate
-> EventCallback
-> Bool
-> RawFilePath
-> IO ()
watchDirectoryRecursively INotifyListener
listener MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar ActionPredicate
actPred EventCallback
callback Bool
False RawFilePath
subPath

    forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
stopListening


type RecursiveWatches = MVar (Maybe [(INo.WatchDescriptor, MVar Bool)])

watchDirectoryRecursively :: INotifyListener -> RecursiveWatches -> ActionPredicate -> EventCallback -> Bool -> RawFilePath -> IO ()
watchDirectoryRecursively :: INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> ActionPredicate
-> EventCallback
-> Bool
-> RawFilePath
-> IO ()
watchDirectoryRecursively listener :: INotifyListener
listener@(INotifyListener {INotify
listenerINotify :: INotify
listenerINotify :: INotifyListener -> INotify
listenerINotify}) MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar ActionPredicate
actPred EventCallback
callback Bool
isRootWatchedDir RawFilePath
rawFilePath = do
  forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar forall a b. (a -> b) -> a -> b
$ \case
    Maybe [(WatchDescriptor, MVar Bool)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just [(WatchDescriptor, MVar Bool)]
wds -> do
      MVar Bool
watchStillExistsVar <- forall a. a -> IO (MVar a)
newMVar Bool
True
      RawFilePath
hinotifyPath <- RawFilePath -> IO RawFilePath
rawToHinotifyPath RawFilePath
rawFilePath
      WatchDescriptor
wd <- INotify
-> [EventVariety]
-> RawFilePath
-> (Event -> IO ())
-> IO WatchDescriptor
INo.addWatch INotify
listenerINotify [EventVariety]
varieties RawFilePath
hinotifyPath (RawFilePath
-> ActionPredicate
-> EventCallback
-> MVar Bool
-> Bool
-> INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> Event
-> IO ()
handleRecursiveEvent RawFilePath
rawFilePath ActionPredicate
actPred EventCallback
callback MVar Bool
watchStillExistsVar Bool
isRootWatchedDir INotifyListener
listener MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ((WatchDescriptor
wd, MVar Bool
watchStillExistsVar)forall a. a -> [a] -> [a]
:[(WatchDescriptor, MVar Bool)]
wds)


handleRecursiveEvent :: RawFilePath -> ActionPredicate -> EventCallback -> MVar Bool -> Bool -> INotifyListener -> RecursiveWatches -> INo.Event -> IO ()
handleRecursiveEvent :: RawFilePath
-> ActionPredicate
-> EventCallback
-> MVar Bool
-> Bool
-> INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> Event
-> IO ()
handleRecursiveEvent RawFilePath
baseDir ActionPredicate
actPred EventCallback
callback MVar Bool
watchStillExistsVar Bool
isRootWatchedDir INotifyListener
listener MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar Event
event = do
  case Event
event of
    (INo.Created Bool
True RawFilePath
hiNotifyPath) -> do
      -- A new directory was created, so add recursive inotify watches to it
      RawFilePath
rawDirPath <- RawFilePath -> IO RawFilePath
rawFromHinotifyPath RawFilePath
hiNotifyPath
      let newRawDir :: RawFilePath
newRawDir = RawFilePath
baseDir RawFilePath -> RawFilePath -> RawFilePath
<//> RawFilePath
rawDirPath
      POSIXTime
timestampBeforeAddingWatch <- IO POSIXTime
getPOSIXTime
      INotifyListener
-> MVar (Maybe [(WatchDescriptor, MVar Bool)])
-> ActionPredicate
-> EventCallback
-> Bool
-> RawFilePath
-> IO ()
watchDirectoryRecursively INotifyListener
listener MVar (Maybe [(WatchDescriptor, MVar Bool)])
wdVar ActionPredicate
actPred EventCallback
callback Bool
False RawFilePath
newRawDir

      String
newDir <- RawFilePath -> IO String
fromRawFilePath RawFilePath
newRawDir

      -- Find all files/folders that might have been created *after* the timestamp, and hence might have been
      -- missed by the watch
      -- TODO: there's a chance of this generating double events, fix
      [String]
files <- Bool -> String -> IO [String]
find Bool
False String
newDir -- TODO: expose the ability to set followSymlinks to True?
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files forall a b. (a -> b) -> a -> b
$ \String
newPath -> do
        FileStatus
fileStatus <- String -> IO FileStatus
getFileStatus String
newPath
        let modTime :: POSIXTime
modTime = FileStatus -> POSIXTime
modificationTimeHiRes FileStatus
fileStatus
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (POSIXTime
modTime forall a. Ord a => a -> a -> Bool
> POSIXTime
timestampBeforeAddingWatch) forall a b. (a -> b) -> a -> b
$ do
          let isDir :: EventIsDirectory
isDir = if FileStatus -> Bool
isDirectory FileStatus
fileStatus then EventIsDirectory
IsDirectory else EventIsDirectory
IsFile
          let addedEvent :: Event
addedEvent = (String -> UTCTime -> EventIsDirectory -> Event
Added (String
newDir String -> ShowS
</> String
newPath) (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
timestampBeforeAddingWatch) EventIsDirectory
isDir)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActionPredicate
actPred Event
addedEvent) forall a b. (a -> b) -> a -> b
$ EventCallback
callback Event
addedEvent

    Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- If the watched directory was removed, mark the watch as already removed
  case Event
event of
    Event
INo.DeletedSelf -> forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
watchStillExistsVar forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Forward the event. Ignore a DeletedSelf if we're not on the root directory,
  -- since the watch above us will pick up the delete of that directory.
  case Event
event of
    Event
INo.DeletedSelf | Bool -> Bool
not Bool
isRootWatchedDir -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Event
_ -> ActionPredicate
-> EventCallback -> RawFilePath -> MVar Bool -> Event -> IO ()
handleInoEvent ActionPredicate
actPred EventCallback
callback RawFilePath
baseDir MVar Bool
watchStillExistsVar Event
event



-- * Util

canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath
canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath
canonicalizeRawDirPath RawFilePath
p = RawFilePath -> IO String
fromRawFilePath RawFilePath
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
canonicalizePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO RawFilePath
toRawFilePath

-- | Same as </> but for RawFilePath
-- TODO: make sure this is correct or find in a library
(<//>) :: RawFilePath -> RawFilePath -> RawFilePath
RawFilePath
x <//> :: RawFilePath -> RawFilePath -> RawFilePath
<//> RawFilePath
y = RawFilePath
x forall a. Semigroup a => a -> a -> a
<> RawFilePath
"/" forall a. Semigroup a => a -> a -> a
<> RawFilePath
y

traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO ()
traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO ()
traverseAllDirs RawFilePath
dir RawFilePath -> IO ()
cb = RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
dir forall a b. (a -> b) -> a -> b
$ \RawFilePath
subPath ->
  -- TODO: wish we didn't need fromRawFilePath here
  -- TODO: make sure this does the right thing with symlinks
  RawFilePath -> IO String
fromRawFilePath RawFilePath
subPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO FileStatus
getFileStatus forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FileStatus -> Bool
isDirectory -> Bool
True) -> RawFilePath -> IO ()
cb RawFilePath
subPath forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    FileStatus
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
dir RawFilePath -> IO Bool
cb = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (RawFilePath -> IO DirStream
openDirStream RawFilePath
dir) DirStream -> IO ()
closeDirStream forall a b. (a -> b) -> a -> b
$ \DirStream
dirStream ->
  forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
loop -> do
    DirStream -> IO RawFilePath
readDirStream DirStream
dirStream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      RawFilePath
x | RawFilePath -> Bool
BS.null RawFilePath
x -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RawFilePath
"." -> IO ()
loop
      RawFilePath
".." -> IO ()
loop
      RawFilePath
subDir -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally IO ()
loop forall a b. (a -> b) -> a -> b
$ do
        -- TODO: canonicalize?
        let fullSubDir :: RawFilePath
fullSubDir = RawFilePath
dir RawFilePath -> RawFilePath -> RawFilePath
<//> RawFilePath
subDir
        Bool
shouldRecurse <- RawFilePath -> IO Bool
cb RawFilePath
fullSubDir
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldRecurse forall a b. (a -> b) -> a -> b
$ RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
traverseAll RawFilePath
fullSubDir RawFilePath -> IO Bool
cb

boolToIsDirectory :: Bool -> EventIsDirectory
boolToIsDirectory :: Bool -> EventIsDirectory
boolToIsDirectory Bool
False = EventIsDirectory
IsFile
boolToIsDirectory Bool
True = EventIsDirectory
IsDirectory

toRawFilePath :: FilePath -> IO BS.ByteString
toRawFilePath :: String -> IO RawFilePath
toRawFilePath String
fp = do
  TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
  forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
F.withCString TextEncoding
enc String
fp CString -> IO RawFilePath
BS.packCString

fromRawFilePath :: BS.ByteString -> IO FilePath
fromRawFilePath :: RawFilePath -> IO String
fromRawFilePath RawFilePath
bs = do
  TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
  forall a. RawFilePath -> (CString -> IO a) -> IO a
BS.useAsCString RawFilePath
bs (TextEncoding -> CString -> IO String
F.peekCString TextEncoding
enc)

#if MIN_VERSION_hinotify(0, 3, 10)
fromHinotifyPath :: BS.ByteString -> IO FilePath
fromHinotifyPath :: RawFilePath -> IO String
fromHinotifyPath = RawFilePath -> IO String
fromRawFilePath

rawToHinotifyPath :: BS.ByteString -> IO BS.ByteString
rawToHinotifyPath :: RawFilePath -> IO RawFilePath
rawToHinotifyPath = forall (m :: * -> *) a. Monad m => a -> m a
return

rawFromHinotifyPath :: BS.ByteString -> IO BS.ByteString
rawFromHinotifyPath :: RawFilePath -> IO RawFilePath
rawFromHinotifyPath = forall (m :: * -> *) a. Monad m => a -> m a
return
#else
fromHinotifyPath :: FilePath -> IO FilePath
fromHinotifyPath = return

rawToHinotifyPath :: BS.ByteString -> IO FilePath
rawToHinotifyPath = fromRawFilePath

rawFromHinotifyPath :: FilePath -> IO BS.ByteString
rawFromHinotifyPath = toRawFilePath
#endif