{-# 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
(MonitorFilePath -> MonitorFilePath -> Bool)
-> (MonitorFilePath -> MonitorFilePath -> Bool)
-> Eq MonitorFilePath
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, Int -> MonitorFilePath -> ShowS
[MonitorFilePath] -> ShowS
MonitorFilePath -> FilePath
(Int -> MonitorFilePath -> ShowS)
-> (MonitorFilePath -> FilePath)
-> ([MonitorFilePath] -> ShowS)
-> Show MonitorFilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorFilePath] -> ShowS
$cshowList :: [MonitorFilePath] -> ShowS
show :: MonitorFilePath -> FilePath
$cshow :: MonitorFilePath -> FilePath
showsPrec :: Int -> MonitorFilePath -> ShowS
$cshowsPrec :: Int -> MonitorFilePath -> ShowS
Show, (forall x. MonitorFilePath -> Rep MonitorFilePath x)
-> (forall x. Rep MonitorFilePath x -> MonitorFilePath)
-> Generic MonitorFilePath
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
(MonitorKindFile -> MonitorKindFile -> Bool)
-> (MonitorKindFile -> MonitorKindFile -> Bool)
-> Eq MonitorKindFile
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, Int -> MonitorKindFile -> ShowS
[MonitorKindFile] -> ShowS
MonitorKindFile -> FilePath
(Int -> MonitorKindFile -> ShowS)
-> (MonitorKindFile -> FilePath)
-> ([MonitorKindFile] -> ShowS)
-> Show MonitorKindFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindFile] -> ShowS
$cshowList :: [MonitorKindFile] -> ShowS
show :: MonitorKindFile -> FilePath
$cshow :: MonitorKindFile -> FilePath
showsPrec :: Int -> MonitorKindFile -> ShowS
$cshowsPrec :: Int -> MonitorKindFile -> ShowS
Show, (forall x. MonitorKindFile -> Rep MonitorKindFile x)
-> (forall x. Rep MonitorKindFile x -> MonitorKindFile)
-> Generic MonitorKindFile
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
(MonitorKindDir -> MonitorKindDir -> Bool)
-> (MonitorKindDir -> MonitorKindDir -> Bool) -> Eq MonitorKindDir
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, Int -> MonitorKindDir -> ShowS
[MonitorKindDir] -> ShowS
MonitorKindDir -> FilePath
(Int -> MonitorKindDir -> ShowS)
-> (MonitorKindDir -> FilePath)
-> ([MonitorKindDir] -> ShowS)
-> Show MonitorKindDir
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindDir] -> ShowS
$cshowList :: [MonitorKindDir] -> ShowS
show :: MonitorKindDir -> FilePath
$cshow :: MonitorKindDir -> FilePath
showsPrec :: Int -> MonitorKindDir -> ShowS
$cshowsPrec :: Int -> MonitorKindDir -> ShowS
Show, (forall x. MonitorKindDir -> Rep MonitorKindDir x)
-> (forall x. Rep MonitorKindDir x -> MonitorKindDir)
-> Generic MonitorKindDir
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
  MonitorFilePath -> [MonitorFilePath] -> [MonitorFilePath]
forall a. a -> [a] -> [a]
: (FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
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
  MonitorFilePath -> [MonitorFilePath] -> [MonitorFilePath]
forall a. a -> [a] -> [a]
: (FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
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 (Int -> MonitorStateFileSet -> ShowS
[MonitorStateFileSet] -> ShowS
MonitorStateFileSet -> FilePath
(Int -> MonitorStateFileSet -> ShowS)
-> (MonitorStateFileSet -> FilePath)
-> ([MonitorStateFileSet] -> ShowS)
-> Show MonitorStateFileSet
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileSet] -> ShowS
$cshowList :: [MonitorStateFileSet] -> ShowS
show :: MonitorStateFileSet -> FilePath
$cshow :: MonitorStateFileSet -> FilePath
showsPrec :: Int -> MonitorStateFileSet -> ShowS
$cshowsPrec :: Int -> MonitorStateFileSet -> ShowS
Show, (forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x)
-> (forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet)
-> Generic MonitorStateFileSet
forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 (Int -> MonitorStateFile -> ShowS
[MonitorStateFile] -> ShowS
MonitorStateFile -> FilePath
(Int -> MonitorStateFile -> ShowS)
-> (MonitorStateFile -> FilePath)
-> ([MonitorStateFile] -> ShowS)
-> Show MonitorStateFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFile] -> ShowS
$cshowList :: [MonitorStateFile] -> ShowS
show :: MonitorStateFile -> FilePath
$cshow :: MonitorStateFile -> FilePath
showsPrec :: Int -> MonitorStateFile -> ShowS
$cshowsPrec :: Int -> MonitorStateFile -> ShowS
Show, (forall x. MonitorStateFile -> Rep MonitorStateFile x)
-> (forall x. Rep MonitorStateFile x -> MonitorStateFile)
-> Generic MonitorStateFile
forall x. Rep MonitorStateFile x -> MonitorStateFile
forall x. MonitorStateFile -> Rep MonitorStateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 (Int -> MonitorStateFileStatus -> ShowS
[MonitorStateFileStatus] -> ShowS
MonitorStateFileStatus -> FilePath
(Int -> MonitorStateFileStatus -> ShowS)
-> (MonitorStateFileStatus -> FilePath)
-> ([MonitorStateFileStatus] -> ShowS)
-> Show MonitorStateFileStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileStatus] -> ShowS
$cshowList :: [MonitorStateFileStatus] -> ShowS
show :: MonitorStateFileStatus -> FilePath
$cshow :: MonitorStateFileStatus -> FilePath
showsPrec :: Int -> MonitorStateFileStatus -> ShowS
$cshowsPrec :: Int -> MonitorStateFileStatus -> ShowS
Show, (forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x)
-> (forall x.
    Rep MonitorStateFileStatus x -> MonitorStateFileStatus)
-> Generic MonitorStateFileStatus
forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 (Int -> MonitorStateGlob -> ShowS
[MonitorStateGlob] -> ShowS
MonitorStateGlob -> FilePath
(Int -> MonitorStateGlob -> ShowS)
-> (MonitorStateGlob -> FilePath)
-> ([MonitorStateGlob] -> ShowS)
-> Show MonitorStateGlob
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlob] -> ShowS
$cshowList :: [MonitorStateGlob] -> ShowS
show :: MonitorStateGlob -> FilePath
$cshow :: MonitorStateGlob -> FilePath
showsPrec :: Int -> MonitorStateGlob -> ShowS
$cshowsPrec :: Int -> MonitorStateGlob -> ShowS
Show, (forall x. MonitorStateGlob -> Rep MonitorStateGlob x)
-> (forall x. Rep MonitorStateGlob x -> MonitorStateGlob)
-> Generic MonitorStateGlob
forall x. Rep MonitorStateGlob x -> MonitorStateGlob
forall x. MonitorStateGlob -> Rep MonitorStateGlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 (Int -> MonitorStateGlobRel -> ShowS
[MonitorStateGlobRel] -> ShowS
MonitorStateGlobRel -> FilePath
(Int -> MonitorStateGlobRel -> ShowS)
-> (MonitorStateGlobRel -> FilePath)
-> ([MonitorStateGlobRel] -> ShowS)
-> Show MonitorStateGlobRel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlobRel] -> ShowS
$cshowList :: [MonitorStateGlobRel] -> ShowS
show :: MonitorStateGlobRel -> FilePath
$cshow :: MonitorStateGlobRel -> FilePath
showsPrec :: Int -> MonitorStateGlobRel -> ShowS
$cshowsPrec :: Int -> MonitorStateGlobRel -> ShowS
Show, (forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x)
-> (forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel)
-> Generic MonitorStateGlobRel
forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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) =
  (MonitorStateFile -> MonitorFilePath)
-> [MonitorStateFile] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateFile -> MonitorFilePath
getSinglePath [MonitorStateFile]
singlePaths [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++ (MonitorStateGlob -> MonitorFilePath)
-> [MonitorStateGlob] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateGlob -> MonitorFilePath
getGlobPath [MonitorStateGlob]
globPaths
  where
    getSinglePath :: MonitorStateFile -> MonitorFilePath
    getSinglePath :: MonitorStateFile -> MonitorFilePath
getSinglePath (MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath MonitorStateFileStatus
_) =
      MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath

    getGlobPath :: MonitorStateGlob -> MonitorFilePath
    getGlobPath :: MonitorStateGlob -> MonitorFilePath
getGlobPath (MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
root MonitorStateGlobRel
gstate) =
      MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir (FilePathGlob -> MonitorFilePath)
-> FilePathGlob -> MonitorFilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root (FilePathGlobRel -> FilePathGlob)
-> FilePathGlobRel -> FilePathGlob
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.
       --
       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.
       --
       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.
       --
       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 :: FilePath -> FileMonitor a b
newFileMonitor FilePath
path = FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
FileMonitor FilePath
path a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Bool
False

-- | The result of 'checkFileMonitorChanged': either the monitored files or
-- value changed (and it tells us which it was) or nothing changed and we get
-- the cached result.
--
data MonitorChanged a b =
     -- | The monitored files and value did not change. The cached result is
     -- @b@.
     --
     -- The set of monitored files is also returned. This is useful
     -- for composing or nesting 'FileMonitor's.
     MonitorUnchanged b [MonitorFilePath]

     -- | The monitor found that something changed. The reason is given.
     --
   | MonitorChanged (MonitorChangedReason a)
  deriving Int -> MonitorChanged a b -> ShowS
[MonitorChanged a b] -> ShowS
MonitorChanged a b -> FilePath
(Int -> MonitorChanged a b -> ShowS)
-> (MonitorChanged a b -> FilePath)
-> ([MonitorChanged a b] -> ShowS)
-> Show (MonitorChanged a b)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
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 :: Int -> MonitorChanged a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
Show

-- | What kind of change 'checkFileMonitorChanged' detected.
--
data MonitorChangedReason a =

     -- | One of the files changed (existence, file type, mtime or file
     -- content, depending on the 'MonitorFilePath' in question)
     MonitoredFileChanged FilePath

     -- | The pure input value changed.
     --
     -- The previous cached key value is also returned. This is sometimes
     -- useful when using a 'fileMonitorKeyValid' function that is not simply
     -- '(==)', when invalidation can be partial. In such cases it can make
     -- sense to 'updateFileMonitor' with a key value that's a combination of
     -- the new and old (e.g. set union).
   | MonitoredValueChanged a

     -- | There was no saved monitor state, cached value etc. Ie the file
     -- for the 'FileMonitor' does not exist.
   | MonitorFirstRun

     -- | There was existing state, but we could not read it. This typically
     -- happens when the code has changed compared to an existing 'FileMonitor'
     -- cache file and type of the input value or cached value has changed such
     -- that we cannot decode the values. This is completely benign as we can
     -- treat is just as if there were no cache file and re-run.
   | MonitorCorruptCache
  deriving (MonitorChangedReason a -> MonitorChangedReason a -> Bool
(MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> (MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> Eq (MonitorChangedReason a)
forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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, Int -> MonitorChangedReason a -> ShowS
[MonitorChangedReason a] -> ShowS
MonitorChangedReason a -> FilePath
(Int -> MonitorChangedReason a -> ShowS)
-> (MonitorChangedReason a -> FilePath)
-> ([MonitorChangedReason a] -> ShowS)
-> Show (MonitorChangedReason a)
forall a. Show a => Int -> MonitorChangedReason a -> ShowS
forall a. Show a => [MonitorChangedReason a] -> ShowS
forall a. Show a => MonitorChangedReason a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
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 :: Int -> MonitorChangedReason a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MonitorChangedReason a -> ShowS
Show, a -> MonitorChangedReason b -> MonitorChangedReason a
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
(forall a b.
 (a -> b) -> MonitorChangedReason a -> MonitorChangedReason b)
-> (forall a b.
    a -> MonitorChangedReason b -> MonitorChangedReason a)
-> Functor MonitorChangedReason
forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MonitorChangedReason b -> MonitorChangedReason a
$c<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
fmap :: (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 :: 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

    MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleDoesNotExist (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorFirstRun) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
    MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleErrorCall    (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
    FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
  -> IO (MonitorChanged a b))
 -> IO (MonitorChanged a b))
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
        (FilePath -> IO (MonitorChanged a b))
-> ((MonitorStateFileSet, a, Either FilePath b)
    -> IO (MonitorChanged a b))
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
_ -> MonitorChanged a b -> IO (MonitorChanged a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache))
               (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
checkStatusCache

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

          | Bool
otherwise
          = a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
              IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
`mplusMaybeT`
            MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult

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

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

    -- Check if any file has changed
    checkFileChange :: MonitorStateFileSet -> a -> Either String b -> IO (Maybe (MonitorChangedReason a))
    checkFileChange :: MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult = do
      Either FilePath (MonitorStateFileSet, CacheChanged)
res <- FilePath
-> MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
probeFileSystem FilePath
root MonitorStateFileSet
cachedFileStatus
      case Either FilePath (MonitorStateFileSet, CacheChanged)
res of
        -- Some monitored file has changed
        Left FilePath
changedPath ->
          Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> Maybe (MonitorChangedReason a)
forall a. a -> Maybe a
Just (FilePath -> MonitorChangedReason a
forall a. FilePath -> MonitorChangedReason a
MonitoredFileChanged (ShowS
normalise FilePath
changedPath)))

        -- No monitored file has changed
        Right (MonitorStateFileSet
cachedFileStatus', CacheChanged
cacheStatus) -> do

          -- But we might still want to update the cache
          CacheChanged -> IO () -> IO ()
forall (m :: * -> *). Monad m => CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
cacheStatus (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            case Either FilePath b
cachedResult of
              Left FilePath
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Right b
cr -> FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
cachedFileStatus' a
cachedKey b
cr

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

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

  in case Either
  (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
partialDecode of
       Left (ByteString
_, ByteOffset
pos, FilePath
msg) ->  FilePath -> Either FilePath (a, b, Either FilePath c)
forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteOffset -> FilePath
forall a. Show a => a -> FilePath
show ByteOffset
pos FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
       Right (ByteString
lbs', ByteOffset
_, (a
x,b
y)) -> (a, b, Either FilePath c)
-> Either FilePath (a, b, Either FilePath c)
forall a b. b -> Either a b
Right (a
x, b
y, Either
  (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall a a a b b.
Show a =>
Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither (Either
   (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
 -> Either FilePath c)
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall a b. (a -> b) -> a -> b
$ Get c
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
runGetOrFail (Get c
forall t. Binary t => Get t
Binary.get :: Binary.Get c) ByteString
lbs')

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

-- | Helper for writing the cache file.
--
-- This determines the type and format of the binary cache file.
--
rewriteCacheFile :: (Binary a, Structured a, Binary b, Structured b)
                 => FileMonitor a b
                 -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile :: 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 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
        (MonitorStateFileSet, a, b) -> ByteString
forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode (MonitorStateFileSet
fileset, a
key, b
result)

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

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

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

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

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

data CacheChanged = CacheChanged | CacheUnchanged

whenCacheChanged :: Monad m => CacheChanged -> m () -> m ()
whenCacheChanged :: CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
CacheChanged m ()
action = m ()
action
whenCacheChanged CacheChanged
CacheUnchanged m ()
_    = () -> 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 Int
hash ->
        FilePath -> FilePath -> ModTime -> Int -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Int
hash

      MonitorStateFileStatus
MonitorStateDirExists ->
        FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
file

      MonitorStateDirModTime ModTime
mtime ->
        FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime

      MonitorStateFileStatus
MonitorStateNonExistent ->
        FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file

      MonitorStateFileStatus
MonitorStateAlreadyChanged ->
        FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file


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

      -- for absolute cases, make the changed file we report absolute too
      FilePathRoot
_ ->
        ShowS -> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a. ShowS -> ChangedM a -> ChangedM a
mapChangedFile (FilePath
root FilePath -> ShowS
</>) (ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob)
-> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a b. (a -> b) -> a -> b
$
        MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"" MonitorStateGlobRel
glob

probeMonitorStateGlobRel :: MonitorKindFile -> MonitorKindDir
                         -> FilePath      -- ^ root path
                         -> FilePath      -- ^ path of the directory we are
                                          --   looking in relative to @root@
                         -> MonitorStateGlobRel
                         -> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel :: MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
dirName
                        (MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children) = do
    Maybe ModTime
change <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
    case Maybe ModTime
change of
      Maybe ModTime
Nothing -> do
        [(FilePath, MonitorStateGlobRel)]
children' <- [ChangedM (FilePath, MonitorStateGlobRel)]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ do MonitorStateGlobRel
fstate' <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel
                            MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
                            (FilePath
dirName FilePath -> ShowS
</> FilePath
fname) MonitorStateGlobRel
fstate
               (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fname, MonitorStateGlobRel
fstate')
          | (FilePath
fname, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
children ]
        MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
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 <- (FilePath -> ChangedM Bool) -> [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
entry -> let subdir :: FilePath
subdir = FilePath
root FilePath -> ShowS
</> FilePath
dirName FilePath -> ShowS
</> FilePath
entry
                                       in IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
subdir)
                 ([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
               ([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

        [(FilePath, MonitorStateGlobRel)]
children' <- (MergeResult (FilePath, MonitorStateGlobRel) FilePath
 -> ChangedM (FilePath, MonitorStateGlobRel))
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult ([MergeResult (FilePath, MonitorStateGlobRel) FilePath]
 -> ChangedM [(FilePath, MonitorStateGlobRel)])
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$
                          ((FilePath, MonitorStateGlobRel) -> FilePath -> Ordering)
-> [(FilePath, MonitorStateGlobRel)]
-> [FilePath]
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(FilePath
path1,MonitorStateGlobRel
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
                                  [(FilePath, MonitorStateGlobRel)]
children
                                  ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
        MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
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
        [] -> (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate)
        -- Strictly speaking we should be returning 'CacheChanged' above
        -- as we should prune the now-missing 'MonitorStateGlobRel'. However
        -- we currently just leave these now-redundant entries in the
        -- cache as they cost no IO and keeping them allows us to avoid
        -- rewriting the cache.
        (FilePath
file:[FilePath]
_) -> FilePath -> ChangedM (FilePath, MonitorStateGlobRel)
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file

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

    -- Found in path
    probeMergeResult (InBoth (FilePath
path, MonitorStateGlobRel
fstate) FilePath
_) = do
      MonitorStateGlobRel
fstate' <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir
                                          FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate
      (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (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 <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
    ModTime
mtime' <- case Maybe ModTime
change of
      Maybe ModTime
Nothing     -> ModTime -> ChangedM ModTime
forall (m :: * -> *) a. Monad m => a -> m a
return ModTime
mtime
      Just ModTime
mtime' -> do
        -- directory modification time changed:
        -- a matching file may have been added or deleted
        [FilePath]
matches <- [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
               ([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))

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

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


    MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (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
_            -> () -> ChangedM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- this is just to be able to accurately report which file changed:
      OnlyInLeft  (FilePath
path, MonitorStateFileStatus
_) -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
      OnlyInRight FilePath
path      -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)

probeMonitorStateGlobRel MonitorKindFile
_ MonitorKindDir
_ FilePath
_ FilePath
_ MonitorStateGlobRel
MonitorStateGlobDirTrailing =
    MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (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 :: FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor a b
monitor FilePath
root Maybe MonitorTimestamp
startTime [MonitorFilePath]
monitorFiles
                  a
cachedKey b
cachedResult = do
    FileHashCache
hashcache <- FileMonitor a b -> IO FileHashCache
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor
    MonitorStateFileSet
msfs <- Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
startTime FileHashCache
hashcache FilePath
root [MonitorFilePath]
monitorFiles
    FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
msfs a
cachedKey b
cachedResult

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

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

-- | Take the snapshot of the monitored files. That is, given the
-- specification of the set of files we need to monitor, inspect the state
-- of the file system now and collect the information we'll need later to
-- determine if anything has changed.
--
buildMonitorStateFileSet :: Maybe MonitorTimestamp -- ^ optional: timestamp
                                              -- of the start of the action
                         -> FileHashCache     -- ^ existing file hashes
                         -> FilePath          -- ^ root directory
                         -> [MonitorFilePath] -- ^ patterns of interest
                                              --   relative to root
                         -> IO MonitorStateFileSet
buildMonitorStateFileSet :: Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache FilePath
root =
    [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [] []
  where
    go :: [MonitorStateFile] -> [MonitorStateGlob]
       -> [MonitorFilePath] -> IO MonitorStateFileSet
    go :: [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths [] =
      MonitorStateFileSet -> IO MonitorStateFileSet
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet ([MonitorStateFile] -> [MonitorStateFile]
forall a. [a] -> [a]
reverse [MonitorStateFile]
singlePaths) ([MonitorStateGlob] -> [MonitorStateGlob]
forall a. [a] -> [a]
reverse [MonitorStateGlob]
globPaths))

    go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths
       (MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path : [MonitorFilePath]
monitors) = do
      MonitorStateFile
monitorState <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> MonitorStateFileStatus
-> MonitorStateFile
MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path
                  (MonitorStateFileStatus -> MonitorStateFile)
-> IO MonitorStateFileStatus -> IO MonitorStateFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache
                                            MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
path
      [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go (MonitorStateFile
monitorState MonitorStateFile -> [MonitorStateFile] -> [MonitorStateFile]
forall a. a -> [a] -> [a]
: [MonitorStateFile]
singlePaths) [MonitorStateGlob]
globPaths [MonitorFilePath]
monitors

    go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths
       (MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir 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 MonitorStateGlob -> [MonitorStateGlob] -> [MonitorStateGlob]
forall a. a -> [a] -> [a]
: [MonitorStateGlob]
globPaths) [MonitorFilePath]
monitors


buildMonitorStateFile :: Maybe MonitorTimestamp -- ^ start time of update
                      -> FileHashCache          -- ^ existing file hashes
                      -> MonitorKindFile -> MonitorKindDir
                      -> FilePath               -- ^ the root directory
                      -> FilePath
                      -> IO MonitorStateFileStatus
buildMonitorStateFile :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
path = do
    let abspath :: FilePath
abspath = FilePath
root FilePath -> ShowS
</> FilePath
path
    Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
abspath
    Bool
isDir  <- FilePath -> IO Bool
doesDirectoryExist FilePath
abspath
    case (Bool
isFile, MonitorKindFile
kindfile, Bool
isDir, MonitorKindDir
kinddir) of
      (Bool
_, MonitorKindFile
FileNotExists, Bool
_, MonitorKindDir
DirNotExists) ->
        -- we don't need to care if it exists now, since we check at probe time
        MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateNonExistent

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

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

      (Bool
True, MonitorKindFile
FileModTime, Bool
_, MonitorKindDir
_) ->
        MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
          ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
          if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
            then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateFileModTime ModTime
mtime)

      (Bool
True, MonitorKindFile
FileHashed, Bool
_, MonitorKindDir
_) ->
        MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
          ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
          if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
            then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else do Int
hash <- FileHashCache -> FilePath -> FilePath -> ModTime -> IO Int
getFileHash FileHashCache
hashcache FilePath
abspath FilePath
abspath ModTime
mtime
                    MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Int -> MonitorStateFileStatus
MonitorStateFileHashed ModTime
mtime Int
hash)

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

      (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirModTime) ->
        MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
          ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
          if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
            then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
            else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateDirModTime ModTime
mtime)

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

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

-- | Much like 'buildMonitorStateFileSet' but for the somewhat complicated case
-- of a file glob.
--
-- This gets used both by 'buildMonitorStateFileSet' when we're taking the
-- file system snapshot, but also by 'probeGlobStatus' as part of checking
-- the monitored (globed) files for changes when we find a whole new subtree.
--
buildMonitorStateGlob :: Maybe MonitorTimestamp -- ^ start time of update
                      -> FileHashCache     -- ^ existing file hashes
                      -> MonitorKindFile -> MonitorKindDir
                      -> FilePath     -- ^ the root directory
                      -> 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 <- IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
    MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot (MonitorStateGlobRel -> MonitorStateGlob)
-> IO MonitorStateGlobRel -> IO MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> 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 <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
subdir -> FilePath -> IO Bool
doesDirectoryExist (FilePath
absdir FilePath -> ShowS
</> FilePath
subdir))
                 ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateGlobRel)]
subdirStates <-
          [FilePath]
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
subdirs) ((FilePath -> IO (FilePath, MonitorStateGlobRel))
 -> IO [(FilePath, MonitorStateGlobRel)])
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$ \FilePath
subdir -> do
            MonitorStateGlobRel
fstate <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
                        Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
                        (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) FilePathGlobRel
globPath'
            (FilePath, MonitorStateGlobRel)
-> IO (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
subdir, MonitorStateGlobRel
fstate)
        MonitorStateGlobRel -> IO MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
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 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
        [(FilePath, MonitorStateFileStatus)]
filesStates <-
          [FilePath]
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
files) ((FilePath -> IO (FilePath, MonitorStateFileStatus))
 -> IO [(FilePath, MonitorStateFileStatus)])
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
            MonitorStateFileStatus
fstate <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile
                        Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
                        (FilePath
dir FilePath -> ShowS
</> FilePath
file)
            (FilePath, MonitorStateFileStatus)
-> IO (FilePath, MonitorStateFileStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, MonitorStateFileStatus
fstate)
        MonitorStateGlobRel -> IO MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! Glob
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles Glob
glob ModTime
dirMTime [(FilePath, MonitorStateFileStatus)]
filesStates

      FilePathGlobRel
GlobDirTrailing ->
        MonitorStateGlobRel -> IO MonitorStateGlobRel
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 Int
lookupFileHashCache FileHashCache
hashcache FilePath
file ModTime
mtime = do
    (ModTime
mtime', Int
hash) <- FilePath -> FileHashCache -> Maybe (ModTime, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
file FileHashCache
hashcache
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModTime
mtime' ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime)
    Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
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 Int
getFileHash FileHashCache
hashcache FilePath
relfile FilePath
absfile ModTime
mtime =
    case FileHashCache -> FilePath -> ModTime -> Maybe Int
lookupFileHashCache FileHashCache
hashcache FilePath
relfile ModTime
mtime of
      Just Int
hash -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
hash
      Maybe Int
Nothing   -> FilePath -> IO Int
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 :: FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor =
    FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleDoesNotExist FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
    FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleErrorCall    FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
    FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO FileHashCache)
-> IO FileHashCache
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
  -> IO FileHashCache)
 -> IO FileHashCache)
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
    -> IO FileHashCache)
-> IO FileHashCache
forall a b. (a -> b) -> a -> b
$ \Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res ->
      case Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res of
        Left FilePath
_             -> FileHashCache -> IO FileHashCache
forall (m :: * -> *) a. Monad m => a -> m a
return FileHashCache
forall k a. Map k a
Map.empty
        Right (MonitorStateFileSet
msfs, a
_, Either FilePath b
_) -> FileHashCache -> IO FileHashCache
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateFileSet -> FileHashCache
mkFileHashCache MonitorStateFileSet
msfs)
  where
    mkFileHashCache :: MonitorStateFileSet -> FileHashCache
    mkFileHashCache :: MonitorStateFileSet -> FileHashCache
mkFileHashCache (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
                    [MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths
        FileHashCache -> FileHashCache -> FileHashCache
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [MonitorStateGlob] -> FileHashCache
collectAllGlobHashes [MonitorStateGlob]
globPaths

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

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

    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Int))]
collectGlobHashes FilePath
dir (MonitorStateGlobDirs Glob
_ FilePathGlobRel
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
      [ (FilePath, (ModTime, Int))
res
      | (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
      , (FilePath, (ModTime, Int))
res <- FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Int))]
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, Int
hash))
      | (FilePath
fname, MonitorStateFileHashed ModTime
mtime Int
hash) <- [(FilePath, MonitorStateFileStatus)]
entries ]

    collectGlobHashes FilePath
_dir MonitorStateGlobRel
MonitorStateGlobDirTrailing =
      []


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

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

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

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

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

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

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

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

-- | Read a non-cryptographic hash of a @file@.
readFileHash :: FilePath -> IO Hash
readFileHash :: FilePath -> IO Int
readFileHash FilePath
file =
    FilePath -> IOMode -> (Handle -> IO Int) -> IO Int
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
file IOMode
ReadMode ((Handle -> IO Int) -> IO Int) -> (Handle -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
      Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> (ByteString -> Int) -> ByteString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall a. Hashable a => a -> Int
Hashable.hash (ByteString -> IO Int) -> IO ByteString -> IO Int
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 =
  Maybe ModTime -> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a. a -> IO a -> IO a
handleIOException Maybe ModTime
forall a. Maybe a
Nothing (IO (Maybe ModTime) -> IO (Maybe ModTime))
-> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ do
    ModTime
mtime' <- FilePath -> IO ModTime
getModTime FilePath
dir
    if ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
      then Maybe ModTime -> IO (Maybe ModTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModTime
forall a. Maybe a
Nothing
      else Maybe ModTime -> IO (Maybe ModTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Maybe ModTime
forall a. a -> Maybe a
Just ModTime
mtime')

-- | Run an IO computation, returning the first argument @e@ if there is an 'error'
-- call. ('ErrorCall')
handleErrorCall :: a -> IO a -> IO a
handleErrorCall :: a -> IO a -> IO a
handleErrorCall a
e = (ErrorCall -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ErrorCall -> IO a
forall (m :: * -> *). Monad m => ErrorCall -> m a
handler where
#if MIN_VERSION_base(4,9,0)
    handler :: ErrorCall -> m a
handler (ErrorCallWithLocation FilePath
_ FilePath
_) = a -> m a
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 :: a -> IO a -> IO a
handleIOException a
e =
    (IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (a -> IOException -> IO a
forall a. a -> IOException -> IO a
anyIOException a
e)
  where
    anyIOException :: a -> IOException -> IO a
    anyIOException :: a -> IOException -> IO a
anyIOException a
x IOException
_ = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x


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