{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | An abstraction to help with re-running actions when files or other
-- input values they depend on have changed.
module Distribution.Client.FileMonitor
  ( -- * Declaring files to monitor
      module Distribution.Simple.FileMonitor.Types

    -- * Creating and checking sets of monitored files
  , FileMonitor (..)
  , newFileMonitor
  , MonitorChanged (..)
  , MonitorChangedReason (..)
  , checkFileMonitorChanged
  , updateFileMonitor
  , MonitorTimestamp
  , beginUpdateFileMonitor

    -- * Internal
  , MonitorStateFileSet
  , MonitorStateFile
  , MonitorStateGlob
  ) where

import Distribution.Client.Compat.Prelude
import qualified Distribution.Compat.Binary as Binary
import Prelude ()

import Data.Binary.Get (runGetOrFail)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map.Strict as Map

import Control.Exception
import Control.Monad
import Control.Monad.Except
  ( ExceptT
  , runExceptT
  , throwError
  , withExceptT
  )
import Control.Monad.State (StateT, mapStateT)
import qualified Control.Monad.State as State
import Control.Monad.Trans (MonadIO, liftIO)

import Distribution.Client.Glob
import Distribution.Client.HashValue
import Distribution.Client.Utils (MergeResult (..), mergeBy)
import Distribution.Compat.Time
import Distribution.Simple.FileMonitor.Types
import Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
import Distribution.Utils.Structured (Tag (..), structuredEncode)

import System.Directory
import System.FilePath
import System.IO

------------------------------------------------------------------------------
-- Implementation types, files status
--

-- | The state necessary to determine whether a set of monitored
-- files has changed.  It consists of two parts: a set of specific
-- files to be monitored (index by their path), and a list of
-- globs, which monitor may files at once.
data MonitorStateFileSet
  = MonitorStateFileSet
      ![MonitorStateFile]
      ![MonitorStateGlob]
  -- Morally this is not actually a set but a bag (represented by lists).
  -- There is no principled reason to use a bag here rather than a set, but
  -- there is also no particular gain either. That said, we do preserve the
  -- order of the lists just to reduce confusion (and have predictable I/O
  -- patterns).
  deriving (Int -> MonitorStateFileSet -> ShowS
[MonitorStateFileSet] -> ShowS
MonitorStateFileSet -> FilePath
(Int -> MonitorStateFileSet -> ShowS)
-> (MonitorStateFileSet -> FilePath)
-> ([MonitorStateFileSet] -> ShowS)
-> Show MonitorStateFileSet
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorStateFileSet -> ShowS
showsPrec :: Int -> MonitorStateFileSet -> ShowS
$cshow :: MonitorStateFileSet -> FilePath
show :: MonitorStateFileSet -> FilePath
$cshowList :: [MonitorStateFileSet] -> ShowS
showList :: [MonitorStateFileSet] -> ShowS
Show, (forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x)
-> (forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet)
-> Generic MonitorStateFileSet
forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
from :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
$cto :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
to :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
Generic)

instance Binary MonitorStateFileSet
instance Structured MonitorStateFileSet

-- | The state necessary to determine whether a monitored file has changed.
--
-- This covers all the cases of 'MonitorFilePath' except for globs which is
-- covered separately by 'MonitorStateGlob'.
--
-- The @Maybe ModTime@ is to cover the case where we already consider the
-- file to have changed, either because it had already changed by the time we
-- did the snapshot (i.e. too new, changed since start of update process) or it
-- no longer exists at all.
data MonitorStateFile
  = MonitorStateFile
      !MonitorKindFile
      !MonitorKindDir
      !FilePath
      !MonitorStateFileStatus
  deriving (Int -> MonitorStateFile -> ShowS
[MonitorStateFile] -> ShowS
MonitorStateFile -> FilePath
(Int -> MonitorStateFile -> ShowS)
-> (MonitorStateFile -> FilePath)
-> ([MonitorStateFile] -> ShowS)
-> Show MonitorStateFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorStateFile -> ShowS
showsPrec :: Int -> MonitorStateFile -> ShowS
$cshow :: MonitorStateFile -> FilePath
show :: MonitorStateFile -> FilePath
$cshowList :: [MonitorStateFile] -> ShowS
showList :: [MonitorStateFile] -> ShowS
Show, (forall x. MonitorStateFile -> Rep MonitorStateFile x)
-> (forall x. Rep MonitorStateFile x -> MonitorStateFile)
-> Generic MonitorStateFile
forall x. Rep MonitorStateFile x -> MonitorStateFile
forall x. MonitorStateFile -> Rep MonitorStateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateFile -> Rep MonitorStateFile x
from :: forall x. MonitorStateFile -> Rep MonitorStateFile x
$cto :: forall x. Rep MonitorStateFile x -> MonitorStateFile
to :: forall x. Rep MonitorStateFile x -> MonitorStateFile
Generic)

data MonitorStateFileStatus
  = MonitorStateFileExists
  | -- | cached file mtime
    MonitorStateFileModTime !ModTime
  | -- | cached mtime and content hash
    MonitorStateFileHashed !ModTime !HashValue
  | MonitorStateDirExists
  | -- | cached dir mtime
    MonitorStateDirModTime !ModTime
  | MonitorStateNonExistent
  | MonitorStateAlreadyChanged
  deriving (Int -> MonitorStateFileStatus -> ShowS
[MonitorStateFileStatus] -> ShowS
MonitorStateFileStatus -> FilePath
(Int -> MonitorStateFileStatus -> ShowS)
-> (MonitorStateFileStatus -> FilePath)
-> ([MonitorStateFileStatus] -> ShowS)
-> Show MonitorStateFileStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorStateFileStatus -> ShowS
showsPrec :: Int -> MonitorStateFileStatus -> ShowS
$cshow :: MonitorStateFileStatus -> FilePath
show :: MonitorStateFileStatus -> FilePath
$cshowList :: [MonitorStateFileStatus] -> ShowS
showList :: [MonitorStateFileStatus] -> ShowS
Show, (forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x)
-> (forall x.
    Rep MonitorStateFileStatus x -> MonitorStateFileStatus)
-> Generic MonitorStateFileStatus
forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
from :: forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
$cto :: forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
to :: forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
Generic)

instance Binary MonitorStateFile
instance Binary MonitorStateFileStatus
instance Structured MonitorStateFile
instance Structured MonitorStateFileStatus

-- | The state necessary to determine whether the files matched by a globbing
-- match have changed.
data MonitorStateGlob
  = MonitorStateGlob
      !MonitorKindFile
      !MonitorKindDir
      !FilePathRoot
      !MonitorStateGlobRel
  deriving (Int -> MonitorStateGlob -> ShowS
[MonitorStateGlob] -> ShowS
MonitorStateGlob -> FilePath
(Int -> MonitorStateGlob -> ShowS)
-> (MonitorStateGlob -> FilePath)
-> ([MonitorStateGlob] -> ShowS)
-> Show MonitorStateGlob
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorStateGlob -> ShowS
showsPrec :: Int -> MonitorStateGlob -> ShowS
$cshow :: MonitorStateGlob -> FilePath
show :: MonitorStateGlob -> FilePath
$cshowList :: [MonitorStateGlob] -> ShowS
showList :: [MonitorStateGlob] -> ShowS
Show, (forall x. MonitorStateGlob -> Rep MonitorStateGlob x)
-> (forall x. Rep MonitorStateGlob x -> MonitorStateGlob)
-> Generic MonitorStateGlob
forall x. Rep MonitorStateGlob x -> MonitorStateGlob
forall x. MonitorStateGlob -> Rep MonitorStateGlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateGlob -> Rep MonitorStateGlob x
from :: forall x. MonitorStateGlob -> Rep MonitorStateGlob x
$cto :: forall x. Rep MonitorStateGlob x -> MonitorStateGlob
to :: forall x. Rep MonitorStateGlob x -> MonitorStateGlob
Generic)

data MonitorStateGlobRel
  = MonitorStateGlobDirs
      !GlobPieces
      !Glob
      !ModTime
      ![(FilePath, MonitorStateGlobRel)] -- invariant: sorted
  | MonitorStateGlobFiles
      !GlobPieces
      !ModTime
      ![(FilePath, MonitorStateFileStatus)] -- invariant: sorted
  | MonitorStateGlobDirTrailing
  deriving (Int -> MonitorStateGlobRel -> ShowS
[MonitorStateGlobRel] -> ShowS
MonitorStateGlobRel -> FilePath
(Int -> MonitorStateGlobRel -> ShowS)
-> (MonitorStateGlobRel -> FilePath)
-> ([MonitorStateGlobRel] -> ShowS)
-> Show MonitorStateGlobRel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorStateGlobRel -> ShowS
showsPrec :: Int -> MonitorStateGlobRel -> ShowS
$cshow :: MonitorStateGlobRel -> FilePath
show :: MonitorStateGlobRel -> FilePath
$cshowList :: [MonitorStateGlobRel] -> ShowS
showList :: [MonitorStateGlobRel] -> ShowS
Show, (forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x)
-> (forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel)
-> Generic MonitorStateGlobRel
forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
from :: forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
$cto :: forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
to :: forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
Generic)

instance Binary MonitorStateGlob
instance Binary MonitorStateGlobRel

instance Structured MonitorStateGlob
instance Structured MonitorStateGlobRel

-- | We can build a 'MonitorStateFileSet' from a set of 'MonitorFilePath' by
-- inspecting the state of the file system, and we can go in the reverse
-- direction by just forgetting the extra info.
reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
  (MonitorStateFile -> MonitorFilePath)
-> [MonitorStateFile] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateFile -> MonitorFilePath
getSinglePath [MonitorStateFile]
singlePaths [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++ (MonitorStateGlob -> MonitorFilePath)
-> [MonitorStateGlob] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateGlob -> MonitorFilePath
getGlobPath [MonitorStateGlob]
globPaths
  where
    getSinglePath :: MonitorStateFile -> MonitorFilePath
    getSinglePath :: MonitorStateFile -> MonitorFilePath
getSinglePath (MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath MonitorStateFileStatus
_) =
      MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath

    getGlobPath :: MonitorStateGlob -> MonitorFilePath
    getGlobPath :: MonitorStateGlob -> MonitorFilePath
getGlobPath (MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
root MonitorStateGlobRel
gstate) =
      MonitorKindFile -> MonitorKindDir -> RootedGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir (RootedGlob -> MonitorFilePath) -> RootedGlob -> MonitorFilePath
forall a b. (a -> b) -> a -> b
$
        FilePathRoot -> Glob -> RootedGlob
RootedGlob FilePathRoot
root (Glob -> RootedGlob) -> Glob -> RootedGlob
forall a b. (a -> b) -> a -> b
$
          case MonitorStateGlobRel
gstate of
            MonitorStateGlobDirs GlobPieces
glob Glob
globs ModTime
_ [(FilePath, MonitorStateGlobRel)]
_ -> GlobPieces -> Glob -> Glob
GlobDir GlobPieces
glob Glob
globs
            MonitorStateGlobFiles GlobPieces
glob ModTime
_ [(FilePath, MonitorStateFileStatus)]
_ -> GlobPieces -> Glob
GlobFile GlobPieces
glob
            MonitorStateGlobRel
MonitorStateGlobDirTrailing -> Glob
GlobDirTrailing

------------------------------------------------------------------------------
-- Checking the status of monitored files
--

-- | A monitor for detecting changes to a set of files. It can be used to
-- efficiently test if any of a set of files (specified individually or by
-- glob patterns) has changed since some snapshot. In addition, it also checks
-- for changes in a value (of type @a@), and when there are no changes in
-- either it returns a saved value (of type @b@).
--
-- The main use case looks like this: suppose we have some expensive action
-- that depends on certain pure inputs and reads some set of files, and
-- produces some pure result. We want to avoid re-running this action when it
-- would produce the same result. So we need to monitor the files the action
-- looked at, the other pure input values, and we need to cache the result.
-- Then at some later point, if the input value didn't change, and none of the
-- files changed, then we can re-use the cached result rather than re-running
-- the action.
--
-- This can be achieved using a 'FileMonitor'. Each 'FileMonitor' instance
-- saves state in a disk file, so the file for that has to be specified,
-- making sure it is unique. The pattern is to use 'checkFileMonitorChanged'
-- to see if there's been any change. If there is, re-run the action, keeping
-- track of the files, then use 'updateFileMonitor' to record the current
-- set of files to monitor, the current input value for the action, and the
-- result of the action.
--
-- The typical occurrence of this pattern is captured by 'rerunIfChanged'
-- and the 'Rebuild' monad. More complicated cases may need to use
-- 'checkFileMonitorChanged' and 'updateFileMonitor' directly.
data FileMonitor a b = FileMonitor
  { forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile :: FilePath
  -- ^ The file where this 'FileMonitor' should store its state.
  , forall a b. FileMonitor a b -> a -> a -> Bool
fileMonitorKeyValid :: a -> a -> Bool
  -- ^ Compares a new cache key with old one to determine if a
  -- corresponding cached value is still valid.
  --
  -- Typically this is just an equality test, but in some
  -- circumstances it can make sense to do things like subset
  -- comparisons.
  --
  -- The first arg is the new value, the second is the old cached value.
  , forall a b. FileMonitor a b -> Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
  -- ^ When this mode is enabled, if 'checkFileMonitorChanged' returns
  -- 'MonitoredValueChanged' then we have the guarantee that no files
  -- changed, that the value change was the only change. In the default
  -- mode no such guarantee is provided which is slightly faster.
  }

-- | Define a new file monitor.
--
-- It's best practice to define file monitor values once, and then use the
-- same value for 'checkFileMonitorChanged' and 'updateFileMonitor' as this
-- ensures you get the same types @a@ and @b@ for reading and writing.
--
-- The path of the file monitor itself must be unique because it keeps state
-- on disk and these would clash.
newFileMonitor
  :: Eq a
  => FilePath
  -- ^ The file to cache the state of the
  -- file monitor. Must be unique.
  -> FileMonitor a b
newFileMonitor :: forall a b. Eq a => FilePath -> FileMonitor a b
newFileMonitor FilePath
path = FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
FileMonitor FilePath
path a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Bool
False

-- | The result of 'checkFileMonitorChanged': either the monitored files or
-- value changed (and it tells us which it was) or nothing changed and we get
-- the cached result.
data MonitorChanged a b
  = -- | The monitored files and value did not change. The cached result is
    -- @b@.
    --
    -- The set of monitored files is also returned. This is useful
    -- for composing or nesting 'FileMonitor's.
    MonitorUnchanged b [MonitorFilePath]
  | -- | The monitor found that something changed. The reason is given.
    MonitorChanged (MonitorChangedReason a)
  deriving (Int -> MonitorChanged a b -> ShowS
[MonitorChanged a b] -> ShowS
MonitorChanged a b -> FilePath
(Int -> MonitorChanged a b -> ShowS)
-> (MonitorChanged a b -> FilePath)
-> ([MonitorChanged a b] -> ShowS)
-> Show (MonitorChanged a b)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
showsPrec :: Int -> MonitorChanged a b -> ShowS
$cshow :: forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
show :: MonitorChanged a b -> FilePath
$cshowList :: forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
showList :: [MonitorChanged a b] -> ShowS
Show)

-- | What kind of change 'checkFileMonitorChanged' detected.
data MonitorChangedReason a
  = -- | One of the files changed (existence, file type, mtime or file
    -- content, depending on the 'MonitorFilePath' in question)
    MonitoredFileChanged FilePath
  | -- | The pure input value changed.
    --
    -- The previous cached key value is also returned. This is sometimes
    -- useful when using a 'fileMonitorKeyValid' function that is not simply
    -- '(==)', when invalidation can be partial. In such cases it can make
    -- sense to 'updateFileMonitor' with a key value that's a combination of
    -- the new and old (e.g. set union).
    MonitoredValueChanged a
  | -- | There was no saved monitor state, cached value etc. Ie the file
    -- for the 'FileMonitor' does not exist.
    MonitorFirstRun
  | -- | There was existing state, but we could not read it. This typically
    -- happens when the code has changed compared to an existing 'FileMonitor'
    -- cache file and type of the input value or cached value has changed such
    -- that we cannot decode the values. This is completely benign as we can
    -- treat is just as if there were no cache file and re-run.
    MonitorCorruptCache
  deriving (MonitorChangedReason a -> MonitorChangedReason a -> Bool
(MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> (MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> Eq (MonitorChangedReason a)
forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
== :: MonitorChangedReason a -> MonitorChangedReason a -> Bool
$c/= :: forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
/= :: MonitorChangedReason a -> MonitorChangedReason a -> Bool
Eq, Int -> MonitorChangedReason a -> ShowS
[MonitorChangedReason a] -> ShowS
MonitorChangedReason a -> FilePath
(Int -> MonitorChangedReason a -> ShowS)
-> (MonitorChangedReason a -> FilePath)
-> ([MonitorChangedReason a] -> ShowS)
-> Show (MonitorChangedReason a)
forall a. Show a => Int -> MonitorChangedReason a -> ShowS
forall a. Show a => [MonitorChangedReason a] -> ShowS
forall a. Show a => MonitorChangedReason a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MonitorChangedReason a -> ShowS
showsPrec :: Int -> MonitorChangedReason a -> ShowS
$cshow :: forall a. Show a => MonitorChangedReason a -> FilePath
show :: MonitorChangedReason a -> FilePath
$cshowList :: forall a. Show a => [MonitorChangedReason a] -> ShowS
showList :: [MonitorChangedReason a] -> ShowS
Show, (forall a b.
 (a -> b) -> MonitorChangedReason a -> MonitorChangedReason b)
-> (forall a b.
    a -> MonitorChangedReason b -> MonitorChangedReason a)
-> Functor MonitorChangedReason
forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
fmap :: forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
$c<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
Functor)

-- | Test if the input value or files monitored by the 'FileMonitor' have
-- changed. If not, return the cached value.
--
-- See 'FileMonitor' for a full explanation.
checkFileMonitorChanged
  :: forall a b
   . (Binary a, Structured a, Binary b, Structured b)
  => FileMonitor a b
  -- ^ cache file path
  -> FilePath
  -- ^ root directory
  -> a
  -- ^ guard or key value
  -> IO (MonitorChanged a b)
  -- ^ did the key or any paths change?
checkFileMonitorChanged :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
  monitor :: FileMonitor a b
monitor@FileMonitor
    { a -> a -> Bool
fileMonitorKeyValid :: forall a b. FileMonitor a b -> a -> a -> Bool
fileMonitorKeyValid :: a -> a -> Bool
fileMonitorKeyValid
    , Bool
fileMonitorCheckIfOnlyValueChanged :: forall a b. FileMonitor a b -> Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged
    }
  FilePath
root
  a
currentKey =
    -- Consider it a change if the cache file does not exist,
    -- or we cannot decode it. Sadly ErrorCall can still happen, despite
    -- using decodeFileOrFail, e.g. Data.Char.chr errors

    MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleDoesNotExist (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorFirstRun) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
      MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleErrorCall (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
        FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
  -> IO (MonitorChanged a b))
 -> IO (MonitorChanged a b))
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
          (FilePath -> IO (MonitorChanged a b))
-> ((MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\FilePath
_ -> MonitorChanged a b -> IO (MonitorChanged a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache))
            (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
checkStatusCache
    where
      checkStatusCache :: (MonitorStateFileSet, a, Either String b) -> IO (MonitorChanged a b)
      checkStatusCache :: (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
checkStatusCache (MonitorStateFileSet
cachedFileStatus, a
cachedKey, Either FilePath b
cachedResult) = do
        Maybe (MonitorChangedReason a)
change <- IO (Maybe (MonitorChangedReason a))
checkForChanges
        case Maybe (MonitorChangedReason a)
change of
          Just MonitorChangedReason a
reason -> MonitorChanged a b -> IO (MonitorChanged a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
reason)
          Maybe (MonitorChangedReason a)
Nothing -> case Either FilePath b
cachedResult of
            Left FilePath
_ -> MonitorChanged a b -> IO (MonitorChanged a b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache)
            Right b
cr -> MonitorChanged a b -> IO (MonitorChanged a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> [MonitorFilePath] -> MonitorChanged a b
forall a b. b -> [MonitorFilePath] -> MonitorChanged a b
MonitorUnchanged b
cr [MonitorFilePath]
monitorFiles)
            where
              monitorFiles :: [MonitorFilePath]
monitorFiles = MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths MonitorStateFileSet
cachedFileStatus
        where
          -- In fileMonitorCheckIfOnlyValueChanged mode we want to guarantee that
          -- if we return MonitoredValueChanged that only the value changed.
          -- We do that by checking for file changes first. Otherwise it makes
          -- more sense to do the cheaper test first.
          checkForChanges :: IO (Maybe (MonitorChangedReason a))
          checkForChanges :: IO (Maybe (MonitorChangedReason a))
checkForChanges
            | Bool
fileMonitorCheckIfOnlyValueChanged =
                MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult
                  IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
`mplusMaybeT` a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
            | Bool
otherwise =
                a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
                  IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
`mplusMaybeT` MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult

      mplusMaybeT :: Monad m => m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
      mplusMaybeT :: forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
mplusMaybeT m (Maybe a1)
ma m (Maybe a1)
mb = do
        Maybe a1
mx <- m (Maybe a1)
ma
        case Maybe a1
mx of
          Maybe a1
Nothing -> m (Maybe a1)
mb
          Just a1
x -> Maybe a1 -> m (Maybe a1)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a1 -> Maybe a1
forall a. a -> Maybe a
Just a1
x)

      -- Check if the guard value has changed
      checkValueChange :: a -> IO (Maybe (MonitorChangedReason a))
      checkValueChange :: a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
        | Bool -> Bool
not (a -> a -> Bool
fileMonitorKeyValid a
currentKey a
cachedKey) =
            Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> Maybe (MonitorChangedReason a)
forall a. a -> Maybe a
Just (a -> MonitorChangedReason a
forall a. a -> MonitorChangedReason a
MonitoredValueChanged a
cachedKey))
        | Bool
otherwise =
            Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MonitorChangedReason a)
forall a. Maybe a
Nothing

      -- Check if any file has changed
      checkFileChange :: MonitorStateFileSet -> a -> Either String b -> IO (Maybe (MonitorChangedReason a))
      checkFileChange :: MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult = do
        Either FilePath (MonitorStateFileSet, CacheChanged)
res <- FilePath
-> MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
probeFileSystem FilePath
root MonitorStateFileSet
cachedFileStatus
        case Either FilePath (MonitorStateFileSet, CacheChanged)
res of
          -- Some monitored file has changed
          Left FilePath
changedPath ->
            Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> Maybe (MonitorChangedReason a)
forall a. a -> Maybe a
Just (FilePath -> MonitorChangedReason a
forall a. FilePath -> MonitorChangedReason a
MonitoredFileChanged (ShowS
normalise FilePath
changedPath)))
          -- No monitored file has changed
          Right (MonitorStateFileSet
cachedFileStatus', CacheChanged
cacheStatus) -> do
            -- But we might still want to update the cache
            CacheChanged -> IO () -> IO ()
forall (m :: * -> *). Monad m => CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
cacheStatus (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              case Either FilePath b
cachedResult of
                Left FilePath
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Right b
cr -> FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
cachedFileStatus' a
cachedKey b
cr

            Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MonitorChangedReason a)
forall a. Maybe a
Nothing

-- | Lazily decode a triple, parsing the first two fields strictly and
-- returning a lazy value containing either the last one or an error.
-- This is helpful for cabal cache files where the first two components
-- contain header data that lets one test if the cache is still valid,
-- and the last (potentially large) component is the cached value itself.
-- This way we can test for cache validity without needing to pay the
-- cost of the decode of stale cache data. This lives here rather than
-- Distribution.Utils.Structured because it depends on a newer version of
-- binary than supported in the Cabal library proper.
structuredDecodeTriple
  :: forall a b c
   . (Structured a, Structured b, Structured c, Binary.Binary a, Binary.Binary b, Binary.Binary c)
  => BS.ByteString
  -> Either String (a, b, Either String c)
structuredDecodeTriple :: forall a b c.
(Structured a, Structured b, Structured c, Binary a, Binary b,
 Binary c) =>
ByteString -> Either FilePath (a, b, Either FilePath c)
structuredDecodeTriple ByteString
lbs =
  let partialDecode :: Either
  (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
partialDecode =
        (Get (a, b)
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
`runGetOrFail` ByteString
lbs) (Get (a, b)
 -> Either
      (ByteString, ByteOffset, FilePath)
      (ByteString, ByteOffset, (a, b)))
-> Get (a, b)
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
forall a b. (a -> b) -> a -> b
$ do
          (Tag (a, b, c)
_ :: Tag (a, b, c)) <- Get (Tag (a, b, c))
forall t. Binary t => Get t
Binary.get
          (a
a :: a) <- Get a
forall t. Binary t => Get t
Binary.get
          (b
b :: b) <- Get b
forall t. Binary t => Get t
Binary.get
          (a, b) -> Get (a, b)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
      cleanEither :: Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither (Left (a
_, a
pos, FilePath
msg)) = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
pos FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
      cleanEither (Right (a
_, b
_, b
v)) = b -> Either FilePath b
forall a b. b -> Either a b
Right b
v
   in case Either
  (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
partialDecode of
        Left (ByteString
_, ByteOffset
pos, FilePath
msg) -> FilePath -> Either FilePath (a, b, Either FilePath c)
forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteOffset -> FilePath
forall a. Show a => a -> FilePath
show ByteOffset
pos FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
        Right (ByteString
lbs', ByteOffset
_, (a
x, b
y)) -> (a, b, Either FilePath c)
-> Either FilePath (a, b, Either FilePath c)
forall a b. b -> Either a b
Right (a
x, b
y, Either
  (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall {a} {a} {a} {b} {b}.
Show a =>
Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither (Either
   (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
 -> Either FilePath c)
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall a b. (a -> b) -> a -> b
$ Get c
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
runGetOrFail (Get c
forall t. Binary t => Get t
Binary.get :: Binary.Get c) ByteString
lbs')

-- | Helper for reading the cache file.
--
-- This determines the type and format of the binary cache file.
withCacheFile
  :: (Binary a, Structured a, Binary b, Structured b)
  => FileMonitor a b
  -> (Either String (MonitorStateFileSet, a, Either String b) -> IO r)
  -> IO r
withCacheFile :: forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO r)
-> IO r
withCacheFile (FileMonitor{FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile}) Either FilePath (MonitorStateFileSet, a, Either FilePath b) -> IO r
k =
  FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fileMonitorCacheFile IOMode
ReadMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
    Either FilePath (MonitorStateFileSet, a, Either FilePath b)
contents <- ByteString
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b)
forall a b c.
(Structured a, Structured b, Structured c, Binary a, Binary b,
 Binary c) =>
ByteString -> Either FilePath (a, b, Either FilePath c)
structuredDecodeTriple (ByteString
 -> Either FilePath (MonitorStateFileSet, a, Either FilePath b))
-> IO ByteString
-> IO (Either FilePath (MonitorStateFileSet, a, Either FilePath b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BS.hGetContents Handle
hnd
    Either FilePath (MonitorStateFileSet, a, Either FilePath b) -> IO r
k Either FilePath (MonitorStateFileSet, a, Either FilePath b)
contents

-- | Helper for writing the cache file.
--
-- This determines the type and format of the binary cache file.
rewriteCacheFile
  :: (Binary a, Structured a, Binary b, Structured b)
  => FileMonitor a b
  -> MonitorStateFileSet
  -> a
  -> b
  -> IO ()
rewriteCacheFile :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor{FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile} MonitorStateFileSet
fileset a
key b
result =
  FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
fileMonitorCacheFile (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
    (MonitorStateFileSet, a, b) -> ByteString
forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode (MonitorStateFileSet
fileset, a
key, b
result)

-- | Probe the file system to see if any of the monitored files have changed.
--
-- It returns Nothing if any file changed, or returns a possibly updated
-- file 'MonitorStateFileSet' plus an indicator of whether it actually changed.
--
-- We may need to update the cache since there may be changes in the filesystem
-- state which don't change any of our affected files.
--
-- Consider the glob @{proj1,proj2}\/\*.cabal@. Say we first run and find a
-- @proj1@ directory containing @proj1.cabal@ yet no @proj2@. If we later run
-- and find @proj2@ was created, yet contains no files matching @*.cabal@ then
-- we want to update the cache despite no changes in our relevant file set.
-- Specifically, we should add an mtime for this directory so we can avoid
-- re-traversing the directory in future runs.
probeFileSystem
  :: FilePath
  -> MonitorStateFileSet
  -> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
probeFileSystem :: FilePath
-> MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
probeFileSystem FilePath
root (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
  ChangedM MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
forall a. ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM (ChangedM MonitorStateFileSet
 -> IO (Either FilePath (MonitorStateFileSet, CacheChanged)))
-> ChangedM MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
forall a b. (a -> b) -> a -> b
$ do
    [ChangedM ()] -> ChangedM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root FilePath
file MonitorStateFileStatus
status
      | MonitorStateFile MonitorKindFile
_ MonitorKindDir
_ FilePath
file MonitorStateFileStatus
status <- [MonitorStateFile]
singlePaths
      ]
    -- The glob monitors can require state changes
    [MonitorStateGlob]
globPaths' <-
      [ChangedM MonitorStateGlob] -> ChangedM [MonitorStateGlob]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ FilePath -> MonitorStateGlob -> ChangedM MonitorStateGlob
probeMonitorStateGlob FilePath
root MonitorStateGlob
globPath
        | MonitorStateGlob
globPath <- [MonitorStateGlob]
globPaths
        ]
    MonitorStateFileSet -> ChangedM MonitorStateFileSet
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths')

-----------------------------------------------
-- Monad for checking for file system changes
--
-- We need to be able to bail out if we detect a change (using ExceptT),
-- but if there's no change we need to be able to rebuild the monitor
-- state. And we want to optimise that rebuilding by keeping track if
-- anything actually changed (using StateT), so that in the typical case
-- we can avoid rewriting the state file.

newtype ChangedM a = ChangedM (StateT CacheChanged (ExceptT FilePath IO) a)
  deriving ((forall a b. (a -> b) -> ChangedM a -> ChangedM b)
-> (forall a b. a -> ChangedM b -> ChangedM a) -> Functor ChangedM
forall a b. a -> ChangedM b -> ChangedM a
forall a b. (a -> b) -> ChangedM a -> ChangedM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ChangedM a -> ChangedM b
fmap :: forall a b. (a -> b) -> ChangedM a -> ChangedM b
$c<$ :: forall a b. a -> ChangedM b -> ChangedM a
<$ :: forall a b. a -> ChangedM b -> ChangedM a
Functor, Functor ChangedM
Functor ChangedM =>
(forall a. a -> ChangedM a)
-> (forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b)
-> (forall a b c.
    (a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM b)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM a)
-> Applicative ChangedM
forall a. a -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM b
forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ChangedM a
pure :: forall a. a -> ChangedM a
$c<*> :: forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
<*> :: forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
liftA2 :: forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
$c*> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
*> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
$c<* :: forall a b. ChangedM a -> ChangedM b -> ChangedM a
<* :: forall a b. ChangedM a -> ChangedM b -> ChangedM a
Applicative, Applicative ChangedM
Applicative ChangedM =>
(forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM b)
-> (forall a. a -> ChangedM a)
-> Monad ChangedM
forall a. a -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM b
forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
>>= :: forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
$c>> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
>> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
$creturn :: forall a. a -> ChangedM a
return :: forall a. a -> ChangedM a
Monad, Monad ChangedM
Monad ChangedM =>
(forall a. IO a -> ChangedM a) -> MonadIO ChangedM
forall a. IO a -> ChangedM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ChangedM a
liftIO :: forall a. IO a -> ChangedM a
MonadIO)

runChangedM :: ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM :: forall a. ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM (ChangedM StateT CacheChanged (ExceptT FilePath IO) a
action) =
  ExceptT FilePath IO (a, CacheChanged)
-> IO (Either FilePath (a, CacheChanged))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO (a, CacheChanged)
 -> IO (Either FilePath (a, CacheChanged)))
-> ExceptT FilePath IO (a, CacheChanged)
-> IO (Either FilePath (a, CacheChanged))
forall a b. (a -> b) -> a -> b
$ StateT CacheChanged (ExceptT FilePath IO) a
-> CacheChanged -> ExceptT FilePath IO (a, CacheChanged)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT StateT CacheChanged (ExceptT FilePath IO) a
action CacheChanged
CacheUnchanged

somethingChanged :: FilePath -> ChangedM a
somethingChanged :: forall a. FilePath -> ChangedM a
somethingChanged FilePath
path = StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM (StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a)
-> StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a b. (a -> b) -> a -> b
$ FilePath -> StateT CacheChanged (ExceptT FilePath IO) a
forall a. FilePath -> StateT CacheChanged (ExceptT FilePath IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
path

cacheChanged :: ChangedM ()
cacheChanged :: ChangedM ()
cacheChanged = StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ()
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM (StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ())
-> StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ()
forall a b. (a -> b) -> a -> b
$ CacheChanged -> StateT CacheChanged (ExceptT FilePath IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put CacheChanged
CacheChanged

mapChangedFile :: (FilePath -> FilePath) -> ChangedM a -> ChangedM a
mapChangedFile :: forall a. ShowS -> ChangedM a -> ChangedM a
mapChangedFile ShowS
adjust (ChangedM StateT CacheChanged (ExceptT FilePath IO) a
a) =
  StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM ((ExceptT FilePath IO (a, CacheChanged)
 -> ExceptT FilePath IO (a, CacheChanged))
-> StateT CacheChanged (ExceptT FilePath IO) a
-> StateT CacheChanged (ExceptT FilePath IO) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (ShowS
-> ExceptT FilePath IO (a, CacheChanged)
-> ExceptT FilePath IO (a, CacheChanged)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ShowS
adjust) StateT CacheChanged (ExceptT FilePath IO) a
a)

data CacheChanged = CacheChanged | CacheUnchanged

whenCacheChanged :: Monad m => CacheChanged -> m () -> m ()
whenCacheChanged :: forall (m :: * -> *). Monad m => CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
CacheChanged m ()
action = m ()
action
whenCacheChanged CacheChanged
CacheUnchanged m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

----------------------

-- | Probe the file system to see if a single monitored file has changed.
probeMonitorStateFileStatus
  :: FilePath
  -> FilePath
  -> MonitorStateFileStatus
  -> ChangedM ()
probeMonitorStateFileStatus :: FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root FilePath
file MonitorStateFileStatus
status =
  case MonitorStateFileStatus
status of
    MonitorStateFileStatus
MonitorStateFileExists ->
      FilePath -> FilePath -> ChangedM ()
probeFileExistence FilePath
root FilePath
file
    MonitorStateFileModTime ModTime
mtime ->
      FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
    MonitorStateFileHashed ModTime
mtime HashValue
hash ->
      FilePath -> FilePath -> ModTime -> HashValue -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime HashValue
hash
    MonitorStateFileStatus
MonitorStateDirExists ->
      FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
file
    MonitorStateDirModTime ModTime
mtime ->
      FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
    MonitorStateFileStatus
MonitorStateNonExistent ->
      FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file
    MonitorStateFileStatus
MonitorStateAlreadyChanged ->
      FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file

-- | Probe the file system to see if a monitored file glob has changed.
probeMonitorStateGlob
  :: FilePath
  -- ^ root path
  -> MonitorStateGlob
  -> ChangedM MonitorStateGlob
probeMonitorStateGlob :: FilePath -> MonitorStateGlob -> ChangedM MonitorStateGlob
probeMonitorStateGlob
  FilePath
relroot
  (MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot MonitorStateGlobRel
glob) = do
    FilePath
root <- IO FilePath -> ChangedM FilePath
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ChangedM FilePath)
-> IO FilePath -> ChangedM FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
    case FilePathRoot
globroot of
      FilePathRoot
FilePathRelative ->
        MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot
          (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"." MonitorStateGlobRel
glob
      -- for absolute cases, make the changed file we report absolute too
      FilePathRoot
_ ->
        ShowS -> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a. ShowS -> ChangedM a -> ChangedM a
mapChangedFile (FilePath
root FilePath -> ShowS
</>) (ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob)
-> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a b. (a -> b) -> a -> b
$
          MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot
            (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"" MonitorStateGlobRel
glob

probeMonitorStateGlobRel
  :: MonitorKindFile
  -> MonitorKindDir
  -> FilePath
  -- ^ root path
  -> FilePath
  -- ^ path of the directory we are
  --   looking in relative to @root@
  -> MonitorStateGlobRel
  -> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel :: MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel
  MonitorKindFile
kindfile
  MonitorKindDir
kinddir
  FilePath
root
  FilePath
dirName
  (MonitorStateGlobDirs GlobPieces
glob Glob
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children) = do
    Maybe ModTime
change <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
    case Maybe ModTime
change of
      Maybe ModTime
Nothing -> do
        [(FilePath, MonitorStateGlobRel)]
children' <-
          [ChangedM (FilePath, MonitorStateGlobRel)]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
            [ do
              MonitorStateGlobRel
fstate' <-
                MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel
                  MonitorKindFile
kindfile
                  MonitorKindDir
kinddir
                  FilePath
root
                  (FilePath
dirName FilePath -> ShowS
</> FilePath
fname)
                  MonitorStateGlobRel
fstate
              (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fname, MonitorStateGlobRel
fstate')
            | (FilePath
fname, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
children
            ]
        MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! GlobPieces
-> Glob
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs GlobPieces
glob Glob
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children'
      Just ModTime
mtime' -> do
        -- directory modification time changed:
        -- a matching subdir may have been added or deleted
        [FilePath]
matches <-
          (FilePath -> ChangedM Bool) -> [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
            ( \FilePath
entry ->
                let subdir :: FilePath
subdir = FilePath
root FilePath -> ShowS
</> FilePath
dirName FilePath -> ShowS
</> FilePath
entry
                 in IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
subdir
            )
            ([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobPieces -> FilePath -> Bool
matchGlobPieces GlobPieces
glob)
            ([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

        [(FilePath, MonitorStateGlobRel)]
children' <-
          (MergeResult (FilePath, MonitorStateGlobRel) FilePath
 -> ChangedM (FilePath, MonitorStateGlobRel))
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult ([MergeResult (FilePath, MonitorStateGlobRel) FilePath]
 -> ChangedM [(FilePath, MonitorStateGlobRel)])
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$
            ((FilePath, MonitorStateGlobRel) -> FilePath -> Ordering)
-> [(FilePath, MonitorStateGlobRel)]
-> [FilePath]
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy
              (\(FilePath
path1, MonitorStateGlobRel
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
              [(FilePath, MonitorStateGlobRel)]
children
              ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
        MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! GlobPieces
-> Glob
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs GlobPieces
glob Glob
globPath ModTime
mtime' [(FilePath, MonitorStateGlobRel)]
children'
    where
      -- Note that just because the directory has changed, we don't force
      -- a cache rewrite with 'cacheChanged' since that has some cost, and
      -- all we're saving is scanning the directory. But we do rebuild the
      -- cache with the new mtime', so that if the cache is rewritten for
      -- some other reason, we'll take advantage of that.

      probeMergeResult
        :: MergeResult (FilePath, MonitorStateGlobRel) FilePath
        -> ChangedM (FilePath, MonitorStateGlobRel)

      -- Only in cached (directory deleted)
      probeMergeResult :: MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult (OnlyInLeft (FilePath
path, MonitorStateGlobRel
fstate)) = do
        case FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate of
          [] -> (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate)
          -- Strictly speaking we should be returning 'CacheChanged' above
          -- as we should prune the now-missing 'MonitorStateGlobRel'. However
          -- we currently just leave these now-redundant entries in the
          -- cache as they cost no IO and keeping them allows us to avoid
          -- rewriting the cache.
          (FilePath
file : [FilePath]
_) -> FilePath -> ChangedM (FilePath, MonitorStateGlobRel)
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file

      -- Only in current filesystem state (directory added)
      probeMergeResult (OnlyInRight FilePath
path) = do
        MonitorStateGlobRel
fstate <-
          IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$
            Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> Glob
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
              Maybe MonitorTimestamp
forall a. Maybe a
Nothing
              FileHashCache
forall k a. Map k a
Map.empty
              MonitorKindFile
kindfile
              MonitorKindDir
kinddir
              FilePath
root
              (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
              Glob
globPath
        case FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate of
          (FilePath
file : [FilePath]
_) -> FilePath -> ChangedM (FilePath, MonitorStateGlobRel)
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file
          -- This is the only case where we use 'cacheChanged' because we can
          -- have a whole new dir subtree (of unbounded size and cost), so we
          -- need to save the state of that new subtree in the cache.
          [] -> ChangedM ()
cacheChanged ChangedM ()
-> ChangedM (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall a b. ChangedM a -> ChangedM b -> ChangedM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate)

      -- Found in path
      probeMergeResult (InBoth (FilePath
path, MonitorStateGlobRel
fstate) FilePath
_) = do
        MonitorStateGlobRel
fstate' <-
          MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel
            MonitorKindFile
kindfile
            MonitorKindDir
kinddir
            FilePath
root
            (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
            MonitorStateGlobRel
fstate
        (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate')

      -- \| Does a 'MonitorStateGlob' have any relevant files within it?
      allMatchingFiles :: FilePath -> MonitorStateGlobRel -> [FilePath]
      allMatchingFiles :: FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles FilePath
dir (MonitorStateGlobFiles GlobPieces
_ ModTime
_ [(FilePath, MonitorStateFileStatus)]
entries) =
        [FilePath
dir FilePath -> ShowS
</> FilePath
fname | (FilePath
fname, MonitorStateFileStatus
_) <- [(FilePath, MonitorStateFileStatus)]
entries]
      allMatchingFiles FilePath
dir (MonitorStateGlobDirs GlobPieces
_ Glob
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
        [ FilePath
res
        | (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
        , FilePath
res <- FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) MonitorStateGlobRel
fstate
        ]
      allMatchingFiles FilePath
dir MonitorStateGlobRel
MonitorStateGlobDirTrailing =
        [FilePath
dir]
probeMonitorStateGlobRel
  MonitorKindFile
_
  MonitorKindDir
_
  FilePath
root
  FilePath
dirName
  (MonitorStateGlobFiles GlobPieces
glob ModTime
mtime [(FilePath, MonitorStateFileStatus)]
children) = do
    Maybe ModTime
change <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
    ModTime
mtime' <- case Maybe ModTime
change of
      Maybe ModTime
Nothing -> ModTime -> ChangedM ModTime
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return ModTime
mtime
      Just ModTime
mtime' -> do
        -- directory modification time changed:
        -- a matching file may have been added or deleted
        [FilePath]
matches <-
          [FilePath] -> ChangedM [FilePath]
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobPieces -> FilePath -> Bool
matchGlobPieces GlobPieces
glob)
            ([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

        (MergeResult (FilePath, MonitorStateFileStatus) FilePath
 -> ChangedM ())
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
-> ChangedM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ()
probeMergeResult ([MergeResult (FilePath, MonitorStateFileStatus) FilePath]
 -> ChangedM ())
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
-> ChangedM ()
forall a b. (a -> b) -> a -> b
$
          ((FilePath, MonitorStateFileStatus) -> FilePath -> Ordering)
-> [(FilePath, MonitorStateFileStatus)]
-> [FilePath]
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy
            (\(FilePath
path1, MonitorStateFileStatus
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
            [(FilePath, MonitorStateFileStatus)]
children
            ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
        ModTime -> ChangedM ModTime
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return ModTime
mtime'

    -- Check that none of the children have changed
    [(FilePath, MonitorStateFileStatus)]
-> ((FilePath, MonitorStateFileStatus) -> ChangedM ())
-> ChangedM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(FilePath, MonitorStateFileStatus)]
children (((FilePath, MonitorStateFileStatus) -> ChangedM ())
 -> ChangedM ())
-> ((FilePath, MonitorStateFileStatus) -> ChangedM ())
-> ChangedM ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
file, MonitorStateFileStatus
status) ->
      FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
file) MonitorStateFileStatus
status

    MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobPieces
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles GlobPieces
glob ModTime
mtime' [(FilePath, MonitorStateFileStatus)]
children)
    where
      -- Again, we don't force a cache rewrite with 'cacheChanged', but we do use
      -- the new mtime' if any.

      probeMergeResult
        :: MergeResult (FilePath, MonitorStateFileStatus) FilePath
        -> ChangedM ()
      probeMergeResult :: MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ()
probeMergeResult MergeResult (FilePath, MonitorStateFileStatus) FilePath
mr = case MergeResult (FilePath, MonitorStateFileStatus) FilePath
mr of
        InBoth (FilePath, MonitorStateFileStatus)
_ FilePath
_ -> () -> ChangedM ()
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- this is just to be able to accurately report which file changed:
        OnlyInLeft (FilePath
path, MonitorStateFileStatus
_) -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
        OnlyInRight FilePath
path -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
probeMonitorStateGlobRel MonitorKindFile
_ MonitorKindDir
_ FilePath
_ FilePath
_ MonitorStateGlobRel
MonitorStateGlobDirTrailing =
  MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a. a -> ChangedM a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateGlobRel
MonitorStateGlobDirTrailing

------------------------------------------------------------------------------

-- | Update the input value and the set of files monitored by the
-- 'FileMonitor', plus the cached value that may be returned in future.
--
-- This takes a snapshot of the state of the monitored files right now, so
-- 'checkFileMonitorChanged' will look for file system changes relative to
-- this snapshot.
--
-- This is typically done once the action has been completed successfully and
-- we have the action's result and we know what files it looked at. See
-- 'FileMonitor' for a full explanation.
--
-- If we do take the snapshot after the action has completed then we have a
-- problem. The problem is that files might have changed /while/ the action was
-- running but /after/ the action read them. If we take the snapshot after the
-- action completes then we will miss these changes. The solution is to record
-- a timestamp before beginning execution of the action and then we make the
-- conservative assumption that any file that has changed since then has
-- already changed, ie the file monitor state for these files will be such that
-- 'checkFileMonitorChanged' will report that they have changed.
--
-- So if you do use 'updateFileMonitor' after the action (so you can discover
-- the files used rather than predicting them in advance) then use
-- 'beginUpdateFileMonitor' to get a timestamp and pass that. Alternatively,
-- if you take the snapshot in advance of the action, or you're not monitoring
-- any files then you can use @Nothing@ for the timestamp parameter.
updateFileMonitor
  :: (Binary a, Structured a, Binary b, Structured b)
  => FileMonitor a b
  -- ^ cache file path
  -> FilePath
  -- ^ root directory
  -> Maybe MonitorTimestamp
  -- ^ timestamp when the update action started
  -> [MonitorFilePath]
  -- ^ files of interest relative to root
  -> a
  -- ^ the current key value
  -> b
  -- ^ the current result value
  -> IO ()
updateFileMonitor :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor
  FileMonitor a b
monitor
  FilePath
root
  Maybe MonitorTimestamp
startTime
  [MonitorFilePath]
monitorFiles
  a
cachedKey
  b
cachedResult = do
    FileHashCache
hashcache <- FileMonitor a b -> IO FileHashCache
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor
    MonitorStateFileSet
msfs <- Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
startTime FileHashCache
hashcache FilePath
root [MonitorFilePath]
monitorFiles
    FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
msfs a
cachedKey b
cachedResult

-- | A timestamp to help with the problem of file changes during actions.
-- See 'updateFileMonitor' for details.
newtype MonitorTimestamp = MonitorTimestamp ModTime

-- | Record a timestamp at the beginning of an action, and when the action
-- completes call 'updateFileMonitor' passing it the timestamp.
-- See 'updateFileMonitor' for details.
beginUpdateFileMonitor :: IO MonitorTimestamp
beginUpdateFileMonitor :: IO MonitorTimestamp
beginUpdateFileMonitor = ModTime -> MonitorTimestamp
MonitorTimestamp (ModTime -> MonitorTimestamp) -> IO ModTime -> IO MonitorTimestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ModTime
getCurTime

-- | Take the snapshot of the monitored files. That is, given the
-- specification of the set of files we need to monitor, inspect the state
-- of the file system now and collect the information we'll need later to
-- determine if anything has changed.
buildMonitorStateFileSet
  :: Maybe MonitorTimestamp
  -- ^ optional: timestamp
  -- of the start of the action
  -> FileHashCache
  -- ^ existing file hashes
  -> FilePath
  -- ^ root directory
  -> [MonitorFilePath]
  -- ^ patterns of interest
  --   relative to root
  -> IO MonitorStateFileSet
buildMonitorStateFileSet :: Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache FilePath
root =
  [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [] []
  where
    go
      :: [MonitorStateFile]
      -> [MonitorStateGlob]
      -> [MonitorFilePath]
      -> IO MonitorStateFileSet
    go :: [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths [] =
      MonitorStateFileSet -> IO MonitorStateFileSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet ([MonitorStateFile] -> [MonitorStateFile]
forall a. [a] -> [a]
reverse [MonitorStateFile]
singlePaths) ([MonitorStateGlob] -> [MonitorStateGlob]
forall a. [a] -> [a]
reverse [MonitorStateGlob]
globPaths))
    go
      ![MonitorStateFile]
singlePaths
      ![MonitorStateGlob]
globPaths
      (MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path : [MonitorFilePath]
monitors) = do
        MonitorStateFile
monitorState <-
          MonitorKindFile
-> MonitorKindDir
-> FilePath
-> MonitorStateFileStatus
-> MonitorStateFile
MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path
            (MonitorStateFileStatus -> MonitorStateFile)
-> IO MonitorStateFileStatus -> IO MonitorStateFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile
              Maybe MonitorTimestamp
mstartTime
              FileHashCache
hashcache
              MonitorKindFile
kindfile
              MonitorKindDir
kinddir
              FilePath
root
              FilePath
path
        [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go (MonitorStateFile
monitorState MonitorStateFile -> [MonitorStateFile] -> [MonitorStateFile]
forall a. a -> [a] -> [a]
: [MonitorStateFile]
singlePaths) [MonitorStateGlob]
globPaths [MonitorFilePath]
monitors
    go
      ![MonitorStateFile]
singlePaths
      ![MonitorStateGlob]
globPaths
      (MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir RootedGlob
globPath : [MonitorFilePath]
monitors) = do
        MonitorStateGlob
monitorState <-
          Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> RootedGlob
-> IO MonitorStateGlob
buildMonitorStateGlob
            Maybe MonitorTimestamp
mstartTime
            FileHashCache
hashcache
            MonitorKindFile
kindfile
            MonitorKindDir
kinddir
            FilePath
root
            RootedGlob
globPath
        [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [MonitorStateFile]
singlePaths (MonitorStateGlob
monitorState MonitorStateGlob -> [MonitorStateGlob] -> [MonitorStateGlob]
forall a. a -> [a] -> [a]
: [MonitorStateGlob]
globPaths) [MonitorFilePath]
monitors

buildMonitorStateFile
  :: Maybe MonitorTimestamp
  -- ^ start time of update
  -> FileHashCache
  -- ^ existing file hashes
  -> MonitorKindFile
  -> MonitorKindDir
  -> FilePath
  -- ^ the root directory
  -> FilePath
  -> IO MonitorStateFileStatus
buildMonitorStateFile :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
path = do
  let abspath :: FilePath
abspath = FilePath
root FilePath -> ShowS
</> FilePath
path
  Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
abspath
  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
abspath
  case (Bool
isFile, MonitorKindFile
kindfile, Bool
isDir, MonitorKindDir
kinddir) of
    (Bool
_, MonitorKindFile
FileNotExists, Bool
_, MonitorKindDir
DirNotExists) ->
      -- we don't need to care if it exists now, since we check at probe time
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateNonExistent
    (Bool
False, MonitorKindFile
_, Bool
False, MonitorKindDir
_) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
    (Bool
True, MonitorKindFile
FileExists, Bool
_, MonitorKindDir
_) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateFileExists
    (Bool
True, MonitorKindFile
FileModTime, Bool
_, MonitorKindDir
_) ->
      MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
        ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
          then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
          else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateFileModTime ModTime
mtime)
    (Bool
True, MonitorKindFile
FileHashed, Bool
_, MonitorKindDir
_) ->
      MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
        ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
          then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
          else do
            HashValue
hash <- FileHashCache -> FilePath -> FilePath -> ModTime -> IO HashValue
getFileHash FileHashCache
hashcache FilePath
abspath FilePath
abspath ModTime
mtime
            MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> HashValue -> MonitorStateFileStatus
MonitorStateFileHashed ModTime
mtime HashValue
hash)
    (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirExists) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateDirExists
    (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirModTime) ->
      MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
        ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
          then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
          else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateDirModTime ModTime
mtime)
    (Bool
False, MonitorKindFile
_, Bool
True, MonitorKindDir
DirNotExists) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
    (Bool
True, MonitorKindFile
FileNotExists, Bool
False, MonitorKindDir
_) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged

-- | If we have a timestamp for the beginning of the update, then any file
-- mtime later than this means that it changed during the update and we ought
-- to consider the file as already changed.
changedDuringUpdate :: Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate :: Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate (Just (MonitorTimestamp ModTime
startTime)) ModTime
mtime =
  ModTime
mtime ModTime -> ModTime -> Bool
forall a. Ord a => a -> a -> Bool
> ModTime
startTime
changedDuringUpdate Maybe MonitorTimestamp
_ ModTime
_ = Bool
False

-- | Much like 'buildMonitorStateFileSet' but for the somewhat complicated case
-- of a file glob.
--
-- This gets used both by 'buildMonitorStateFileSet' when we're taking the
-- file system snapshot, but also by 'probeGlobStatus' as part of checking
-- the monitored (globed) files for changes when we find a whole new subtree.
buildMonitorStateGlob
  :: Maybe MonitorTimestamp
  -- ^ start time of update
  -> FileHashCache
  -- ^ existing file hashes
  -> MonitorKindFile
  -> MonitorKindDir
  -> FilePath
  -- ^ the root directory
  -> RootedGlob
  -- ^ the matching glob
  -> IO MonitorStateGlob
buildMonitorStateGlob :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> RootedGlob
-> IO MonitorStateGlob
buildMonitorStateGlob
  Maybe MonitorTimestamp
mstartTime
  FileHashCache
hashcache
  MonitorKindFile
kindfile
  MonitorKindDir
kinddir
  FilePath
relroot
  (RootedGlob FilePathRoot
globroot Glob
globPath) = do
    FilePath
root <- IO FilePath -> IO FilePath
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
    MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot
      (MonitorStateGlobRel -> MonitorStateGlob)
-> IO MonitorStateGlobRel -> IO MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> Glob
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
        Maybe MonitorTimestamp
mstartTime
        FileHashCache
hashcache
        MonitorKindFile
kindfile
        MonitorKindDir
kinddir
        FilePath
root
        FilePath
"."
        Glob
globPath

buildMonitorStateGlobRel
  :: Maybe MonitorTimestamp
  -- ^ start time of update
  -> FileHashCache
  -- ^ existing file hashes
  -> MonitorKindFile
  -> MonitorKindDir
  -> FilePath
  -- ^ the root directory
  -> FilePath
  -- ^ directory we are examining
  --   relative to the root
  -> Glob
  -- ^ the matching glob
  -> IO MonitorStateGlobRel
buildMonitorStateGlobRel :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> Glob
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
  Maybe MonitorTimestamp
mstartTime
  FileHashCache
hashcache
  MonitorKindFile
kindfile
  MonitorKindDir
kinddir
  FilePath
root
  FilePath
dir
  Glob
globPath = do
    let absdir :: FilePath
absdir = FilePath
root FilePath -> ShowS
</> FilePath
dir
    [FilePath]
dirEntries <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
absdir
    ModTime
dirMTime <- FilePath -> IO ModTime
getModTime FilePath
absdir
    case Glob
globPath of
      GlobDirRecursive{} -> FilePath -> IO MonitorStateGlobRel
forall a. HasCallStack => FilePath -> a
error FilePath
"Monitoring directory-recursive globs (i.e. ../**/...) is currently unsupported"
      GlobDir GlobPieces
glob Glob
globPath' -> do
        [FilePath]
subdirs <-
          (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
subdir -> FilePath -> IO Bool
doesDirectoryExist (FilePath
absdir FilePath -> ShowS
</> FilePath
subdir)) ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
            (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobPieces -> FilePath -> Bool
matchGlobPieces GlobPieces
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateGlobRel)]
subdirStates <-
          [FilePath]
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
subdirs) ((FilePath -> IO (FilePath, MonitorStateGlobRel))
 -> IO [(FilePath, MonitorStateGlobRel)])
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$ \FilePath
subdir -> do
            MonitorStateGlobRel
fstate <-
              Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> Glob
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
                Maybe MonitorTimestamp
mstartTime
                FileHashCache
hashcache
                MonitorKindFile
kindfile
                MonitorKindDir
kinddir
                FilePath
root
                (FilePath
dir FilePath -> ShowS
</> FilePath
subdir)
                Glob
globPath'
            (FilePath, MonitorStateGlobRel)
-> IO (FilePath, MonitorStateGlobRel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
subdir, MonitorStateGlobRel
fstate)
        MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! GlobPieces
-> Glob
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs GlobPieces
glob Glob
globPath' ModTime
dirMTime [(FilePath, MonitorStateGlobRel)]
subdirStates
      GlobFile GlobPieces
glob -> do
        let files :: [FilePath]
files = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobPieces -> FilePath -> Bool
matchGlobPieces GlobPieces
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateFileStatus)]
filesStates <-
          [FilePath]
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
files) ((FilePath -> IO (FilePath, MonitorStateFileStatus))
 -> IO [(FilePath, MonitorStateFileStatus)])
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
            MonitorStateFileStatus
fstate <-
              Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile
                Maybe MonitorTimestamp
mstartTime
                FileHashCache
hashcache
                MonitorKindFile
kindfile
                MonitorKindDir
kinddir
                FilePath
root
                (FilePath
dir FilePath -> ShowS
</> FilePath
file)
            (FilePath, MonitorStateFileStatus)
-> IO (FilePath, MonitorStateFileStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, MonitorStateFileStatus
fstate)
        MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! GlobPieces
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles GlobPieces
glob ModTime
dirMTime [(FilePath, MonitorStateFileStatus)]
filesStates
      Glob
GlobDirTrailing ->
        MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateGlobRel
MonitorStateGlobDirTrailing

-- | We really want to avoid re-hashing files all the time. We already make
-- the assumption that if a file mtime has not changed then we don't need to
-- bother checking if the content hash has changed. We can apply the same
-- assumption when updating the file monitor state. In the typical case of
-- updating a file monitor the set of files is the same or largely the same so
-- we can grab the previously known content hashes with their corresponding
-- mtimes.
type FileHashCache = Map FilePath (ModTime, HashValue)

-- | We declare it a cache hit if the mtime of a file is the same as before.
lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe HashValue
lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe HashValue
lookupFileHashCache FileHashCache
hashcache FilePath
file ModTime
mtime = do
  (ModTime
mtime', HashValue
hash) <- FilePath -> FileHashCache -> Maybe (ModTime, HashValue)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
file FileHashCache
hashcache
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModTime
mtime' ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime)
  HashValue -> Maybe HashValue
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return HashValue
hash

-- | Either get it from the cache or go read the file
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO HashValue
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO HashValue
getFileHash FileHashCache
hashcache FilePath
relfile FilePath
absfile ModTime
mtime =
  case FileHashCache -> FilePath -> ModTime -> Maybe HashValue
lookupFileHashCache FileHashCache
hashcache FilePath
relfile ModTime
mtime of
    Just HashValue
hash -> HashValue -> IO HashValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HashValue
hash
    Maybe HashValue
Nothing -> FilePath -> IO HashValue
readFileHashValue FilePath
absfile

-- | Build a 'FileHashCache' from the previous 'MonitorStateFileSet'. While
-- in principle we could preserve the structure of the previous state, given
-- that the set of files to monitor can change then it's simpler just to throw
-- away the structure and use a finite map.
readCacheFileHashes
  :: (Binary a, Structured a, Binary b, Structured b)
  => FileMonitor a b
  -> IO FileHashCache
readCacheFileHashes :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor =
  FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleDoesNotExist FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
    FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleErrorCall FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
      FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO FileHashCache)
-> IO FileHashCache
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
  -> IO FileHashCache)
 -> IO FileHashCache)
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO FileHashCache)
-> IO FileHashCache
forall a b. (a -> b) -> a -> b
$ \Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res ->
        case Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res of
          Left FilePath
_ -> FileHashCache -> IO FileHashCache
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileHashCache
forall k a. Map k a
Map.empty
          Right (MonitorStateFileSet
msfs, a
_, Either FilePath b
_) -> FileHashCache -> IO FileHashCache
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateFileSet -> FileHashCache
mkFileHashCache MonitorStateFileSet
msfs)
  where
    mkFileHashCache :: MonitorStateFileSet -> FileHashCache
    mkFileHashCache :: MonitorStateFileSet -> FileHashCache
mkFileHashCache (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
      [MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths
        FileHashCache -> FileHashCache -> FileHashCache
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [MonitorStateGlob] -> FileHashCache
collectAllGlobHashes [MonitorStateGlob]
globPaths

    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, HashValue)
    collectAllFileHashes :: [MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths =
      [(FilePath, (ModTime, HashValue))] -> FileHashCache
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (FilePath
fpath, (ModTime
mtime, HashValue
hash))
        | MonitorStateFile
            MonitorKindFile
_
            MonitorKindDir
_
            FilePath
fpath
            (MonitorStateFileHashed ModTime
mtime HashValue
hash) <-
            [MonitorStateFile]
singlePaths
        ]

    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, HashValue)
    collectAllGlobHashes :: [MonitorStateGlob] -> FileHashCache
collectAllGlobHashes [MonitorStateGlob]
globPaths =
      [(FilePath, (ModTime, HashValue))] -> FileHashCache
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (FilePath
fpath, (ModTime
mtime, HashValue
hash))
        | MonitorStateGlob MonitorKindFile
_ MonitorKindDir
_ FilePathRoot
_ MonitorStateGlobRel
gstate <- [MonitorStateGlob]
globPaths
        , (FilePath
fpath, (ModTime
mtime, HashValue
hash)) <- FilePath
-> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]
collectGlobHashes FilePath
"" MonitorStateGlobRel
gstate
        ]

    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]
    collectGlobHashes :: FilePath
-> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]
collectGlobHashes FilePath
dir (MonitorStateGlobDirs GlobPieces
_ Glob
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
      [ (FilePath, (ModTime, HashValue))
res
      | (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
      , (FilePath, (ModTime, HashValue))
res <- FilePath
-> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]
collectGlobHashes (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) MonitorStateGlobRel
fstate
      ]
    collectGlobHashes FilePath
dir (MonitorStateGlobFiles GlobPieces
_ ModTime
_ [(FilePath, MonitorStateFileStatus)]
entries) =
      [ (FilePath
dir FilePath -> ShowS
</> FilePath
fname, (ModTime
mtime, HashValue
hash))
      | (FilePath
fname, MonitorStateFileHashed ModTime
mtime HashValue
hash) <- [(FilePath, MonitorStateFileStatus)]
entries
      ]
    collectGlobHashes FilePath
_dir MonitorStateGlobRel
MonitorStateGlobDirTrailing =
      []

------------------------------------------------------------------------------
-- Utils
--

-- | Within the @root@ directory, check if @file@ has its 'ModTime' is
-- the same as @mtime@, short-circuiting if it is different.
probeFileModificationTime :: FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime :: FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime = do
  Bool
unchanged <- IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ModTime -> IO Bool
checkModificationTimeUnchanged FilePath
root FilePath
file ModTime
mtime
  Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)

-- | Within the @root@ directory, check if @file@ has its 'ModTime' and
-- 'HashValue' is the same as @mtime@ and @hash@, short-circuiting if it is
-- different.
probeFileModificationTimeAndHash
  :: FilePath
  -> FilePath
  -> ModTime
  -> HashValue
  -> ChangedM ()
probeFileModificationTimeAndHash :: FilePath -> FilePath -> ModTime -> HashValue -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime HashValue
hash = do
  Bool
unchanged <-
    IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$
      FilePath -> FilePath -> ModTime -> HashValue -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime HashValue
hash
  Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)

-- | Within the @root@ directory, check if @file@ still exists as a file.
-- If it *does not* exist, short-circuit.
probeFileExistence :: FilePath -> FilePath -> ChangedM ()
probeFileExistence :: FilePath -> FilePath -> ChangedM ()
probeFileExistence FilePath
root FilePath
file = do
  Bool
existsFile <- IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
  Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsFile (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)

-- | Within the @root@ directory, check if @dir@ still exists.
-- If it *does not* exist, short-circuit.
probeDirExistence :: FilePath -> FilePath -> ChangedM ()
probeDirExistence :: FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
dir = do
  Bool
existsDir <- IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
dir)
  Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsDir (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
dir)

-- | Within the @root@ directory, check if @file@ still does not exist.
-- If it *does* exist, short-circuit.
probeFileNonExistence :: FilePath -> FilePath -> ChangedM ()
probeFileNonExistence :: FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file = do
  Bool
existsFile <- IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
  Bool
existsDir <- IO Bool -> ChangedM Bool
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
  Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
existsFile Bool -> Bool -> Bool
|| Bool
existsDir) (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)

-- | Returns @True@ if, inside the @root@ directory, @file@ has the same
-- 'ModTime' as @mtime@.
checkModificationTimeUnchanged
  :: FilePath
  -> FilePath
  -> ModTime
  -> IO Bool
checkModificationTimeUnchanged :: FilePath -> FilePath -> ModTime -> IO Bool
checkModificationTimeUnchanged FilePath
root FilePath
file ModTime
mtime =
  Bool -> IO Bool -> IO Bool
forall a. a -> IO a -> IO a
handleIOException Bool
False (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime')

-- | Returns @True@ if, inside the @root@ directory, @file@ has the
-- same 'ModTime' and 'HashValue' as @mtime and @chash@.
checkFileModificationTimeAndHashUnchanged
  :: FilePath
  -> FilePath
  -> ModTime
  -> HashValue
  -> IO Bool
checkFileModificationTimeAndHashUnchanged :: FilePath -> FilePath -> ModTime -> HashValue -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime HashValue
chash =
  Bool -> IO Bool -> IO Bool
forall a. a -> IO a -> IO a
handleIOException Bool
False (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
    if ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
      then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else do
        HashValue
chash' <- FilePath -> IO HashValue
readFileHashValue (FilePath
root FilePath -> ShowS
</> FilePath
file)
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashValue
chash HashValue -> HashValue -> Bool
forall a. Eq a => a -> a -> Bool
== HashValue
chash')

-- | Given a directory @dir@, return @Nothing@ if its 'ModTime'
-- is the same as @mtime@, and the new 'ModTime' if it is not.
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime FilePath
dir ModTime
mtime =
  Maybe ModTime -> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a. a -> IO a -> IO a
handleIOException Maybe ModTime
forall a. Maybe a
Nothing (IO (Maybe ModTime) -> IO (Maybe ModTime))
-> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime FilePath
dir
    if ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
      then Maybe ModTime -> IO (Maybe ModTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModTime
forall a. Maybe a
Nothing
      else Maybe ModTime -> IO (Maybe ModTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Maybe ModTime
forall a. a -> Maybe a
Just ModTime
mtime')

-- | Run an IO computation, returning the first argument @e@ if there is an 'error'
-- call. ('ErrorCall')
handleErrorCall :: a -> IO a -> IO a
handleErrorCall :: forall a. a -> IO a -> IO a
handleErrorCall a
e = (ErrorCall -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ErrorCall -> IO a
forall {m :: * -> *}. Monad m => ErrorCall -> m a
handler
  where
    handler :: ErrorCall -> m a
handler (ErrorCall FilePath
_) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e

-- | Run an IO computation, returning @e@ if there is any 'IOException'.
--
-- This policy is OK in the file monitor code because it just causes the
-- monitor to report that something changed, and then code reacting to that
-- will normally encounter the same IO exception when it re-runs the action
-- that uses the file.
handleIOException :: a -> IO a -> IO a
handleIOException :: forall a. a -> IO a -> IO a
handleIOException a
e =
  (IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (a -> IOException -> IO a
forall a. a -> IOException -> IO a
anyIOException a
e)
  where
    anyIOException :: a -> IOException -> IO a
    anyIOException :: forall a. a -> IOException -> IO a
anyIOException a
x IOException
_ = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

------------------------------------------------------------------------------
-- Instances
--