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

-- | 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
  MonitorFilePath(..),
  MonitorKindFile(..),
  MonitorKindDir(..),
  FilePathGlob(..),
  monitorFile,
  monitorFileHashed,
  monitorNonExistentFile,
  monitorFileExistence,
  monitorDirectory,
  monitorNonExistentDirectory,
  monitorDirectoryExistence,
  monitorFileOrDirectory,
  monitorFileGlob,
  monitorFileGlobExistence,
  monitorFileSearchPath,
  monitorFileHashedSearchPath,

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

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

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

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

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

import           Distribution.Compat.Time
import           Distribution.Client.Glob
import           Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
import           Distribution.Client.Utils (mergeBy, MergeResult(..))
import           Distribution.Utils.Structured (structuredEncode, Tag (..))
import           System.FilePath
import           System.Directory
import           System.IO

------------------------------------------------------------------------------
-- Types for specifying files to monitor
--


-- | A description of a file (or set of files) to monitor for changes.
--
-- Where file paths are relative they are relative to a common directory
-- (e.g. project root), not necessarily the process current directory.
--
data MonitorFilePath =
     MonitorFile {
       MonitorFilePath -> MonitorKindFile
monitorKindFile :: !MonitorKindFile,
       MonitorFilePath -> MonitorKindDir
monitorKindDir  :: !MonitorKindDir,
       MonitorFilePath -> FilePath
monitorPath     :: !FilePath
     }
   | MonitorFileGlob {
       monitorKindFile :: !MonitorKindFile,
       monitorKindDir  :: !MonitorKindDir,
       MonitorFilePath -> FilePathGlob
monitorPathGlob :: !FilePathGlob
     }
  deriving (MonitorFilePath -> MonitorFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorFilePath -> MonitorFilePath -> Bool
$c/= :: MonitorFilePath -> MonitorFilePath -> Bool
== :: MonitorFilePath -> MonitorFilePath -> Bool
$c== :: MonitorFilePath -> MonitorFilePath -> Bool
Eq, Hash -> MonitorFilePath -> ShowS
[MonitorFilePath] -> ShowS
MonitorFilePath -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorFilePath] -> ShowS
$cshowList :: [MonitorFilePath] -> ShowS
show :: MonitorFilePath -> FilePath
$cshow :: MonitorFilePath -> FilePath
showsPrec :: Hash -> MonitorFilePath -> ShowS
$cshowsPrec :: Hash -> MonitorFilePath -> ShowS
Show, forall x. Rep MonitorFilePath x -> MonitorFilePath
forall x. MonitorFilePath -> Rep MonitorFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorFilePath x -> MonitorFilePath
$cfrom :: forall x. MonitorFilePath -> Rep MonitorFilePath x
Generic)

data MonitorKindFile = FileExists
                     | FileModTime
                     | FileHashed
                     | FileNotExists
  deriving (MonitorKindFile -> MonitorKindFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorKindFile -> MonitorKindFile -> Bool
$c/= :: MonitorKindFile -> MonitorKindFile -> Bool
== :: MonitorKindFile -> MonitorKindFile -> Bool
$c== :: MonitorKindFile -> MonitorKindFile -> Bool
Eq, Hash -> MonitorKindFile -> ShowS
[MonitorKindFile] -> ShowS
MonitorKindFile -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindFile] -> ShowS
$cshowList :: [MonitorKindFile] -> ShowS
show :: MonitorKindFile -> FilePath
$cshow :: MonitorKindFile -> FilePath
showsPrec :: Hash -> MonitorKindFile -> ShowS
$cshowsPrec :: Hash -> MonitorKindFile -> ShowS
Show, forall x. Rep MonitorKindFile x -> MonitorKindFile
forall x. MonitorKindFile -> Rep MonitorKindFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorKindFile x -> MonitorKindFile
$cfrom :: forall x. MonitorKindFile -> Rep MonitorKindFile x
Generic)

data MonitorKindDir  = DirExists
                     | DirModTime
                     | DirNotExists
  deriving (MonitorKindDir -> MonitorKindDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorKindDir -> MonitorKindDir -> Bool
$c/= :: MonitorKindDir -> MonitorKindDir -> Bool
== :: MonitorKindDir -> MonitorKindDir -> Bool
$c== :: MonitorKindDir -> MonitorKindDir -> Bool
Eq, Hash -> MonitorKindDir -> ShowS
[MonitorKindDir] -> ShowS
MonitorKindDir -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindDir] -> ShowS
$cshowList :: [MonitorKindDir] -> ShowS
show :: MonitorKindDir -> FilePath
$cshow :: MonitorKindDir -> FilePath
showsPrec :: Hash -> MonitorKindDir -> ShowS
$cshowsPrec :: Hash -> MonitorKindDir -> ShowS
Show, forall x. Rep MonitorKindDir x -> MonitorKindDir
forall x. MonitorKindDir -> Rep MonitorKindDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorKindDir x -> MonitorKindDir
$cfrom :: forall x. MonitorKindDir -> Rep MonitorKindDir x
Generic)

instance Binary MonitorFilePath
instance Binary MonitorKindFile
instance Binary MonitorKindDir

instance Structured MonitorFilePath
instance Structured MonitorKindFile
instance Structured MonitorKindDir

-- | Monitor a single file for changes, based on its modification time.
-- The monitored file is considered to have changed if it no longer
-- exists or if its modification time has changed.
--
monitorFile :: FilePath -> MonitorFilePath
monitorFile :: FilePath -> MonitorFilePath
monitorFile = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirNotExists

-- | Monitor a single file for changes, based on its modification time
-- and content hash. The monitored file is considered to have changed if
-- it no longer exists or if its modification time and content hash have
-- changed.
--
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileHashed MonitorKindDir
DirNotExists

-- | Monitor a single non-existent file for changes. The monitored file
-- is considered to have changed if it exists.
--
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirNotExists

-- | Monitor a single file for existence only. The monitored file is
-- considered to have changed if it no longer exists.
--
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileExists MonitorKindDir
DirNotExists

-- | Monitor a single directory for changes, based on its modification
-- time. The monitored directory is considered to have changed if it no
-- longer exists or if its modification time has changed.
--
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirModTime

-- | Monitor a single non-existent directory for changes.  The monitored
-- directory is considered to have changed if it exists.
--
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
-- Just an alias for monitorNonExistentFile, since you can't
-- tell the difference between a non-existent directory and
-- a non-existent file :)
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
monitorNonExistentDirectory = FilePath -> MonitorFilePath
monitorNonExistentFile

-- | Monitor a single directory for existence. The monitored directory is
-- considered to have changed only if it no longer exists.
--
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirExists

-- | Monitor a single file or directory for changes, based on its modification
-- time. The monitored file is considered to have changed if it no longer
-- exists or if its modification time has changed.
--
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirModTime

-- | Monitor a set of files (or directories) identified by a file glob.
-- The monitored glob is considered to have changed if the set of files
-- matching the glob changes (i.e. creations or deletions), or for files if the
-- modification time and content hash of any matching file has changed.
--
monitorFileGlob :: FilePathGlob -> MonitorFilePath
monitorFileGlob :: FilePathGlob -> MonitorFilePath
monitorFileGlob = MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileHashed MonitorKindDir
DirExists

-- | Monitor a set of files (or directories) identified by a file glob for
-- existence only. The monitored glob is considered to have changed if the set
-- of files matching the glob changes (i.e. creations or deletions).
--
monitorFileGlobExistence :: FilePathGlob -> MonitorFilePath
monitorFileGlobExistence :: FilePathGlob -> MonitorFilePath
monitorFileGlobExistence = MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileExists MonitorKindDir
DirExists

-- | Creates a list of files to monitor when you search for a file which
-- unsuccessfully looked in @notFoundAtPaths@ before finding it at
-- @foundAtPath@.
monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileSearchPath [FilePath]
notFoundAtPaths FilePath
foundAtPath =
    FilePath -> MonitorFilePath
monitorFile FilePath
foundAtPath
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorNonExistentFile [FilePath]
notFoundAtPaths

-- | Similar to 'monitorFileSearchPath', but also instructs us to
-- monitor the hash of the found file.
monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
monitorFileHashedSearchPath [FilePath]
notFoundAtPaths FilePath
foundAtPath =
    FilePath -> MonitorFilePath
monitorFileHashed FilePath
foundAtPath
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MonitorFilePath
monitorNonExistentFile [FilePath]
notFoundAtPaths


------------------------------------------------------------------------------
-- 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 (Hash -> MonitorStateFileSet -> ShowS
[MonitorStateFileSet] -> ShowS
MonitorStateFileSet -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileSet] -> ShowS
$cshowList :: [MonitorStateFileSet] -> ShowS
show :: MonitorStateFileSet -> FilePath
$cshow :: MonitorStateFileSet -> FilePath
showsPrec :: Hash -> MonitorStateFileSet -> ShowS
$cshowsPrec :: Hash -> MonitorStateFileSet -> ShowS
Show, 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
$cto :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
$cfrom :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
Generic)

instance Binary MonitorStateFileSet
instance Structured MonitorStateFileSet

type Hash = Int

-- | 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 (Hash -> MonitorStateFile -> ShowS
[MonitorStateFile] -> ShowS
MonitorStateFile -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFile] -> ShowS
$cshowList :: [MonitorStateFile] -> ShowS
show :: MonitorStateFile -> FilePath
$cshow :: MonitorStateFile -> FilePath
showsPrec :: Hash -> MonitorStateFile -> ShowS
$cshowsPrec :: Hash -> MonitorStateFile -> ShowS
Show, 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
$cto :: forall x. Rep MonitorStateFile x -> MonitorStateFile
$cfrom :: forall x. MonitorStateFile -> Rep MonitorStateFile x
Generic)

data MonitorStateFileStatus
   = MonitorStateFileExists
   | MonitorStateFileModTime !ModTime        -- ^ cached file mtime
   | MonitorStateFileHashed  !ModTime !Hash  -- ^ cached mtime and content hash
   | MonitorStateDirExists
   | MonitorStateDirModTime  !ModTime        -- ^ cached dir mtime
   | MonitorStateNonExistent
   | MonitorStateAlreadyChanged
  deriving (Hash -> MonitorStateFileStatus -> ShowS
[MonitorStateFileStatus] -> ShowS
MonitorStateFileStatus -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileStatus] -> ShowS
$cshowList :: [MonitorStateFileStatus] -> ShowS
show :: MonitorStateFileStatus -> FilePath
$cshow :: MonitorStateFileStatus -> FilePath
showsPrec :: Hash -> MonitorStateFileStatus -> ShowS
$cshowsPrec :: Hash -> MonitorStateFileStatus -> ShowS
Show, 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
$cto :: forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
$cfrom :: forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
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 (Hash -> MonitorStateGlob -> ShowS
[MonitorStateGlob] -> ShowS
MonitorStateGlob -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlob] -> ShowS
$cshowList :: [MonitorStateGlob] -> ShowS
show :: MonitorStateGlob -> FilePath
$cshow :: MonitorStateGlob -> FilePath
showsPrec :: Hash -> MonitorStateGlob -> ShowS
$cshowsPrec :: Hash -> MonitorStateGlob -> ShowS
Show, 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
$cto :: forall x. Rep MonitorStateGlob x -> MonitorStateGlob
$cfrom :: forall x. MonitorStateGlob -> Rep MonitorStateGlob x
Generic)

data MonitorStateGlobRel
   = MonitorStateGlobDirs
       !Glob !FilePathGlobRel
       !ModTime
       ![(FilePath, MonitorStateGlobRel)] -- invariant: sorted

   | MonitorStateGlobFiles
       !Glob
       !ModTime
       ![(FilePath, MonitorStateFileStatus)] -- invariant: sorted

   | MonitorStateGlobDirTrailing
  deriving (Hash -> MonitorStateGlobRel -> ShowS
[MonitorStateGlobRel] -> ShowS
MonitorStateGlobRel -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlobRel] -> ShowS
$cshowList :: [MonitorStateGlobRel] -> ShowS
show :: MonitorStateGlobRel -> FilePath
$cshow :: MonitorStateGlobRel -> FilePath
showsPrec :: Hash -> MonitorStateGlobRel -> ShowS
$cshowsPrec :: Hash -> MonitorStateGlobRel -> ShowS
Show, 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
$cto :: forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
$cfrom :: forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
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) =
  forall a b. (a -> b) -> [a] -> [b]
map MonitorStateFile -> MonitorFilePath
getSinglePath [MonitorStateFile]
singlePaths forall a. [a] -> [a] -> [a]
++ 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 -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root forall a b. (a -> b) -> a -> b
$
        case MonitorStateGlobRel
gstate of
          MonitorStateGlobDirs  Glob
glob FilePathGlobRel
globs ModTime
_ [(FilePath, MonitorStateGlobRel)]
_ -> Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir  Glob
glob FilePathGlobRel
globs
          MonitorStateGlobFiles Glob
glob       ModTime
_ [(FilePath, MonitorStateFileStatus)]
_ -> Glob -> FilePathGlobRel
GlobFile Glob
glob
          MonitorStateGlobRel
MonitorStateGlobDirTrailing          -> FilePathGlobRel
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 {

       -- | The file where this 'FileMonitor' should store its state.
       --
       forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile :: FilePath,

       -- | 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 -> a -> a -> Bool
fileMonitorKeyValid :: a -> a -> 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.
       --
       forall a b. FileMonitor a b -> Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
  }

-- | 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 = forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
FileMonitor FilePath
path 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 Hash -> MonitorChanged a b -> ShowS
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Hash -> 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
showList :: [MonitorChanged a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
show :: MonitorChanged a b -> FilePath
$cshow :: forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
showsPrec :: Hash -> MonitorChanged a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Hash -> 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
forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorChangedReason a -> MonitorChangedReason a -> Bool
$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
Eq, Hash -> MonitorChangedReason a -> ShowS
forall a. Show a => Hash -> MonitorChangedReason a -> ShowS
forall a. Show a => [MonitorChangedReason a] -> ShowS
forall a. Show a => MonitorChangedReason a -> FilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorChangedReason a] -> ShowS
$cshowList :: forall a. Show a => [MonitorChangedReason a] -> ShowS
show :: MonitorChangedReason a -> FilePath
$cshow :: forall a. Show a => MonitorChangedReason a -> FilePath
showsPrec :: Hash -> MonitorChangedReason a -> ShowS
$cshowsPrec :: forall a. Show a => Hash -> MonitorChangedReason a -> ShowS
Show, 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
<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
$c<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
fmap :: forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
$cfmap :: forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
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 :: a -> a -> Bool
fileMonitorKeyValid :: forall a b. FileMonitor a b -> a -> a -> Bool
fileMonitorKeyValid,
                          Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged :: forall a b. FileMonitor a b -> 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

    forall a. a -> IO a -> IO a
handleDoesNotExist (forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged forall a. MonitorChangedReason a
MonitorFirstRun) forall a b. (a -> b) -> a -> b
$
    forall a. a -> IO a -> IO a
handleErrorCall    (forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged forall a. MonitorChangedReason a
MonitorCorruptCache) forall a b. (a -> b) -> 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 forall a b. (a -> b) -> a -> b
$
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
reason)
          Maybe (MonitorChangedReason a)
Nothing     -> case Either FilePath b
cachedResult of
                            Left FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged forall a. MonitorChangedReason a
MonitorCorruptCache)
                            Right b
cr -> forall (m :: * -> *) a. Monad m => a -> m a
return (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
              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
              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  -> forall (m :: * -> *) a. Monad m => a -> m a
return (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)
      = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a. a -> MonitorChangedReason a
MonitoredValueChanged a
cachedKey))
      | Bool
otherwise
      = forall (m :: * -> *) a. Monad m => a -> m a
return 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 ->
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (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
          forall (m :: * -> *). Monad m => CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
cacheStatus forall a b. (a -> b) -> a -> b
$
            case Either FilePath b
cachedResult of
              Left FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Right b
cr -> 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

          forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
         (forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
`runGetOrFail` ByteString
lbs) forall a b. (a -> b) -> a -> b
$ do
            (Tag (a, b, c)
_ :: Tag (a,b,c)) <- forall t. Binary t => Get t
Binary.get
            (a
a :: a) <- forall t. Binary t => Get t
Binary.get
            (b
b :: b) <- forall t. Binary t => Get t
Binary.get
            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)) = forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
pos forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
msg)
      cleanEither (Right (a
_,b
_,b
v))     = 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) ->  forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ByteOffset
pos forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
msg)
       Right (ByteString
lbs', ByteOffset
_, (a
x,b
y)) -> forall a b. b -> Either a b
Right (a
x, b
y, forall {a} {a} {a} {b} {b}.
Show a =>
Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither forall a b. (a -> b) -> a -> b
$ forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
runGetOrFail (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 :: FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile}) Either FilePath (MonitorStateFileSet, a, Either FilePath b) -> IO r
k =
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fileMonitorCacheFile IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
        Either FilePath (MonitorStateFileSet, a, Either FilePath b)
contents <- 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 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 :: FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile} MonitorStateFileSet
fileset a
key b
result =
    FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
fileMonitorCacheFile forall a b. (a -> b) -> a -> b
$
        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) =
  forall a. ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM forall a b. (a -> b) -> a -> b
$ do
    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' <-
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ FilePath -> MonitorStateGlob -> ChangedM MonitorStateGlob
probeMonitorStateGlob FilePath
root MonitorStateGlob
globPath
        | MonitorStateGlob
globPath <- [MonitorStateGlob]
globPaths ]
    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 -> 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
<$ :: forall a b. a -> ChangedM b -> ChangedM a
$c<$ :: forall a b. a -> ChangedM b -> ChangedM a
fmap :: forall a b. (a -> b) -> ChangedM a -> ChangedM b
$cfmap :: forall a b. (a -> b) -> ChangedM a -> ChangedM b
Functor, Functor 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
<* :: forall a b. ChangedM a -> ChangedM b -> ChangedM a
$c<* :: forall a b. ChangedM a -> ChangedM b -> ChangedM a
*> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
$c*> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
liftA2 :: forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
<*> :: forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
$c<*> :: forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
pure :: forall a. a -> ChangedM a
$cpure :: forall a. a -> ChangedM a
Applicative, Applicative 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
return :: forall a. a -> ChangedM a
$creturn :: forall a. a -> ChangedM a
>> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
$c>> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
>>= :: forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
$c>>= :: forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
Monad, Monad ChangedM
forall a. IO a -> ChangedM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> ChangedM a
$cliftIO :: 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) =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ 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 = forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
path

cacheChanged :: ChangedM ()
cacheChanged :: ChangedM ()
cacheChanged = forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM forall a b. (a -> b) -> a -> b
$ 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) =
    forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM (forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (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 ()
_    = 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 Hash
hash ->
        FilePath -> FilePath -> ModTime -> Hash -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Hash
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 ->
        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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 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
_ ->
        forall a. ShowS -> ChangedM a -> ChangedM a
mapChangedFile (FilePath
root FilePath -> ShowS
</>) forall a b. (a -> b) -> a -> b
$
        MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot 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 Glob
glob FilePathGlobRel
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children) = do
    Maybe ModTime
change <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t 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
               forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fname, MonitorStateGlobRel
fstate')
          | (FilePath
fname, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
children ]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
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 <- 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 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
subdir)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
               forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

        [(FilePath, MonitorStateGlobRel)]
children' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult forall a b. (a -> b) -> a -> b
$
                          forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(FilePath
path1,MonitorStateGlobRel
_) FilePath
path2 -> forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
                                  [(FilePath, MonitorStateGlobRel)]
children
                                  (forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath ModTime
mtime' [(FilePath, MonitorStateGlobRel)]
children'
        -- 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.

  where
    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
        [] -> 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]
_) -> forall a. FilePath -> ChangedM a
somethingChanged FilePath
file

    -- Only in current filesystem state (directory added)
    probeMergeResult (OnlyInRight FilePath
path) = do
      MonitorStateGlobRel
fstate <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel forall a. Maybe a
Nothing forall k a. Map k a
Map.empty
                           MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
path) FilePathGlobRel
globPath
      case FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate of
        (FilePath
file:[FilePath]
_) -> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
      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 Glob
_ ModTime
_   [(FilePath, MonitorStateFileStatus)]
entries) =
      [ FilePath
dir FilePath -> ShowS
</> FilePath
fname | (FilePath
fname, MonitorStateFileStatus
_) <- [(FilePath, MonitorStateFileStatus)]
entries ]
    allMatchingFiles FilePath
dir (MonitorStateGlobDirs  Glob
_ FilePathGlobRel
_ 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 Glob
glob ModTime
mtime [(FilePath, MonitorStateFileStatus)]
children) = do
    Maybe ModTime
change <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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     -> 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 <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
               forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

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

    -- Check that none of the children have changed
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(FilePath, MonitorStateFileStatus)]
children 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


    forall (m :: * -> *) a. Monad m => a -> m a
return (Glob
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles Glob
glob ModTime
mtime' [(FilePath, MonitorStateFileStatus)]
children)
    -- Again, we don't force a cache rewrite with 'cacheChanged', but we do use
    -- the new mtime' if any.
  where
    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
_            -> 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
_) -> forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
      OnlyInRight FilePath
path      -> forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)

probeMonitorStateGlobRel MonitorKindFile
_ MonitorKindDir
_ FilePath
_ FilePath
_ MonitorStateGlobRel
MonitorStateGlobDirTrailing =
    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 <- 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
    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 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 [] =
      forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet (forall a. [a] -> [a]
reverse [MonitorStateFile]
singlePaths) (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
                  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 forall a. a -> [a] -> [a]
: [MonitorStateFile]
singlePaths) [MonitorStateGlob]
globPaths [MonitorFilePath]
monitors

    go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths
       (MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathGlob
globPath : [MonitorFilePath]
monitors) = do
      MonitorStateGlob
monitorState <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePathGlob
-> IO MonitorStateGlob
buildMonitorStateGlob Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache
                                            MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePathGlob
globPath
      [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [MonitorStateFile]
singlePaths (MonitorStateGlob
monitorState 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
        forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateNonExistent

      (Bool
False, MonitorKindFile
_, Bool
False, MonitorKindDir
_) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged

      (Bool
True, MonitorKindFile
FileExists, Bool
_, MonitorKindDir
_)  ->
        forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateFileExists

      (Bool
True, MonitorKindFile
FileModTime, Bool
_, MonitorKindDir
_) ->
        forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged 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 forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateFileModTime ModTime
mtime)

      (Bool
True, MonitorKindFile
FileHashed, Bool
_, MonitorKindDir
_) ->
        forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged 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 forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else do Hash
hash <- FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
getFileHash FileHashCache
hashcache FilePath
abspath FilePath
abspath ModTime
mtime
                    forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Hash -> MonitorStateFileStatus
MonitorStateFileHashed ModTime
mtime Hash
hash)

      (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirExists) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateDirExists

      (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirModTime) ->
        forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged 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 forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateDirModTime ModTime
mtime)

      (Bool
False, MonitorKindFile
_, Bool
True,  MonitorKindDir
DirNotExists) -> forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
      (Bool
True, MonitorKindFile
FileNotExists, Bool
False, MonitorKindDir
_) -> 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 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
                      -> FilePathGlob -- ^ the matching glob
                      -> IO MonitorStateGlob
buildMonitorStateGlob :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePathGlob
-> IO MonitorStateGlob
buildMonitorStateGlob Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
relroot
                      (FilePathGlob FilePathRoot
globroot FilePathGlobRel
globPath) = do
    FilePath
root <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
        Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"." FilePathGlobRel
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
                         -> FilePathGlobRel -- ^ the matching glob
                         -> IO MonitorStateGlobRel
buildMonitorStateGlobRel :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
                         FilePath
dir FilePathGlobRel
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 FilePathGlobRel
globPath of
      GlobDir Glob
glob FilePathGlobRel
globPath' -> do
        [FilePath]
subdirs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
subdir -> FilePath -> IO Bool
doesDirectoryExist (FilePath
absdir FilePath -> ShowS
</> FilePath
subdir))
                 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateGlobRel)]
subdirStates <-
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall a. Ord a => [a] -> [a]
sort [FilePath]
subdirs) forall a b. (a -> b) -> a -> b
$ \FilePath
subdir -> do
            MonitorStateGlobRel
fstate <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
                        Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
                        (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) FilePathGlobRel
globPath'
            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
subdir, MonitorStateGlobRel
fstate)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath' ModTime
dirMTime [(FilePath, MonitorStateGlobRel)]
subdirStates

      GlobFile Glob
glob -> do
        let files :: [FilePath]
files = forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateFileStatus)]
filesStates <-
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall a. Ord a => [a] -> [a]
sort [FilePath]
files) 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)
            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, MonitorStateFileStatus
fstate)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Glob
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles Glob
glob ModTime
dirMTime [(FilePath, MonitorStateFileStatus)]
filesStates

      FilePathGlobRel
GlobDirTrailing ->
        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, Hash)

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

-- | Either get it from the cache or go read the file
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
getFileHash FileHashCache
hashcache FilePath
relfile FilePath
absfile ModTime
mtime =
    case FileHashCache -> FilePath -> ModTime -> Maybe Hash
lookupFileHashCache FileHashCache
hashcache FilePath
relfile ModTime
mtime of
      Just Hash
hash -> forall (m :: * -> *) a. Monad m => a -> m a
return Hash
hash
      Maybe Hash
Nothing   -> FilePath -> IO Hash
readFileHash 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 =
    forall a. a -> IO a -> IO a
handleDoesNotExist forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$
    forall a. a -> IO a -> IO a
handleErrorCall    forall k a. Map k a
Map.empty forall a b. (a -> b) -> 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 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
_             -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty
        Right (MonitorStateFileSet
msfs, a
_, Either FilePath b
_) -> 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
        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, Hash)
    collectAllFileHashes :: [MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (FilePath
fpath, (ModTime
mtime, Hash
hash))
                   | MonitorStateFile MonitorKindFile
_ MonitorKindDir
_ FilePath
fpath
                       (MonitorStateFileHashed ModTime
mtime Hash
hash) <- [MonitorStateFile]
singlePaths ]

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

    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
collectGlobHashes FilePath
dir (MonitorStateGlobDirs Glob
_ FilePathGlobRel
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
      [ (FilePath, (ModTime, Hash))
res
      | (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
      , (FilePath, (ModTime, Hash))
res <- FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
collectGlobHashes (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) MonitorStateGlobRel
fstate ]

    collectGlobHashes FilePath
dir (MonitorStateGlobFiles  Glob
_ ModTime
_ [(FilePath, MonitorStateFileStatus)]
entries) =
      [ (FilePath
dir FilePath -> ShowS
</> FilePath
fname, (ModTime
mtime, Hash
hash))
      | (FilePath
fname, MonitorStateFileHashed ModTime
mtime Hash
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ModTime -> IO Bool
checkModificationTimeUnchanged FilePath
root FilePath
file ModTime
mtime
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)

-- | Within the @root@ directory, check if @file@ has its 'ModTime' and
-- 'Hash' is the same as @mtime@ and @hash@, short-circuiting if it is
-- different.
probeFileModificationTimeAndHash :: FilePath -> FilePath -> ModTime -> Hash
                                 -> ChangedM ()
probeFileModificationTimeAndHash :: FilePath -> FilePath -> ModTime -> Hash -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Hash
hash = do
    Bool
unchanged <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      FilePath -> FilePath -> ModTime -> Hash -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime Hash
hash
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsFile (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  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
dir)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsDir (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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
    Bool
existsDir  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
existsFile Bool -> Bool -> Bool
|| Bool
existsDir) (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 =
  forall a. a -> IO a -> IO a
handleIOException Bool
False forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
    forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime
mtime forall a. Eq a => a -> a -> Bool
== ModTime
mtime')

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

-- | Read a non-cryptographic hash of a @file@.
readFileHash :: FilePath -> IO Hash
readFileHash :: FilePath -> IO Hash
readFileHash FilePath
file =
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
file IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
      forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Hash
Hashable.hash forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
BS.hGetContents Handle
hnd

-- | 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 =
  forall a. a -> IO a -> IO a
handleIOException forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime FilePath
dir
    if ModTime
mtime forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall {m :: * -> *}. Monad m => ErrorCall -> m a
handler where
#if MIN_VERSION_base(4,9,0)
    handler :: ErrorCall -> m a
handler (ErrorCallWithLocation FilePath
_ FilePath
_) = forall (m :: * -> *) a. Monad m => a -> m a
return a
e
#else
    handler (ErrorCall _) = return e
#endif


-- | 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 =
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return a
x


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