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

module System.FSNotify.Polling (
  createPollManager
  , PollManager(..)
  , FileListener(..)
  ) where

import Control.Concurrent
import Control.Exception.Safe
import Control.Monad (forM_)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX
import Prelude hiding (FilePath)
import System.Directory (doesDirectoryExist)
import System.FSNotify.Listener
import System.FSNotify.Path (findFilesAndDirs, canonicalizeDirPath)
import System.FSNotify.Types
import System.FilePath
import System.PosixCompat.Files
import System.PosixCompat.Types


data EventType = AddedEvent
               | ModifiedEvent
               | RemovedEvent

newtype WatchKey = WatchKey ThreadId deriving (WatchKey -> WatchKey -> Bool
(WatchKey -> WatchKey -> Bool)
-> (WatchKey -> WatchKey -> Bool) -> Eq WatchKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WatchKey -> WatchKey -> Bool
== :: WatchKey -> WatchKey -> Bool
$c/= :: WatchKey -> WatchKey -> Bool
/= :: WatchKey -> WatchKey -> Bool
Eq, Eq WatchKey
Eq WatchKey =>
(WatchKey -> WatchKey -> Ordering)
-> (WatchKey -> WatchKey -> Bool)
-> (WatchKey -> WatchKey -> Bool)
-> (WatchKey -> WatchKey -> Bool)
-> (WatchKey -> WatchKey -> Bool)
-> (WatchKey -> WatchKey -> WatchKey)
-> (WatchKey -> WatchKey -> WatchKey)
-> Ord WatchKey
WatchKey -> WatchKey -> Bool
WatchKey -> WatchKey -> Ordering
WatchKey -> WatchKey -> WatchKey
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
$ccompare :: WatchKey -> WatchKey -> Ordering
compare :: WatchKey -> WatchKey -> Ordering
$c< :: WatchKey -> WatchKey -> Bool
< :: WatchKey -> WatchKey -> Bool
$c<= :: WatchKey -> WatchKey -> Bool
<= :: WatchKey -> WatchKey -> Bool
$c> :: WatchKey -> WatchKey -> Bool
> :: WatchKey -> WatchKey -> Bool
$c>= :: WatchKey -> WatchKey -> Bool
>= :: WatchKey -> WatchKey -> Bool
$cmax :: WatchKey -> WatchKey -> WatchKey
max :: WatchKey -> WatchKey -> WatchKey
$cmin :: WatchKey -> WatchKey -> WatchKey
min :: WatchKey -> WatchKey -> WatchKey
Ord)
data WatchData = WatchData FilePath EventCallback
type WatchMap = Map WatchKey WatchData
data PollManager = PollManager {
  PollManager -> MVar WatchMap
pollManagerWatchMap :: MVar WatchMap
  , PollManager -> Int
pollManagerInterval :: Int
  }

generateEvent :: UTCTime -> EventIsDirectory -> EventType -> FilePath -> Maybe Event
generateEvent :: UTCTime -> EventIsDirectory -> EventType -> FilePath -> Maybe Event
generateEvent UTCTime
timestamp EventIsDirectory
isDir EventType
AddedEvent FilePath
filePath = Event -> Maybe Event
forall a. a -> Maybe a
Just (FilePath -> UTCTime -> EventIsDirectory -> Event
Added FilePath
filePath UTCTime
timestamp EventIsDirectory
isDir)
generateEvent UTCTime
timestamp EventIsDirectory
isDir EventType
ModifiedEvent FilePath
filePath = Event -> Maybe Event
forall a. a -> Maybe a
Just (FilePath -> UTCTime -> EventIsDirectory -> Event
Modified FilePath
filePath UTCTime
timestamp EventIsDirectory
isDir)
generateEvent UTCTime
timestamp EventIsDirectory
isDir EventType
RemovedEvent FilePath
filePath = Event -> Maybe Event
forall a. a -> Maybe a
Just (FilePath -> UTCTime -> EventIsDirectory -> Event
Removed FilePath
filePath UTCTime
timestamp EventIsDirectory
isDir)

generateEvents :: UTCTime -> EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents :: UTCTime -> EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents UTCTime
timestamp EventType
eventType = ((FilePath, EventIsDirectory) -> Maybe Event)
-> [(FilePath, EventIsDirectory)] -> [Event]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(FilePath
path, EventIsDirectory
isDir) -> UTCTime -> EventIsDirectory -> EventType -> FilePath -> Maybe Event
generateEvent UTCTime
timestamp EventIsDirectory
isDir EventType
eventType FilePath
path)

-- | Do not return modified events for directories.
-- These can arise when files are created inside subdirectories, resulting in the modification time
-- of the directory being bumped. However, to increase consistency with the other FileListeners,
-- we ignore these events.
handleEvent :: EventCallback -> ActionPredicate -> Event -> IO ()
handleEvent :: EventCallback -> ActionPredicate -> EventCallback
handleEvent EventCallback
_ ActionPredicate
_ (Modified FilePath
_ UTCTime
_ EventIsDirectory
IsDirectory) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleEvent EventCallback
callback ActionPredicate
actPred Event
event
  | ActionPredicate
actPred Event
event = EventCallback
callback Event
event
  | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pathModMap :: Bool -> FilePath -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap :: Bool -> FilePath -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap Bool
recursive FilePath
path = Bool -> FilePath -> IO [FilePath]
findFilesAndDirs Bool
recursive FilePath
path IO [FilePath]
-> ([FilePath] -> IO (Map FilePath (UTCTime, EventIsDirectory)))
-> IO (Map FilePath (UTCTime, EventIsDirectory))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap'
  where
    pathModMap' :: [FilePath] -> IO (Map FilePath (UTCTime, EventIsDirectory))
    pathModMap' :: [FilePath] -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap' [FilePath]
files = ([(FilePath, (UTCTime, EventIsDirectory))]
-> Map FilePath (UTCTime, EventIsDirectory)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FilePath, (UTCTime, EventIsDirectory))]
 -> Map FilePath (UTCTime, EventIsDirectory))
-> ([Maybe (FilePath, (UTCTime, EventIsDirectory))]
    -> [(FilePath, (UTCTime, EventIsDirectory))])
-> [Maybe (FilePath, (UTCTime, EventIsDirectory))]
-> Map FilePath (UTCTime, EventIsDirectory)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (FilePath, (UTCTime, EventIsDirectory))]
-> [(FilePath, (UTCTime, EventIsDirectory))]
forall a. [Maybe a] -> [a]
catMaybes) ([Maybe (FilePath, (UTCTime, EventIsDirectory))]
 -> Map FilePath (UTCTime, EventIsDirectory))
-> IO [Maybe (FilePath, (UTCTime, EventIsDirectory))]
-> IO (Map FilePath (UTCTime, EventIsDirectory))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory))))
-> [FilePath] -> IO [Maybe (FilePath, (UTCTime, EventIsDirectory))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
pathAndInfo [FilePath]
files

    pathAndInfo :: FilePath -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
    pathAndInfo :: FilePath -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
pathAndInfo FilePath
p = (IOException -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory))))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(IOException
_ :: IOException) -> Maybe (FilePath, (UTCTime, EventIsDirectory))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, (UTCTime, EventIsDirectory))
forall a. Maybe a
Nothing) (IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
 -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory))))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
modTime <- FilePath -> IO UTCTime
getModificationTime FilePath
p
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
p
      Maybe (FilePath, (UTCTime, EventIsDirectory))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FilePath, (UTCTime, EventIsDirectory))
 -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory))))
-> Maybe (FilePath, (UTCTime, EventIsDirectory))
-> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
forall a b. (a -> b) -> a -> b
$ (FilePath, (UTCTime, EventIsDirectory))
-> Maybe (FilePath, (UTCTime, EventIsDirectory))
forall a. a -> Maybe a
Just (FilePath
p, (UTCTime
modTime, if Bool
isDir then EventIsDirectory
IsDirectory else EventIsDirectory
IsFile))

pollPath :: Int -> Bool -> EventCallback -> FilePath -> ActionPredicate -> Map FilePath (UTCTime, EventIsDirectory) -> IO ()
pollPath :: Int
-> Bool
-> EventCallback
-> FilePath
-> ActionPredicate
-> Map FilePath (UTCTime, EventIsDirectory)
-> IO ()
pollPath Int
interval Bool
recursive EventCallback
callback FilePath
filePath ActionPredicate
actPred Map FilePath (UTCTime, EventIsDirectory)
oldPathMap = do
  Int -> IO ()
threadDelay Int
interval
  Maybe (Map FilePath (UTCTime, EventIsDirectory))
maybeNewPathMap <- (IOException
 -> IO (Maybe (Map FilePath (UTCTime, EventIsDirectory))))
-> IO (Maybe (Map FilePath (UTCTime, EventIsDirectory)))
-> IO (Maybe (Map FilePath (UTCTime, EventIsDirectory)))
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(IOException
_ :: IOException) -> Maybe (Map FilePath (UTCTime, EventIsDirectory))
-> IO (Maybe (Map FilePath (UTCTime, EventIsDirectory)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map FilePath (UTCTime, EventIsDirectory))
forall a. Maybe a
Nothing) (Map FilePath (UTCTime, EventIsDirectory)
-> Maybe (Map FilePath (UTCTime, EventIsDirectory))
forall a. a -> Maybe a
Just (Map FilePath (UTCTime, EventIsDirectory)
 -> Maybe (Map FilePath (UTCTime, EventIsDirectory)))
-> IO (Map FilePath (UTCTime, EventIsDirectory))
-> IO (Maybe (Map FilePath (UTCTime, EventIsDirectory)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> FilePath -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap Bool
recursive FilePath
filePath)
  case Maybe (Map FilePath (UTCTime, EventIsDirectory))
maybeNewPathMap of
    -- Something went wrong while listing directories; we'll try again on the next poll
    Maybe (Map FilePath (UTCTime, EventIsDirectory))
Nothing -> Int
-> Bool
-> EventCallback
-> FilePath
-> ActionPredicate
-> Map FilePath (UTCTime, EventIsDirectory)
-> IO ()
pollPath Int
interval Bool
recursive EventCallback
callback FilePath
filePath ActionPredicate
actPred Map FilePath (UTCTime, EventIsDirectory)
oldPathMap

    Just Map FilePath (UTCTime, EventIsDirectory)
newPathMap -> do
      UTCTime
currentTime <- IO UTCTime
getCurrentTime
      let deletedMap :: Map FilePath (UTCTime, EventIsDirectory)
deletedMap = Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map FilePath (UTCTime, EventIsDirectory)
oldPathMap Map FilePath (UTCTime, EventIsDirectory)
newPathMap
          createdMap :: Map FilePath (UTCTime, EventIsDirectory)
createdMap = Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map FilePath (UTCTime, EventIsDirectory)
newPathMap Map FilePath (UTCTime, EventIsDirectory)
oldPathMap
          modifiedAndCreatedMap :: Map FilePath (UTCTime, EventIsDirectory)
modifiedAndCreatedMap = ((UTCTime, EventIsDirectory)
 -> (UTCTime, EventIsDirectory)
 -> Maybe (UTCTime, EventIsDirectory))
-> Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (UTCTime, EventIsDirectory)
-> (UTCTime, EventIsDirectory) -> Maybe (UTCTime, EventIsDirectory)
modifiedDifference Map FilePath (UTCTime, EventIsDirectory)
newPathMap Map FilePath (UTCTime, EventIsDirectory)
oldPathMap
          modifiedMap :: Map FilePath (UTCTime, EventIsDirectory)
modifiedMap = Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
-> Map FilePath (UTCTime, EventIsDirectory)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map FilePath (UTCTime, EventIsDirectory)
modifiedAndCreatedMap Map FilePath (UTCTime, EventIsDirectory)
createdMap
          generateEvents' :: EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents' = UTCTime -> EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents UTCTime
currentTime

      [Event] -> IO ()
handleEvents ([Event] -> IO ()) -> [Event] -> IO ()
forall a b. (a -> b) -> a -> b
$ EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents' EventType
AddedEvent [(FilePath
path, EventIsDirectory
isDir) | (FilePath
path, (UTCTime
_, EventIsDirectory
isDir)) <- Map FilePath (UTCTime, EventIsDirectory)
-> [(FilePath, (UTCTime, EventIsDirectory))]
forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath (UTCTime, EventIsDirectory)
createdMap]
      [Event] -> IO ()
handleEvents ([Event] -> IO ()) -> [Event] -> IO ()
forall a b. (a -> b) -> a -> b
$ EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents' EventType
ModifiedEvent [(FilePath
path, EventIsDirectory
isDir) | (FilePath
path, (UTCTime
_, EventIsDirectory
isDir)) <- Map FilePath (UTCTime, EventIsDirectory)
-> [(FilePath, (UTCTime, EventIsDirectory))]
forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath (UTCTime, EventIsDirectory)
modifiedMap]
      [Event] -> IO ()
handleEvents ([Event] -> IO ()) -> [Event] -> IO ()
forall a b. (a -> b) -> a -> b
$ EventType -> [(FilePath, EventIsDirectory)] -> [Event]
generateEvents' EventType
RemovedEvent [(FilePath
path, EventIsDirectory
isDir) | (FilePath
path, (UTCTime
_, EventIsDirectory
isDir)) <- Map FilePath (UTCTime, EventIsDirectory)
-> [(FilePath, (UTCTime, EventIsDirectory))]
forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath (UTCTime, EventIsDirectory)
deletedMap]

      Int
-> Bool
-> EventCallback
-> FilePath
-> ActionPredicate
-> Map FilePath (UTCTime, EventIsDirectory)
-> IO ()
pollPath Int
interval Bool
recursive EventCallback
callback FilePath
filePath ActionPredicate
actPred Map FilePath (UTCTime, EventIsDirectory)
newPathMap

  where
    modifiedDifference :: (UTCTime, EventIsDirectory) -> (UTCTime, EventIsDirectory) -> Maybe (UTCTime, EventIsDirectory)
    modifiedDifference :: (UTCTime, EventIsDirectory)
-> (UTCTime, EventIsDirectory) -> Maybe (UTCTime, EventIsDirectory)
modifiedDifference (UTCTime
newTime, EventIsDirectory
isDir1) (UTCTime
oldTime, EventIsDirectory
isDir2)
      | UTCTime
oldTime UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
/= UTCTime
newTime Bool -> Bool -> Bool
|| EventIsDirectory
isDir1 EventIsDirectory -> EventIsDirectory -> Bool
forall a. Eq a => a -> a -> Bool
/= EventIsDirectory
isDir2 = (UTCTime, EventIsDirectory) -> Maybe (UTCTime, EventIsDirectory)
forall a. a -> Maybe a
Just (UTCTime
newTime, EventIsDirectory
isDir1)
      | Bool
otherwise = Maybe (UTCTime, EventIsDirectory)
forall a. Maybe a
Nothing

    handleEvents :: [Event] -> IO ()
    handleEvents :: [Event] -> IO ()
handleEvents = EventCallback -> [Event] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventCallback -> ActionPredicate -> EventCallback
handleEvent EventCallback
callback ActionPredicate
actPred)


-- Additional init function exported to allow startManager to unconditionally
-- create a poll manager as a fallback when other managers will not instantiate.
createPollManager :: Int -> IO PollManager
createPollManager :: Int -> IO PollManager
createPollManager Int
interval  = MVar WatchMap -> Int -> PollManager
PollManager (MVar WatchMap -> Int -> PollManager)
-> IO (MVar WatchMap) -> IO (Int -> PollManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WatchMap -> IO (MVar WatchMap)
forall a. a -> IO (MVar a)
newMVar WatchMap
forall k a. Map k a
Map.empty IO (Int -> PollManager) -> IO Int -> IO PollManager
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
interval

killWatchingThread :: WatchKey -> IO ()
killWatchingThread :: WatchKey -> IO ()
killWatchingThread (WatchKey ThreadId
threadId) = ThreadId -> IO ()
killThread ThreadId
threadId

killAndUnregister :: MVar WatchMap -> WatchKey -> IO ()
killAndUnregister :: MVar WatchMap -> WatchKey -> IO ()
killAndUnregister MVar WatchMap
mvarMap WatchKey
wk = do
  WatchMap
_ <- MVar WatchMap -> (WatchMap -> IO WatchMap) -> IO WatchMap
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar WatchMap
mvarMap ((WatchMap -> IO WatchMap) -> IO WatchMap)
-> (WatchMap -> IO WatchMap) -> IO WatchMap
forall a b. (a -> b) -> a -> b
$ \WatchMap
m -> do
    WatchKey -> IO ()
killWatchingThread WatchKey
wk
    WatchMap -> IO WatchMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WatchMap -> IO WatchMap) -> WatchMap -> IO WatchMap
forall a b. (a -> b) -> a -> b
$ WatchKey -> WatchMap -> WatchMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete WatchKey
wk WatchMap
m
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

listen' :: Bool -> WatchConfig -> PollManager -> FilePath -> ActionPredicate -> EventCallback -> IO (IO ())
listen' :: Bool
-> WatchConfig
-> PollManager
-> FilePath
-> ActionPredicate
-> EventCallback
-> IO (IO ())
listen' Bool
isRecursive WatchConfig
_conf (PollManager MVar WatchMap
mvarMap Int
interval) FilePath
path ActionPredicate
actPred EventCallback
callback = do
  FilePath
path' <- FilePath -> IO FilePath
canonicalizeDirPath FilePath
path
  Map FilePath (UTCTime, EventIsDirectory)
pmMap <- Bool -> FilePath -> IO (Map FilePath (UTCTime, EventIsDirectory))
pathModMap Bool
isRecursive FilePath
path'
  ThreadId
threadId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Int
-> Bool
-> EventCallback
-> FilePath
-> ActionPredicate
-> Map FilePath (UTCTime, EventIsDirectory)
-> IO ()
pollPath Int
interval Bool
isRecursive EventCallback
callback FilePath
path' ActionPredicate
actPred Map FilePath (UTCTime, EventIsDirectory)
pmMap
  let wk :: WatchKey
wk = ThreadId -> WatchKey
WatchKey ThreadId
threadId
  MVar WatchMap -> (WatchMap -> IO WatchMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar WatchMap
mvarMap ((WatchMap -> IO WatchMap) -> IO ())
-> (WatchMap -> IO WatchMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ WatchMap -> IO WatchMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WatchMap -> IO WatchMap)
-> (WatchMap -> WatchMap) -> WatchMap -> IO WatchMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchKey -> WatchData -> WatchMap -> WatchMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WatchKey
wk (FilePath -> EventCallback -> WatchData
WatchData FilePath
path' EventCallback
callback)
  IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ MVar WatchMap -> WatchKey -> IO ()
killAndUnregister MVar WatchMap
mvarMap WatchKey
wk


instance FileListener PollManager Int where
  initSession :: Int -> IO (Either Text PollManager)
initSession Int
interval = PollManager -> Either Text PollManager
forall a b. b -> Either a b
Right (PollManager -> Either Text PollManager)
-> IO PollManager -> IO (Either Text PollManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO PollManager
createPollManager Int
interval

  killSession :: PollManager -> IO ()
killSession (PollManager MVar WatchMap
mvarMap Int
_) = do
    WatchMap
watchMap <- MVar WatchMap -> IO WatchMap
forall a. MVar a -> IO a
readMVar MVar WatchMap
mvarMap
    [WatchKey] -> (WatchKey -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (WatchMap -> [WatchKey]
forall k a. Map k a -> [k]
Map.keys WatchMap
watchMap) WatchKey -> IO ()
killWatchingThread

  listen :: ListenFn PollManager Int
listen = Bool
-> WatchConfig
-> PollManager
-> FilePath
-> ActionPredicate
-> EventCallback
-> IO (IO ())
listen' Bool
False

  listenRecursive :: ListenFn PollManager Int
listenRecursive = Bool
-> WatchConfig
-> PollManager
-> FilePath
-> ActionPredicate
-> EventCallback
-> IO (IO ())
listen' Bool
True

getModificationTime :: FilePath -> IO UTCTime
getModificationTime :: FilePath -> IO UTCTime
getModificationTime FilePath
p = EpochTime -> UTCTime
fromEpoch (EpochTime -> UTCTime)
-> (FileStatus -> EpochTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
modificationTime (FileStatus -> UTCTime) -> IO FileStatus -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
p

fromEpoch :: EpochTime -> UTCTime
fromEpoch :: EpochTime -> UTCTime
fromEpoch = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (EpochTime -> POSIXTime) -> EpochTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac