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

-- | An abstraction to help with re-running actions when files or other
-- input values they depend on have changed.
module Distribution.Client.FileMonitor
  ( -- * Declaring files to monitor
    MonitorFilePath (..)
  , MonitorKindFile (..)
  , MonitorKindDir (..)
  , RootedGlob (..)
  , 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 Distribution.Client.Compat.Prelude
import qualified Distribution.Compat.Binary as Binary
import Prelude ()

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

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

import Distribution.Client.Glob
import Distribution.Client.Utils (MergeResult (..), mergeBy)
import Distribution.Compat.Time
import Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
import Distribution.Utils.Structured (Tag (..), structuredEncode)
import System.Directory
import System.FilePath
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 -> RootedGlob
monitorPathGlob :: !RootedGlob
      }
  deriving (MonitorFilePath -> MonitorFilePath -> Bool
(MonitorFilePath -> MonitorFilePath -> Bool)
-> (MonitorFilePath -> MonitorFilePath -> Bool)
-> Eq MonitorFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorFilePath -> MonitorFilePath -> Bool
== :: MonitorFilePath -> MonitorFilePath -> Bool
$c/= :: MonitorFilePath -> MonitorFilePath -> Bool
/= :: MonitorFilePath -> MonitorFilePath -> Bool
Eq, Hash -> MonitorFilePath -> ShowS
[MonitorFilePath] -> ShowS
MonitorFilePath -> FilePath
(Hash -> MonitorFilePath -> ShowS)
-> (MonitorFilePath -> FilePath)
-> ([MonitorFilePath] -> ShowS)
-> Show MonitorFilePath
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Hash -> MonitorFilePath -> ShowS
showsPrec :: Hash -> MonitorFilePath -> ShowS
$cshow :: MonitorFilePath -> FilePath
show :: MonitorFilePath -> FilePath
$cshowList :: [MonitorFilePath] -> ShowS
showList :: [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
$cfrom :: forall x. MonitorFilePath -> Rep MonitorFilePath x
from :: forall x. MonitorFilePath -> Rep MonitorFilePath x
$cto :: forall x. Rep MonitorFilePath x -> MonitorFilePath
to :: forall x. Rep MonitorFilePath x -> MonitorFilePath
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
$c== :: MonitorKindFile -> MonitorKindFile -> Bool
== :: MonitorKindFile -> MonitorKindFile -> Bool
$c/= :: MonitorKindFile -> MonitorKindFile -> Bool
/= :: MonitorKindFile -> MonitorKindFile -> Bool
Eq, Hash -> MonitorKindFile -> ShowS
[MonitorKindFile] -> ShowS
MonitorKindFile -> FilePath
(Hash -> MonitorKindFile -> ShowS)
-> (MonitorKindFile -> FilePath)
-> ([MonitorKindFile] -> ShowS)
-> Show MonitorKindFile
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Hash -> MonitorKindFile -> ShowS
showsPrec :: Hash -> MonitorKindFile -> ShowS
$cshow :: MonitorKindFile -> FilePath
show :: MonitorKindFile -> FilePath
$cshowList :: [MonitorKindFile] -> ShowS
showList :: [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
$cfrom :: forall x. MonitorKindFile -> Rep MonitorKindFile x
from :: forall x. MonitorKindFile -> Rep MonitorKindFile x
$cto :: forall x. Rep MonitorKindFile x -> MonitorKindFile
to :: forall x. Rep MonitorKindFile x -> MonitorKindFile
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
$c== :: MonitorKindDir -> MonitorKindDir -> Bool
== :: MonitorKindDir -> MonitorKindDir -> Bool
$c/= :: MonitorKindDir -> MonitorKindDir -> Bool
/= :: MonitorKindDir -> MonitorKindDir -> Bool
Eq, Hash -> MonitorKindDir -> ShowS
[MonitorKindDir] -> ShowS
MonitorKindDir -> FilePath
(Hash -> MonitorKindDir -> ShowS)
-> (MonitorKindDir -> FilePath)
-> ([MonitorKindDir] -> ShowS)
-> Show MonitorKindDir
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Hash -> MonitorKindDir -> ShowS
showsPrec :: Hash -> MonitorKindDir -> ShowS
$cshow :: MonitorKindDir -> FilePath
show :: MonitorKindDir -> FilePath
$cshowList :: [MonitorKindDir] -> ShowS
showList :: [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
$cfrom :: forall x. MonitorKindDir -> Rep MonitorKindDir x
from :: forall x. MonitorKindDir -> Rep MonitorKindDir x
$cto :: forall x. Rep MonitorKindDir x -> MonitorKindDir
to :: forall x. Rep MonitorKindDir x -> MonitorKindDir
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 :: RootedGlob -> MonitorFilePath
monitorFileGlob :: RootedGlob -> MonitorFilePath
monitorFileGlob = MonitorKindFile -> MonitorKindDir -> RootedGlob -> 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 :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
monitorFileGlobExistence = MonitorKindFile -> MonitorKindDir -> RootedGlob -> 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 (Hash -> MonitorStateFileSet -> ShowS
[MonitorStateFileSet] -> ShowS
MonitorStateFileSet -> FilePath
(Hash -> MonitorStateFileSet -> ShowS)
-> (MonitorStateFileSet -> FilePath)
-> ([MonitorStateFileSet] -> ShowS)
-> Show MonitorStateFileSet
forall a.
(Hash -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Hash -> MonitorStateFileSet -> ShowS
showsPrec :: Hash -> MonitorStateFileSet -> ShowS
$cshow :: MonitorStateFileSet -> FilePath
show :: MonitorStateFileSet -> FilePath
$cshowList :: [MonitorStateFileSet] -> ShowS
showList :: [MonitorStateFileSet] -> ShowS
Show, (forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x)
-> (forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet)
-> Generic MonitorStateFileSet
forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
from :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
$cto :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
to :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
Generic)

instance Binary MonitorStateFileSet
instance Structured MonitorStateFileSet

type Hash = Int

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

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

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

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

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

instance Binary MonitorStateGlob
instance Binary MonitorStateGlobRel

instance Structured MonitorStateGlob
instance Structured MonitorStateGlobRel

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data CacheChanged = CacheChanged | CacheUnchanged

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

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

-- | Probe the file system to see if a single monitored file has changed.
probeMonitorStateFileStatus
  :: FilePath
  -> FilePath
  -> MonitorStateFileStatus
  -> ChangedM ()
probeMonitorStateFileStatus :: FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root FilePath
file MonitorStateFileStatus
status =
  case MonitorStateFileStatus
status of
    MonitorStateFileStatus
MonitorStateFileExists ->
      FilePath -> FilePath -> ChangedM ()
probeFileExistence FilePath
root FilePath
file
    MonitorStateFileModTime ModTime
mtime ->
      FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
    MonitorStateFileHashed ModTime
mtime Hash
hash ->
      FilePath -> FilePath -> ModTime -> Hash -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Hash
hash
    MonitorStateFileStatus
MonitorStateDirExists ->
      FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
file
    MonitorStateDirModTime ModTime
mtime ->
      FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
    MonitorStateFileStatus
MonitorStateNonExistent ->
      FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file
    MonitorStateFileStatus
MonitorStateAlreadyChanged ->
      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
    root <- IO FilePath -> ChangedM FilePath
forall a. IO a -> ChangedM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ChangedM FilePath)
-> IO FilePath -> ChangedM FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
    case globroot of
      FilePathRoot
FilePathRelative ->
        MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot
          (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"." MonitorStateGlobRel
glob
      -- for absolute cases, make the changed file we report absolute too
      FilePathRoot
_ ->
        ShowS -> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a. ShowS -> ChangedM a -> ChangedM a
mapChangedFile (FilePath
root FilePath -> ShowS
</>) (ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob)
-> ChangedM MonitorStateGlob -> ChangedM MonitorStateGlob
forall a b. (a -> b) -> a -> b
$
          MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot
            (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"" MonitorStateGlobRel
glob

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

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

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

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

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

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

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

        traverse_ probeMergeResult $
          mergeBy
            (\(FilePath
path1, MonitorStateFileStatus
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
            children
            (sort matches)
        return mtime'

    -- Check that none of the children have changed
    for_ children $ \(FilePath
file, MonitorStateFileStatus
status) ->
      FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
file) MonitorStateFileStatus
status

    return (MonitorStateGlobFiles glob mtime' children)
    where
      -- Again, we don't force a cache rewrite with 'cacheChanged', but we do use
      -- the new mtime' if any.

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

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

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

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

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

-- | Take the snapshot of the monitored files. That is, given the
-- specification of the set of files we need to monitor, inspect the state
-- of the file system now and collect the information we'll need later to
-- determine if anything has changed.
buildMonitorStateFileSet
  :: Maybe MonitorTimestamp
  -- ^ optional: timestamp
  -- of the start of the action
  -> FileHashCache
  -- ^ existing file hashes
  -> FilePath
  -- ^ root directory
  -> [MonitorFilePath]
  -- ^ patterns of interest
  --   relative to root
  -> IO MonitorStateFileSet
buildMonitorStateFileSet :: Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache FilePath
root =
  [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [] []
  where
    go
      :: [MonitorStateFile]
      -> [MonitorStateGlob]
      -> [MonitorFilePath]
      -> IO MonitorStateFileSet
    go :: [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths [] =
      MonitorStateFileSet -> IO MonitorStateFileSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet ([MonitorStateFile] -> [MonitorStateFile]
forall a. [a] -> [a]
reverse [MonitorStateFile]
singlePaths) ([MonitorStateGlob] -> [MonitorStateGlob]
forall a. [a] -> [a]
reverse [MonitorStateGlob]
globPaths))
    go
      ![MonitorStateFile]
singlePaths
      ![MonitorStateGlob]
globPaths
      (MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path : [MonitorFilePath]
monitors) = do
        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
        go (monitorState : singlePaths) globPaths monitors
    go
      ![MonitorStateFile]
singlePaths
      ![MonitorStateGlob]
globPaths
      (MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir RootedGlob
globPath : [MonitorFilePath]
monitors) = do
        monitorState <-
          Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> RootedGlob
-> IO MonitorStateGlob
buildMonitorStateGlob
            Maybe MonitorTimestamp
mstartTime
            FileHashCache
hashcache
            MonitorKindFile
kindfile
            MonitorKindDir
kinddir
            FilePath
root
            RootedGlob
globPath
        go singlePaths (monitorState : globPaths) 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
  isFile <- FilePath -> IO Bool
doesFileExist FilePath
abspath
  isDir <- doesDirectoryExist abspath
  case (isFile, kindfile, isDir, kinddir) of
    (Bool
_, MonitorKindFile
FileNotExists, Bool
_, MonitorKindDir
DirNotExists) ->
      -- we don't need to care if it exists now, since we check at probe time
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateNonExistent
    (Bool
False, MonitorKindFile
_, Bool
False, MonitorKindDir
_) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
    (Bool
True, MonitorKindFile
FileExists, Bool
_, MonitorKindDir
_) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateFileExists
    (Bool
True, MonitorKindFile
FileModTime, Bool
_, MonitorKindDir
_) ->
      MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
        mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if changedDuringUpdate mstartTime mtime
          then return MonitorStateAlreadyChanged
          else return (MonitorStateFileModTime 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
        mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if changedDuringUpdate mstartTime mtime
          then return MonitorStateAlreadyChanged
          else do
            hash <- getFileHash hashcache abspath abspath mtime
            return (MonitorStateFileHashed mtime hash)
    (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirExists) ->
      MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateDirExists
    (Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirModTime) ->
      MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
        mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
        if changedDuringUpdate mstartTime mtime
          then return MonitorStateAlreadyChanged
          else return (MonitorStateDirModTime mtime)
    (Bool
False, MonitorKindFile
_, Bool
True, MonitorKindDir
DirNotExists) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
    (Bool
True, MonitorKindFile
FileNotExists, Bool
False, MonitorKindDir
_) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Returns @True@ if, inside the @root@ directory, @file@ has the
-- same 'ModTime' and 'Hash' as @mtime and @chash@.
checkFileModificationTimeAndHashUnchanged
  :: FilePath
  -> FilePath
  -> ModTime
  -> Hash
  -> IO Bool
checkFileModificationTimeAndHashUnchanged :: FilePath -> FilePath -> ModTime -> Hash -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime Hash
chash =
  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
    mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
    if mtime == mtime'
      then return True
      else do
        chash' <- readFileHash (root </> file)
        return (chash == chash')

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

-- | Given a directory @dir@, return @Nothing@ if its 'ModTime'
-- is the same as @mtime@, and the new 'ModTime' if it is not.
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime FilePath
dir ModTime
mtime =
  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
    mtime' <- FilePath -> IO ModTime
getModTime FilePath
dir
    if mtime == mtime'
      then return Nothing
      else return (Just mtime')

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

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