--
-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
--

module System.FSNotify.Listener
       ( debounce
       , epsilonDefault
       , FileListener(..)
       , StopListening
       , newDebouncePayload
       ) where

import Data.IORef (newIORef)
import Data.Time (diffUTCTime, NominalDiffTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Prelude hiding (FilePath)
import System.FSNotify.Types
import System.FilePath

-- | An action that cancels a watching/listening job
type StopListening = IO ()

-- | A typeclass that imposes structure on watch managers capable of listening
-- for events, or simulated listening for events.
class FileListener sessionType where
  -- | Initialize a file listener instance.
  initSession :: IO (Maybe sessionType) -- ^ Just an initialized file listener,
                                        --   or Nothing if this file listener
                                        --   cannot be supported.

  -- | Kill a file listener instance.
  -- This will immediately stop acting on events for all directories being
  -- watched.
  killSession :: sessionType -> IO ()

  -- | Listen for file events associated with the immediate contents of a directory.
  -- Listening for events associated with immediate contents of a directory will
  -- only report events associated with files within the specified directory, and
  -- not files within its subdirectories.
  listen :: WatchConfig -> sessionType -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening

  -- | Listen for file events associated with all the contents of a directory.
  -- Listening for events associated with all the contents of a directory will
  -- report events associated with files within the specified directory and its
  -- subdirectories.
  listenRecursive :: WatchConfig -> sessionType -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening

  -- | Does this manager use polling?
  usesPolling :: sessionType -> Bool

-- | The default maximum difference (exclusive, in seconds) for two
-- events to be considered as occuring "at the same time".
epsilonDefault :: NominalDiffTime
epsilonDefault :: NominalDiffTime
epsilonDefault = NominalDiffTime
0.001

-- | The default event that provides a basis for comparison.
eventDefault :: Event
eventDefault :: Event
eventDefault = FilePath -> UTCTime -> Bool -> Event
Added FilePath
"" (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
0) Bool
False

-- | A predicate indicating whether two events may be considered "the same
-- event". This predicate is applied to the most recent dispatched event and
-- the current event after the client-specified ActionPredicate is applied,
-- before the event is dispatched.
debounce :: NominalDiffTime -> Event -> Event -> Bool
debounce :: NominalDiffTime -> Event -> Event -> Bool
debounce NominalDiffTime
epsilon Event
e1 Event
e2 =
  Event -> FilePath
eventPath Event
e1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Event -> FilePath
eventPath Event
e2 Bool -> Bool -> Bool
&& NominalDiffTime
timeDiff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> -NominalDiffTime
epsilon Bool -> Bool -> Bool
&& NominalDiffTime
timeDiff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
epsilon
  where
    timeDiff :: NominalDiffTime
timeDiff = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (Event -> UTCTime
eventTime Event
e2) (Event -> UTCTime
eventTime Event
e1)

-- | Produces a fresh data payload used for debouncing events in a
-- handler.
newDebouncePayload :: Debounce -> IO DebouncePayload
newDebouncePayload :: Debounce -> IO DebouncePayload
newDebouncePayload Debounce
DebounceDefault    = Event -> IO (IORef Event)
forall a. a -> IO (IORef a)
newIORef Event
eventDefault IO (IORef Event)
-> (IORef Event -> IO DebouncePayload) -> IO DebouncePayload
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DebouncePayload -> IO DebouncePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (DebouncePayload -> IO DebouncePayload)
-> (IORef Event -> DebouncePayload)
-> IORef Event
-> IO DebouncePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebounceData -> DebouncePayload
forall a. a -> Maybe a
Just (DebounceData -> DebouncePayload)
-> (IORef Event -> DebounceData) -> IORef Event -> DebouncePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> IORef Event -> DebounceData
DebounceData NominalDiffTime
epsilonDefault
newDebouncePayload (Debounce NominalDiffTime
epsilon) = Event -> IO (IORef Event)
forall a. a -> IO (IORef a)
newIORef Event
eventDefault IO (IORef Event)
-> (IORef Event -> IO DebouncePayload) -> IO DebouncePayload
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DebouncePayload -> IO DebouncePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (DebouncePayload -> IO DebouncePayload)
-> (IORef Event -> DebouncePayload)
-> IORef Event
-> IO DebouncePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebounceData -> DebouncePayload
forall a. a -> Maybe a
Just (DebounceData -> DebouncePayload)
-> (IORef Event -> DebounceData) -> IORef Event -> DebouncePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> IORef Event -> DebounceData
DebounceData NominalDiffTime
epsilon
newDebouncePayload Debounce
NoDebounce         = DebouncePayload -> IO DebouncePayload
forall (m :: * -> *) a. Monad m => a -> m a
return DebouncePayload
forall a. Maybe a
Nothing