cabal-install/src/Distribution/Client/FileMonitor.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE CPP #-}
   3 {-# LANGUAGE DeriveFunctor #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   6 {-# LANGUAGE NamedFieldPuns #-}
   7 {-# LANGUAGE ScopedTypeVariables #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9
  10 -- | An abstraction to help with re-running actions when files or other
  11 -- input values they depend on have changed.
  12 module Distribution.Client.FileMonitor
  13   ( -- * Declaring files to monitor
  14     MonitorFilePath (..)
  15   , MonitorKindFile (..)
  16   , MonitorKindDir (..)
  17   , FilePathGlob (..)
  18   , monitorFile
  19   , monitorFileHashed
  20   , monitorNonExistentFile
  21   , monitorFileExistence
  22   , monitorDirectory
  23   , monitorNonExistentDirectory
  24   , monitorDirectoryExistence
  25   , monitorFileOrDirectory
  26   , monitorFileGlob
  27   , monitorFileGlobExistence
  28   , monitorFileSearchPath
  29   , monitorFileHashedSearchPath
  30
  31     -- * Creating and checking sets of monitored files
  32   , FileMonitor (..)
  33   , newFileMonitor
  34   , MonitorChanged (..)
  35   , MonitorChangedReason (..)
  36   , checkFileMonitorChanged
  37   , updateFileMonitor
  38   , MonitorTimestamp
  39   , beginUpdateFileMonitor
  40
  41     -- * Internal
  42   , MonitorStateFileSet
  43   , MonitorStateFile
  44   , MonitorStateGlob
  45   ) where
  46
  47 import Distribution.Client.Compat.Prelude
  48 import qualified Distribution.Compat.Binary as Binary
  49 import Prelude ()
  50
  51 import Data.Binary.Get (runGetOrFail)
  52 import qualified Data.ByteString.Lazy as BS
  53 import qualified Data.Hashable as Hashable
  54 import qualified Data.Map.Strict as Map
  55
  56 import Control.Exception
  57 import Control.Monad
  58 import Control.Monad.Except
  59   ( ExceptT
  60   , runExceptT
  61   , throwError
  62   , withExceptT
  63   )
  64 import Control.Monad.State (StateT, mapStateT)
  65 import qualified Control.Monad.State as State
  66 import Control.Monad.Trans (MonadIO, liftIO)
  67
  68 import Distribution.Client.Glob
  69 import Distribution.Client.Utils (MergeResult (..), mergeBy)
  70 import Distribution.Compat.Time
  71 import Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
  72 import Distribution.Utils.Structured (Tag (..), structuredEncode)
  73 import System.Directory
  74 import System.FilePath
  75 import System.IO
  76
  77 ------------------------------------------------------------------------------
  78 -- Types for specifying files to monitor
  79 --
  80
  81 -- | A description of a file (or set of files) to monitor for changes.
  82 --
  83 -- Where file paths are relative they are relative to a common directory
  84 -- (e.g. project root), not necessarily the process current directory.
  85 data MonitorFilePath
  86   = MonitorFile
  87       { monitorKindFile :: !MonitorKindFile
  88       , monitorKindDir :: !MonitorKindDir
  89       , monitorPath :: !FilePath
  90       }
  91   | MonitorFileGlob
  92       { monitorKindFile :: !MonitorKindFile
  93       , monitorKindDir :: !MonitorKindDir
  94       , monitorPathGlob :: !FilePathGlob
  95       }
  96   deriving (Eq, Show, Generic)
  97
  98 data MonitorKindFile
  99   = FileExists
 100   | FileModTime
 101   | FileHashed
 102   | FileNotExists
 103   deriving (Eq, Show, Generic)
 104
 105 data MonitorKindDir
 106   = DirExists
 107   | DirModTime
 108   | DirNotExists
 109   deriving (Eq, Show, Generic)
 110
 111 instance Binary MonitorFilePath
 112 instance Binary MonitorKindFile
 113 instance Binary MonitorKindDir
 114
 115 instance Structured MonitorFilePath
 116 instance Structured MonitorKindFile
 117 instance Structured MonitorKindDir
 118
 119 -- | Monitor a single file for changes, based on its modification time.
 120 -- The monitored file is considered to have changed if it no longer
 121 -- exists or if its modification time has changed.
 122 monitorFile :: FilePath -> MonitorFilePath
 123 monitorFile = MonitorFile FileModTime DirNotExists
 124
 125 -- | Monitor a single file for changes, based on its modification time
 126 -- and content hash. The monitored file is considered to have changed if
 127 -- it no longer exists or if its modification time and content hash have
 128 -- changed.
 129 monitorFileHashed :: FilePath -> MonitorFilePath
 130 monitorFileHashed = MonitorFile FileHashed DirNotExists
 131
 132 -- | Monitor a single non-existent file for changes. The monitored file
 133 -- is considered to have changed if it exists.
 134 monitorNonExistentFile :: FilePath -> MonitorFilePath
 135 monitorNonExistentFile = MonitorFile FileNotExists DirNotExists
 136
 137 -- | Monitor a single file for existence only. The monitored file is
 138 -- considered to have changed if it no longer exists.
 139 monitorFileExistence :: FilePath -> MonitorFilePath
 140 monitorFileExistence = MonitorFile FileExists DirNotExists
 141
 142 -- | Monitor a single directory for changes, based on its modification
 143 -- time. The monitored directory is considered to have changed if it no
 144 -- longer exists or if its modification time has changed.
 145 monitorDirectory :: FilePath -> MonitorFilePath
 146 monitorDirectory = MonitorFile FileNotExists DirModTime
 147
 148 -- | Monitor a single non-existent directory for changes.  The monitored
 149 -- directory is considered to have changed if it exists.
 150 monitorNonExistentDirectory :: FilePath -> MonitorFilePath
 151 -- Just an alias for monitorNonExistentFile, since you can't
 152 -- tell the difference between a non-existent directory and
 153 -- a non-existent file :)
 154 monitorNonExistentDirectory = monitorNonExistentFile
 155
 156 -- | Monitor a single directory for existence. The monitored directory is
 157 -- considered to have changed only if it no longer exists.
 158 monitorDirectoryExistence :: FilePath -> MonitorFilePath
 159 monitorDirectoryExistence = MonitorFile FileNotExists DirExists
 160
 161 -- | Monitor a single file or directory for changes, based on its modification
 162 -- time. The monitored file is considered to have changed if it no longer
 163 -- exists or if its modification time has changed.
 164 monitorFileOrDirectory :: FilePath -> MonitorFilePath
 165 monitorFileOrDirectory = MonitorFile FileModTime DirModTime
 166
 167 -- | Monitor a set of files (or directories) identified by a file glob.
 168 -- The monitored glob is considered to have changed if the set of files
 169 -- matching the glob changes (i.e. creations or deletions), or for files if the
 170 -- modification time and content hash of any matching file has changed.
 171 monitorFileGlob :: FilePathGlob -> MonitorFilePath
 172 monitorFileGlob = MonitorFileGlob FileHashed DirExists
 173
 174 -- | Monitor a set of files (or directories) identified by a file glob for
 175 -- existence only. The monitored glob is considered to have changed if the set
 176 -- of files matching the glob changes (i.e. creations or deletions).
 177 monitorFileGlobExistence :: FilePathGlob -> MonitorFilePath
 178 monitorFileGlobExistence = MonitorFileGlob FileExists DirExists
 179
 180 -- | Creates a list of files to monitor when you search for a file which
 181 -- unsuccessfully looked in @notFoundAtPaths@ before finding it at
 182 -- @foundAtPath@.
 183 monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
 184 monitorFileSearchPath notFoundAtPaths foundAtPath =
 185   monitorFile foundAtPath
 186     : map monitorNonExistentFile notFoundAtPaths
 187
 188 -- | Similar to 'monitorFileSearchPath', but also instructs us to
 189 -- monitor the hash of the found file.
 190 monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
 191 monitorFileHashedSearchPath notFoundAtPaths foundAtPath =
 192   monitorFileHashed foundAtPath
 193     : map monitorNonExistentFile notFoundAtPaths
 194
 195 ------------------------------------------------------------------------------
 196 -- Implementation types, files status
 197 --
 198
 199 -- | The state necessary to determine whether a set of monitored
 200 -- files has changed.  It consists of two parts: a set of specific
 201 -- files to be monitored (index by their path), and a list of
 202 -- globs, which monitor may files at once.
 203 data MonitorStateFileSet
 204   = MonitorStateFileSet
 205       ![MonitorStateFile]
 206       ![MonitorStateGlob]
 207   -- Morally this is not actually a set but a bag (represented by lists).
 208   -- There is no principled reason to use a bag here rather than a set, but
 209   -- there is also no particular gain either. That said, we do preserve the
 210   -- order of the lists just to reduce confusion (and have predictable I/O
 211   -- patterns).
 212   deriving (Show, Generic)
 213
 214 instance Binary MonitorStateFileSet
 215 instance Structured MonitorStateFileSet
 216
 217 type Hash = Int
 218
 219 -- | The state necessary to determine whether a monitored file has changed.
 220 --
 221 -- This covers all the cases of 'MonitorFilePath' except for globs which is
 222 -- covered separately by 'MonitorStateGlob'.
 223 --
 224 -- The @Maybe ModTime@ is to cover the case where we already consider the
 225 -- file to have changed, either because it had already changed by the time we
 226 -- did the snapshot (i.e. too new, changed since start of update process) or it
 227 -- no longer exists at all.
 228 data MonitorStateFile
 229   = MonitorStateFile
 230       !MonitorKindFile
 231       !MonitorKindDir
 232       !FilePath
 233       !MonitorStateFileStatus
 234   deriving (Show, Generic)
 235
 236 data MonitorStateFileStatus
 237   = MonitorStateFileExists
 238   | -- | cached file mtime
 239     MonitorStateFileModTime !ModTime
 240   | -- | cached mtime and content hash
 241     MonitorStateFileHashed !ModTime !Hash
 242   | MonitorStateDirExists
 243   | -- | cached dir mtime
 244     MonitorStateDirModTime !ModTime
 245   | MonitorStateNonExistent
 246   | MonitorStateAlreadyChanged
 247   deriving (Show, Generic)
 248
 249 instance Binary MonitorStateFile
 250 instance Binary MonitorStateFileStatus
 251 instance Structured MonitorStateFile
 252 instance Structured MonitorStateFileStatus
 253
 254 -- | The state necessary to determine whether the files matched by a globbing
 255 -- match have changed.
 256 data MonitorStateGlob
 257   = MonitorStateGlob
 258       !MonitorKindFile
 259       !MonitorKindDir
 260       !FilePathRoot
 261       !MonitorStateGlobRel
 262   deriving (Show, Generic)
 263
 264 data MonitorStateGlobRel
 265   = MonitorStateGlobDirs
 266       !Glob
 267       !FilePathGlobRel
 268       !ModTime
 269       ![(FilePath, MonitorStateGlobRel)] -- invariant: sorted
 270   | MonitorStateGlobFiles
 271       !Glob
 272       !ModTime
 273       ![(FilePath, MonitorStateFileStatus)] -- invariant: sorted
 274   | MonitorStateGlobDirTrailing
 275   deriving (Show, Generic)
 276
 277 instance Binary MonitorStateGlob
 278 instance Binary MonitorStateGlobRel
 279
 280 instance Structured MonitorStateGlob
 281 instance Structured MonitorStateGlobRel
 282
 283 -- | We can build a 'MonitorStateFileSet' from a set of 'MonitorFilePath' by
 284 -- inspecting the state of the file system, and we can go in the reverse
 285 -- direction by just forgetting the extra info.
 286 reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
 287 reconstructMonitorFilePaths (MonitorStateFileSet singlePaths globPaths) =
 288   map getSinglePath singlePaths ++ map getGlobPath globPaths
 289   where
 290     getSinglePath :: MonitorStateFile -> MonitorFilePath
 291     getSinglePath (MonitorStateFile kindfile kinddir filepath _) =
 292       MonitorFile kindfile kinddir filepath
 293
 294     getGlobPath :: MonitorStateGlob -> MonitorFilePath
 295     getGlobPath (MonitorStateGlob kindfile kinddir root gstate) =
 296       MonitorFileGlob kindfile kinddir $
 297         FilePathGlob root $
 298           case gstate of
 299             MonitorStateGlobDirs glob globs _ _ -> GlobDir glob globs
 300             MonitorStateGlobFiles glob _ _ -> GlobFile glob
 301             MonitorStateGlobDirTrailing -> GlobDirTrailing
 302
 303 ------------------------------------------------------------------------------
 304 -- Checking the status of monitored files
 305 --
 306
 307 -- | A monitor for detecting changes to a set of files. It can be used to
 308 -- efficiently test if any of a set of files (specified individually or by
 309 -- glob patterns) has changed since some snapshot. In addition, it also checks
 310 -- for changes in a value (of type @a@), and when there are no changes in
 311 -- either it returns a saved value (of type @b@).
 312 --
 313 -- The main use case looks like this: suppose we have some expensive action
 314 -- that depends on certain pure inputs and reads some set of files, and
 315 -- produces some pure result. We want to avoid re-running this action when it
 316 -- would produce the same result. So we need to monitor the files the action
 317 -- looked at, the other pure input values, and we need to cache the result.
 318 -- Then at some later point, if the input value didn't change, and none of the
 319 -- files changed, then we can re-use the cached result rather than re-running
 320 -- the action.
 321 --
 322 -- This can be achieved using a 'FileMonitor'. Each 'FileMonitor' instance
 323 -- saves state in a disk file, so the file for that has to be specified,
 324 -- making sure it is unique. The pattern is to use 'checkFileMonitorChanged'
 325 -- to see if there's been any change. If there is, re-run the action, keeping
 326 -- track of the files, then use 'updateFileMonitor' to record the current
 327 -- set of files to monitor, the current input value for the action, and the
 328 -- result of the action.
 329 --
 330 -- The typical occurrence of this pattern is captured by 'rerunIfChanged'
 331 -- and the 'Rebuild' monad. More complicated cases may need to use
 332 -- 'checkFileMonitorChanged' and 'updateFileMonitor' directly.
 333 data FileMonitor a b = FileMonitor
 334   { fileMonitorCacheFile :: FilePath
 335   -- ^ The file where this 'FileMonitor' should store its state.
 336   , fileMonitorKeyValid :: a -> a -> Bool
 337   -- ^ Compares a new cache key with old one to determine if a
 338   -- corresponding cached value is still valid.
 339   --
 340   -- Typically this is just an equality test, but in some
 341   -- circumstances it can make sense to do things like subset
 342   -- comparisons.
 343   --
 344   -- The first arg is the new value, the second is the old cached value.
 345   , fileMonitorCheckIfOnlyValueChanged :: Bool
 346   -- ^ When this mode is enabled, if 'checkFileMonitorChanged' returns
 347   -- 'MonitoredValueChanged' then we have the guarantee that no files
 348   -- changed, that the value change was the only change. In the default
 349   -- mode no such guarantee is provided which is slightly faster.
 350   }
 351
 352 -- | Define a new file monitor.
 353 --
 354 -- It's best practice to define file monitor values once, and then use the
 355 -- same value for 'checkFileMonitorChanged' and 'updateFileMonitor' as this
 356 -- ensures you get the same types @a@ and @b@ for reading and writing.
 357 --
 358 -- The path of the file monitor itself must be unique because it keeps state
 359 -- on disk and these would clash.
 360 newFileMonitor
 361   :: Eq a
 362   => FilePath
 363   -- ^ The file to cache the state of the
 364   -- file monitor. Must be unique.
 365   -> FileMonitor a b
 366 newFileMonitor path = FileMonitor path (==) False
 367
 368 -- | The result of 'checkFileMonitorChanged': either the monitored files or
 369 -- value changed (and it tells us which it was) or nothing changed and we get
 370 -- the cached result.
 371 data MonitorChanged a b
 372   = -- | The monitored files and value did not change. The cached result is
 373     -- @b@.
 374     --
 375     -- The set of monitored files is also returned. This is useful
 376     -- for composing or nesting 'FileMonitor's.
 377     MonitorUnchanged b [MonitorFilePath]
 378   | -- | The monitor found that something changed. The reason is given.
 379     MonitorChanged (MonitorChangedReason a)
 380   deriving (Show)
 381
 382 -- | What kind of change 'checkFileMonitorChanged' detected.
 383 data MonitorChangedReason a
 384   = -- | One of the files changed (existence, file type, mtime or file
 385     -- content, depending on the 'MonitorFilePath' in question)
 386     MonitoredFileChanged FilePath
 387   | -- | The pure input value changed.
 388     --
 389     -- The previous cached key value is also returned. This is sometimes
 390     -- useful when using a 'fileMonitorKeyValid' function that is not simply
 391     -- '(==)', when invalidation can be partial. In such cases it can make
 392     -- sense to 'updateFileMonitor' with a key value that's a combination of
 393     -- the new and old (e.g. set union).
 394     MonitoredValueChanged a
 395   | -- | There was no saved monitor state, cached value etc. Ie the file
 396     -- for the 'FileMonitor' does not exist.
 397     MonitorFirstRun
 398   | -- | There was existing state, but we could not read it. This typically
 399     -- happens when the code has changed compared to an existing 'FileMonitor'
 400     -- cache file and type of the input value or cached value has changed such
 401     -- that we cannot decode the values. This is completely benign as we can
 402     -- treat is just as if there were no cache file and re-run.
 403     MonitorCorruptCache
 404   deriving (Eq, Show, Functor)
 405
 406 -- | Test if the input value or files monitored by the 'FileMonitor' have
 407 -- changed. If not, return the cached value.
 408 --
 409 -- See 'FileMonitor' for a full explanation.
 410 checkFileMonitorChanged
 411   :: forall a b
 412    . (Binary a, Structured a, Binary b, Structured b)
 413   => FileMonitor a b
 414   -- ^ cache file path
 415   -> FilePath
 416   -- ^ root directory
 417   -> a
 418   -- ^ guard or key value
 419   -> IO (MonitorChanged a b)
 420   -- ^ did the key or any paths change?
 421 checkFileMonitorChanged
 422   monitor@FileMonitor
 423     { fileMonitorKeyValid
 424     , fileMonitorCheckIfOnlyValueChanged
 425     }
 426   root
 427   currentKey =
 428     -- Consider it a change if the cache file does not exist,
 429     -- or we cannot decode it. Sadly ErrorCall can still happen, despite
 430     -- using decodeFileOrFail, e.g. Data.Char.chr errors
 431
 432     handleDoesNotExist (MonitorChanged MonitorFirstRun) $
 433       handleErrorCall (MonitorChanged MonitorCorruptCache) $
 434         withCacheFile monitor $
 435           either
 436             (\_ -> return (MonitorChanged MonitorCorruptCache))
 437             checkStatusCache
 438     where
 439       checkStatusCache :: (MonitorStateFileSet, a, Either String b) -> IO (MonitorChanged a b)
 440       checkStatusCache (cachedFileStatus, cachedKey, cachedResult) = do
 441         change <- checkForChanges
 442         case change of
 443           Just reason -> return (MonitorChanged reason)
 444           Nothing -> case cachedResult of
 445             Left _ -> pure (MonitorChanged MonitorCorruptCache)
 446             Right cr -> return (MonitorUnchanged cr monitorFiles)
 447             where
 448               monitorFiles = reconstructMonitorFilePaths cachedFileStatus
 449         where
 450           -- In fileMonitorCheckIfOnlyValueChanged mode we want to guarantee that
 451           -- if we return MonitoredValueChanged that only the value changed.
 452           -- We do that by checking for file changes first. Otherwise it makes
 453           -- more sense to do the cheaper test first.
 454           checkForChanges :: IO (Maybe (MonitorChangedReason a))
 455           checkForChanges
 456             | fileMonitorCheckIfOnlyValueChanged =
 457                 checkFileChange cachedFileStatus cachedKey cachedResult
 458                   `mplusMaybeT` checkValueChange cachedKey
 459             | otherwise =
 460                 checkValueChange cachedKey
 461                   `mplusMaybeT` checkFileChange cachedFileStatus cachedKey cachedResult
 462
 463       mplusMaybeT :: Monad m => m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
 464       mplusMaybeT ma mb = do
 465         mx <- ma
 466         case mx of
 467           Nothing -> mb
 468           Just x -> return (Just x)
 469
 470       -- Check if the guard value has changed
 471       checkValueChange :: a -> IO (Maybe (MonitorChangedReason a))
 472       checkValueChange cachedKey
 473         | not (fileMonitorKeyValid currentKey cachedKey) =
 474             return (Just (MonitoredValueChanged cachedKey))
 475         | otherwise =
 476             return Nothing
 477
 478       -- Check if any file has changed
 479       checkFileChange :: MonitorStateFileSet -> a -> Either String b -> IO (Maybe (MonitorChangedReason a))
 480       checkFileChange cachedFileStatus cachedKey cachedResult = do
 481         res <- probeFileSystem root cachedFileStatus
 482         case res of
 483           -- Some monitored file has changed
 484           Left changedPath ->
 485             return (Just (MonitoredFileChanged (normalise changedPath)))
 486           -- No monitored file has changed
 487           Right (cachedFileStatus', cacheStatus) -> do
 488             -- But we might still want to update the cache
 489             whenCacheChanged cacheStatus $
 490               case cachedResult of
 491                 Left _ -> pure ()
 492                 Right cr -> rewriteCacheFile monitor cachedFileStatus' cachedKey cr
 493
 494             return Nothing
 495
 496 -- | Lazily decode a triple, parsing the first two fields strictly and
 497 -- returning a lazy value containing either the last one or an error.
 498 -- This is helpful for cabal cache files where the first two components
 499 -- contain header data that lets one test if the cache is still valid,
 500 -- and the last (potentially large) component is the cached value itself.
 501 -- This way we can test for cache validity without needing to pay the
 502 -- cost of the decode of stale cache data. This lives here rather than
 503 -- Distribution.Utils.Structured because it depends on a newer version of
 504 -- binary than supported in the Cabal library proper.
 505 structuredDecodeTriple
 506   :: forall a b c
 507    . (Structured a, Structured b, Structured c, Binary.Binary a, Binary.Binary b, Binary.Binary c)
 508   => BS.ByteString
 509   -> Either String (a, b, Either String c)
 510 structuredDecodeTriple lbs =
 511   let partialDecode =
 512         (`runGetOrFail` lbs) $ do
 513           (_ :: Tag (a, b, c)) <- Binary.get
 514           (a :: a) <- Binary.get
 515           (b :: b) <- Binary.get
 516           pure (a, b)
 517       cleanEither (Left (_, pos, msg)) = Left ("Data.Binary.Get.runGet at position " ++ show pos ++ ": " ++ msg)
 518       cleanEither (Right (_, _, v)) = Right v
 519    in case partialDecode of
 520         Left (_, pos, msg) -> Left ("Data.Binary.Get.runGet at position " ++ show pos ++ ": " ++ msg)
 521         Right (lbs', _, (x, y)) -> Right (x, y, cleanEither $ runGetOrFail (Binary.get :: Binary.Get c) lbs')
 522
 523 -- | Helper for reading the cache file.
 524 --
 525 -- This determines the type and format of the binary cache file.
 526 withCacheFile
 527   :: (Binary a, Structured a, Binary b, Structured b)
 528   => FileMonitor a b
 529   -> (Either String (MonitorStateFileSet, a, Either String b) -> IO r)
 530   -> IO r
 531 withCacheFile (FileMonitor{fileMonitorCacheFile}) k =
 532   withBinaryFile fileMonitorCacheFile ReadMode $ \hnd -> do
 533     contents <- structuredDecodeTriple <$> BS.hGetContents hnd
 534     k contents
 535
 536 -- | Helper for writing the cache file.
 537 --
 538 -- This determines the type and format of the binary cache file.
 539 rewriteCacheFile
 540   :: (Binary a, Structured a, Binary b, Structured b)
 541   => FileMonitor a b
 542   -> MonitorStateFileSet
 543   -> a
 544   -> b
 545   -> IO ()
 546 rewriteCacheFile FileMonitor{fileMonitorCacheFile} fileset key result =
 547   writeFileAtomic fileMonitorCacheFile $
 548     structuredEncode (fileset, key, result)
 549
 550 -- | Probe the file system to see if any of the monitored files have changed.
 551 --
 552 -- It returns Nothing if any file changed, or returns a possibly updated
 553 -- file 'MonitorStateFileSet' plus an indicator of whether it actually changed.
 554 --
 555 -- We may need to update the cache since there may be changes in the filesystem
 556 -- state which don't change any of our affected files.
 557 --
 558 -- Consider the glob @{proj1,proj2}\/\*.cabal@. Say we first run and find a
 559 -- @proj1@ directory containing @proj1.cabal@ yet no @proj2@. If we later run
 560 -- and find @proj2@ was created, yet contains no files matching @*.cabal@ then
 561 -- we want to update the cache despite no changes in our relevant file set.
 562 -- Specifically, we should add an mtime for this directory so we can avoid
 563 -- re-traversing the directory in future runs.
 564 probeFileSystem
 565   :: FilePath
 566   -> MonitorStateFileSet
 567   -> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
 568 probeFileSystem root (MonitorStateFileSet singlePaths globPaths) =
 569   runChangedM $ do
 570     sequence_
 571       [ probeMonitorStateFileStatus root file status
 572       | MonitorStateFile _ _ file status <- singlePaths
 573       ]
 574     -- The glob monitors can require state changes
 575     globPaths' <-
 576       sequence
 577         [ probeMonitorStateGlob root globPath
 578         | globPath <- globPaths
 579         ]
 580     return (MonitorStateFileSet singlePaths globPaths')
 581
 582 -----------------------------------------------
 583 -- Monad for checking for file system changes
 584 --
 585 -- We need to be able to bail out if we detect a change (using ExceptT),
 586 -- but if there's no change we need to be able to rebuild the monitor
 587 -- state. And we want to optimise that rebuilding by keeping track if
 588 -- anything actually changed (using StateT), so that in the typical case
 589 -- we can avoid rewriting the state file.
 590
 591 newtype ChangedM a = ChangedM (StateT CacheChanged (ExceptT FilePath IO) a)
 592   deriving (Functor, Applicative, Monad, MonadIO)
 593
 594 runChangedM :: ChangedM a -> IO (Either FilePath (a, CacheChanged))
 595 runChangedM (ChangedM action) =
 596   runExceptT $ State.runStateT action CacheUnchanged
 597
 598 somethingChanged :: FilePath -> ChangedM a
 599 somethingChanged path = ChangedM $ throwError path
 600
 601 cacheChanged :: ChangedM ()
 602 cacheChanged = ChangedM $ State.put CacheChanged
 603
 604 mapChangedFile :: (FilePath -> FilePath) -> ChangedM a -> ChangedM a
 605 mapChangedFile adjust (ChangedM a) =
 606   ChangedM (mapStateT (withExceptT adjust) a)
 607
 608 data CacheChanged = CacheChanged | CacheUnchanged
 609
 610 whenCacheChanged :: Monad m => CacheChanged -> m () -> m ()
 611 whenCacheChanged CacheChanged action = action
 612 whenCacheChanged CacheUnchanged _ = return ()
 613
 614 ----------------------
 615
 616 -- | Probe the file system to see if a single monitored file has changed.
 617 probeMonitorStateFileStatus
 618   :: FilePath
 619   -> FilePath
 620   -> MonitorStateFileStatus
 621   -> ChangedM ()
 622 probeMonitorStateFileStatus root file status =
 623   case status of
 624     MonitorStateFileExists ->
 625       probeFileExistence root file
 626     MonitorStateFileModTime mtime ->
 627       probeFileModificationTime root file mtime
 628     MonitorStateFileHashed mtime hash ->
 629       probeFileModificationTimeAndHash root file mtime hash
 630     MonitorStateDirExists ->
 631       probeDirExistence root file
 632     MonitorStateDirModTime mtime ->
 633       probeFileModificationTime root file mtime
 634     MonitorStateNonExistent ->
 635       probeFileNonExistence root file
 636     MonitorStateAlreadyChanged ->
 637       somethingChanged file
 638
 639 -- | Probe the file system to see if a monitored file glob has changed.
 640 probeMonitorStateGlob
 641   :: FilePath
 642   -- ^ root path
 643   -> MonitorStateGlob
 644   -> ChangedM MonitorStateGlob
 645 probeMonitorStateGlob
 646   relroot
 647   (MonitorStateGlob kindfile kinddir globroot glob) = do
 648     root <- liftIO $ getFilePathRootDirectory globroot relroot
 649     case globroot of
 650       FilePathRelative ->
 651         MonitorStateGlob kindfile kinddir globroot
 652           <$> probeMonitorStateGlobRel kindfile kinddir root "." glob
 653       -- for absolute cases, make the changed file we report absolute too
 654       _ ->
 655         mapChangedFile (root </>) $
 656           MonitorStateGlob kindfile kinddir globroot
 657             <$> probeMonitorStateGlobRel kindfile kinddir root "" glob
 658
 659 probeMonitorStateGlobRel
 660   :: MonitorKindFile
 661   -> MonitorKindDir
 662   -> FilePath
 663   -- ^ root path
 664   -> FilePath
 665   -- ^ path of the directory we are
 666   --   looking in relative to @root@
 667   -> MonitorStateGlobRel
 668   -> ChangedM MonitorStateGlobRel
 669 probeMonitorStateGlobRel
 670   kindfile
 671   kinddir
 672   root
 673   dirName
 674   (MonitorStateGlobDirs glob globPath mtime children) = do
 675     change <- liftIO $ checkDirectoryModificationTime (root </> dirName) mtime
 676     case change of
 677       Nothing -> do
 678         children' <-
 679           sequence
 680             [ do
 681               fstate' <-
 682                 probeMonitorStateGlobRel
 683                   kindfile
 684                   kinddir
 685                   root
 686                   (dirName </> fname)
 687                   fstate
 688               return (fname, fstate')
 689             | (fname, fstate) <- children
 690             ]
 691         return $! MonitorStateGlobDirs glob globPath mtime children'
 692       Just mtime' -> do
 693         -- directory modification time changed:
 694         -- a matching subdir may have been added or deleted
 695         matches <-
 696           filterM
 697             ( \entry ->
 698                 let subdir = root </> dirName </> entry
 699                  in liftIO $ doesDirectoryExist subdir
 700             )
 701             . filter (matchGlob glob)
 702             =<< liftIO (getDirectoryContents (root </> dirName))
 703
 704         children' <-
 705           traverse probeMergeResult $
 706             mergeBy
 707               (\(path1, _) path2 -> compare path1 path2)
 708               children
 709               (sort matches)
 710         return $! MonitorStateGlobDirs glob globPath mtime' children'
 711     where
 712       -- Note that just because the directory has changed, we don't force
 713       -- a cache rewrite with 'cacheChanged' since that has some cost, and
 714       -- all we're saving is scanning the directory. But we do rebuild the
 715       -- cache with the new mtime', so that if the cache is rewritten for
 716       -- some other reason, we'll take advantage of that.
 717
 718       probeMergeResult
 719         :: MergeResult (FilePath, MonitorStateGlobRel) FilePath
 720         -> ChangedM (FilePath, MonitorStateGlobRel)
 721
 722       -- Only in cached (directory deleted)
 723       probeMergeResult (OnlyInLeft (path, fstate)) = do
 724         case allMatchingFiles (dirName </> path) fstate of
 725           [] -> return (path, fstate)
 726           -- Strictly speaking we should be returning 'CacheChanged' above
 727           -- as we should prune the now-missing 'MonitorStateGlobRel'. However
 728           -- we currently just leave these now-redundant entries in the
 729           -- cache as they cost no IO and keeping them allows us to avoid
 730           -- rewriting the cache.
 731           (file : _) -> somethingChanged file
 732
 733       -- Only in current filesystem state (directory added)
 734       probeMergeResult (OnlyInRight path) = do
 735         fstate <-
 736           liftIO $
 737             buildMonitorStateGlobRel
 738               Nothing
 739               Map.empty
 740               kindfile
 741               kinddir
 742               root
 743               (dirName </> path)
 744               globPath
 745         case allMatchingFiles (dirName </> path) fstate of
 746           (file : _) -> somethingChanged file
 747           -- This is the only case where we use 'cacheChanged' because we can
 748           -- have a whole new dir subtree (of unbounded size and cost), so we
 749           -- need to save the state of that new subtree in the cache.
 750           [] -> cacheChanged >> return (path, fstate)
 751
 752       -- Found in path
 753       probeMergeResult (InBoth (path, fstate) _) = do
 754         fstate' <-
 755           probeMonitorStateGlobRel
 756             kindfile
 757             kinddir
 758             root
 759             (dirName </> path)
 760             fstate
 761         return (path, fstate')
 762
 763       -- \| Does a 'MonitorStateGlob' have any relevant files within it?
 764       allMatchingFiles :: FilePath -> MonitorStateGlobRel -> [FilePath]
 765       allMatchingFiles dir (MonitorStateGlobFiles _ _ entries) =
 766         [dir </> fname | (fname, _) <- entries]
 767       allMatchingFiles dir (MonitorStateGlobDirs _ _ _ entries) =
 768         [ res
 769         | (subdir, fstate) <- entries
 770         , res <- allMatchingFiles (dir </> subdir) fstate
 771         ]
 772       allMatchingFiles dir MonitorStateGlobDirTrailing =
 773         [dir]
 774 probeMonitorStateGlobRel
 775   _
 776   _
 777   root
 778   dirName
 779   (MonitorStateGlobFiles glob mtime children) = do
 780     change <- liftIO $ checkDirectoryModificationTime (root </> dirName) mtime
 781     mtime' <- case change of
 782       Nothing -> return mtime
 783       Just mtime' -> do
 784         -- directory modification time changed:
 785         -- a matching file may have been added or deleted
 786         matches <-
 787           return . filter (matchGlob glob)
 788             =<< liftIO (getDirectoryContents (root </> dirName))
 789
 790         traverse_ probeMergeResult $
 791           mergeBy
 792             (\(path1, _) path2 -> compare path1 path2)
 793             children
 794             (sort matches)
 795         return mtime'
 796
 797     -- Check that none of the children have changed
 798     for_ children $ \(file, status) ->
 799       probeMonitorStateFileStatus root (dirName </> file) status
 800
 801     return (MonitorStateGlobFiles glob mtime' children)
 802     where
 803       -- Again, we don't force a cache rewrite with 'cacheChanged', but we do use
 804       -- the new mtime' if any.
 805
 806       probeMergeResult
 807         :: MergeResult (FilePath, MonitorStateFileStatus) FilePath
 808         -> ChangedM ()
 809       probeMergeResult mr = case mr of
 810         InBoth _ _ -> return ()
 811         -- this is just to be able to accurately report which file changed:
 812         OnlyInLeft (path, _) -> somethingChanged (dirName </> path)
 813         OnlyInRight path -> somethingChanged (dirName </> path)
 814 probeMonitorStateGlobRel _ _ _ _ MonitorStateGlobDirTrailing =
 815   return MonitorStateGlobDirTrailing
 816
 817 ------------------------------------------------------------------------------
 818
 819 -- | Update the input value and the set of files monitored by the
 820 -- 'FileMonitor', plus the cached value that may be returned in future.
 821 --
 822 -- This takes a snapshot of the state of the monitored files right now, so
 823 -- 'checkFileMonitorChanged' will look for file system changes relative to
 824 -- this snapshot.
 825 --
 826 -- This is typically done once the action has been completed successfully and
 827 -- we have the action's result and we know what files it looked at. See
 828 -- 'FileMonitor' for a full explanation.
 829 --
 830 -- If we do take the snapshot after the action has completed then we have a
 831 -- problem. The problem is that files might have changed /while/ the action was
 832 -- running but /after/ the action read them. If we take the snapshot after the
 833 -- action completes then we will miss these changes. The solution is to record
 834 -- a timestamp before beginning execution of the action and then we make the
 835 -- conservative assumption that any file that has changed since then has
 836 -- already changed, ie the file monitor state for these files will be such that
 837 -- 'checkFileMonitorChanged' will report that they have changed.
 838 --
 839 -- So if you do use 'updateFileMonitor' after the action (so you can discover
 840 -- the files used rather than predicting them in advance) then use
 841 -- 'beginUpdateFileMonitor' to get a timestamp and pass that. Alternatively,
 842 -- if you take the snapshot in advance of the action, or you're not monitoring
 843 -- any files then you can use @Nothing@ for the timestamp parameter.
 844 updateFileMonitor
 845   :: (Binary a, Structured a, Binary b, Structured b)
 846   => FileMonitor a b
 847   -- ^ cache file path
 848   -> FilePath
 849   -- ^ root directory
 850   -> Maybe MonitorTimestamp
 851   -- ^ timestamp when the update action started
 852   -> [MonitorFilePath]
 853   -- ^ files of interest relative to root
 854   -> a
 855   -- ^ the current key value
 856   -> b
 857   -- ^ the current result value
 858   -> IO ()
 859 updateFileMonitor
 860   monitor
 861   root
 862   startTime
 863   monitorFiles
 864   cachedKey
 865   cachedResult = do
 866     hashcache <- readCacheFileHashes monitor
 867     msfs <- buildMonitorStateFileSet startTime hashcache root monitorFiles
 868     rewriteCacheFile monitor msfs cachedKey cachedResult
 869
 870 -- | A timestamp to help with the problem of file changes during actions.
 871 -- See 'updateFileMonitor' for details.
 872 newtype MonitorTimestamp = MonitorTimestamp ModTime
 873
 874 -- | Record a timestamp at the beginning of an action, and when the action
 875 -- completes call 'updateFileMonitor' passing it the timestamp.
 876 -- See 'updateFileMonitor' for details.
 877 beginUpdateFileMonitor :: IO MonitorTimestamp
 878 beginUpdateFileMonitor = MonitorTimestamp <$> getCurTime
 879
 880 -- | Take the snapshot of the monitored files. That is, given the
 881 -- specification of the set of files we need to monitor, inspect the state
 882 -- of the file system now and collect the information we'll need later to
 883 -- determine if anything has changed.
 884 buildMonitorStateFileSet
 885   :: Maybe MonitorTimestamp
 886   -- ^ optional: timestamp
 887   -- of the start of the action
 888   -> FileHashCache
 889   -- ^ existing file hashes
 890   -> FilePath
 891   -- ^ root directory
 892   -> [MonitorFilePath]
 893   -- ^ patterns of interest
 894   --   relative to root
 895   -> IO MonitorStateFileSet
 896 buildMonitorStateFileSet mstartTime hashcache root =
 897   go [] []
 898   where
 899     go
 900       :: [MonitorStateFile]
 901       -> [MonitorStateGlob]
 902       -> [MonitorFilePath]
 903       -> IO MonitorStateFileSet
 904     go !singlePaths !globPaths [] =
 905       return (MonitorStateFileSet (reverse singlePaths) (reverse globPaths))
 906     go
 907       !singlePaths
 908       !globPaths
 909       (MonitorFile kindfile kinddir path : monitors) = do
 910         monitorState <-
 911           MonitorStateFile kindfile kinddir path
 912             <$> buildMonitorStateFile
 913               mstartTime
 914               hashcache
 915               kindfile
 916               kinddir
 917               root
 918               path
 919         go (monitorState : singlePaths) globPaths monitors
 920     go
 921       !singlePaths
 922       !globPaths
 923       (MonitorFileGlob kindfile kinddir globPath : monitors) = do
 924         monitorState <-
 925           buildMonitorStateGlob
 926             mstartTime
 927             hashcache
 928             kindfile
 929             kinddir
 930             root
 931             globPath
 932         go singlePaths (monitorState : globPaths) monitors
 933
 934 buildMonitorStateFile
 935   :: Maybe MonitorTimestamp
 936   -- ^ start time of update
 937   -> FileHashCache
 938   -- ^ existing file hashes
 939   -> MonitorKindFile
 940   -> MonitorKindDir
 941   -> FilePath
 942   -- ^ the root directory
 943   -> FilePath
 944   -> IO MonitorStateFileStatus
 945 buildMonitorStateFile mstartTime hashcache kindfile kinddir root path = do
 946   let abspath = root </> path
 947   isFile <- doesFileExist abspath
 948   isDir <- doesDirectoryExist abspath
 949   case (isFile, kindfile, isDir, kinddir) of
 950     (_, FileNotExists, _, DirNotExists) ->
 951       -- we don't need to care if it exists now, since we check at probe time
 952       return MonitorStateNonExistent
 953     (False, _, False, _) ->
 954       return MonitorStateAlreadyChanged
 955     (True, FileExists, _, _) ->
 956       return MonitorStateFileExists
 957     (True, FileModTime, _, _) ->
 958       handleIOException MonitorStateAlreadyChanged $ do
 959         mtime <- getModTime abspath
 960         if changedDuringUpdate mstartTime mtime
 961           then return MonitorStateAlreadyChanged
 962           else return (MonitorStateFileModTime mtime)
 963     (True, FileHashed, _, _) ->
 964       handleIOException MonitorStateAlreadyChanged $ do
 965         mtime <- getModTime abspath
 966         if changedDuringUpdate mstartTime mtime
 967           then return MonitorStateAlreadyChanged
 968           else do
 969             hash <- getFileHash hashcache abspath abspath mtime
 970             return (MonitorStateFileHashed mtime hash)
 971     (_, _, True, DirExists) ->
 972       return MonitorStateDirExists
 973     (_, _, True, DirModTime) ->
 974       handleIOException MonitorStateAlreadyChanged $ do
 975         mtime <- getModTime abspath
 976         if changedDuringUpdate mstartTime mtime
 977           then return MonitorStateAlreadyChanged
 978           else return (MonitorStateDirModTime mtime)
 979     (False, _, True, DirNotExists) -> return MonitorStateAlreadyChanged
 980     (True, FileNotExists, False, _) -> return MonitorStateAlreadyChanged
 981
 982 -- | If we have a timestamp for the beginning of the update, then any file
 983 -- mtime later than this means that it changed during the update and we ought
 984 -- to consider the file as already changed.
 985 changedDuringUpdate :: Maybe MonitorTimestamp -> ModTime -> Bool
 986 changedDuringUpdate (Just (MonitorTimestamp startTime)) mtime =
 987   mtime > startTime
 988 changedDuringUpdate _ _ = False
 989
 990 -- | Much like 'buildMonitorStateFileSet' but for the somewhat complicated case
 991 -- of a file glob.
 992 --
 993 -- This gets used both by 'buildMonitorStateFileSet' when we're taking the
 994 -- file system snapshot, but also by 'probeGlobStatus' as part of checking
 995 -- the monitored (globed) files for changes when we find a whole new subtree.
 996 buildMonitorStateGlob
 997   :: Maybe MonitorTimestamp
 998   -- ^ start time of update
 999   -> FileHashCache
1000   -- ^ existing file hashes
1001   -> MonitorKindFile
1002   -> MonitorKindDir
1003   -> FilePath
1004   -- ^ the root directory
1005   -> FilePathGlob
1006   -- ^ the matching glob
1007   -> IO MonitorStateGlob
1008 buildMonitorStateGlob
1009   mstartTime
1010   hashcache
1011   kindfile
1012   kinddir
1013   relroot
1014   (FilePathGlob globroot globPath) = do
1015     root <- liftIO $ getFilePathRootDirectory globroot relroot
1016     MonitorStateGlob kindfile kinddir globroot
1017       <$> buildMonitorStateGlobRel
1018         mstartTime
1019         hashcache
1020         kindfile
1021         kinddir
1022         root
1023         "."
1024         globPath
1025
1026 buildMonitorStateGlobRel
1027   :: Maybe MonitorTimestamp
1028   -- ^ start time of update
1029   -> FileHashCache
1030   -- ^ existing file hashes
1031   -> MonitorKindFile
1032   -> MonitorKindDir
1033   -> FilePath
1034   -- ^ the root directory
1035   -> FilePath
1036   -- ^ directory we are examining
1037   --   relative to the root
1038   -> FilePathGlobRel
1039   -- ^ the matching glob
1040   -> IO MonitorStateGlobRel
1041 buildMonitorStateGlobRel
1042   mstartTime
1043   hashcache
1044   kindfile
1045   kinddir
1046   root
1047   dir
1048   globPath = do
1049     let absdir = root </> dir
1050     dirEntries <- getDirectoryContents absdir
1051     dirMTime <- getModTime absdir
1052     case globPath of
1053       GlobDir glob globPath' -> do
1054         subdirs <-
1055           filterM (\subdir -> doesDirectoryExist (absdir </> subdir)) $
1056             filter (matchGlob glob) dirEntries
1057         subdirStates <-
1058           for (sort subdirs) $ \subdir -> do
1059             fstate <-
1060               buildMonitorStateGlobRel
1061                 mstartTime
1062                 hashcache
1063                 kindfile
1064                 kinddir
1065                 root
1066                 (dir </> subdir)
1067                 globPath'
1068             return (subdir, fstate)
1069         return $! MonitorStateGlobDirs glob globPath' dirMTime subdirStates
1070       GlobFile glob -> do
1071         let files = filter (matchGlob glob) dirEntries
1072         filesStates <-
1073           for (sort files) $ \file -> do
1074             fstate <-
1075               buildMonitorStateFile
1076                 mstartTime
1077                 hashcache
1078                 kindfile
1079                 kinddir
1080                 root
1081                 (dir </> file)
1082             return (file, fstate)
1083         return $! MonitorStateGlobFiles glob dirMTime filesStates
1084       GlobDirTrailing ->
1085         return MonitorStateGlobDirTrailing
1086
1087 -- | We really want to avoid re-hashing files all the time. We already make
1088 -- the assumption that if a file mtime has not changed then we don't need to
1089 -- bother checking if the content hash has changed. We can apply the same
1090 -- assumption when updating the file monitor state. In the typical case of
1091 -- updating a file monitor the set of files is the same or largely the same so
1092 -- we can grab the previously known content hashes with their corresponding
1093 -- mtimes.
1094 type FileHashCache = Map FilePath (ModTime, Hash)
1095
1096 -- | We declare it a cache hit if the mtime of a file is the same as before.
1097 lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe Hash
1098 lookupFileHashCache hashcache file mtime = do
1099   (mtime', hash) <- Map.lookup file hashcache
1100   guard (mtime' == mtime)
1101   return hash
1102
1103 -- | Either get it from the cache or go read the file
1104 getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
1105 getFileHash hashcache relfile absfile mtime =
1106   case lookupFileHashCache hashcache relfile mtime of
1107     Just hash -> return hash
1108     Nothing -> readFileHash absfile
1109
1110 -- | Build a 'FileHashCache' from the previous 'MonitorStateFileSet'. While
1111 -- in principle we could preserve the structure of the previous state, given
1112 -- that the set of files to monitor can change then it's simpler just to throw
1113 -- away the structure and use a finite map.
1114 readCacheFileHashes
1115   :: (Binary a, Structured a, Binary b, Structured b)
1116   => FileMonitor a b
1117   -> IO FileHashCache
1118 readCacheFileHashes monitor =
1119   handleDoesNotExist Map.empty $
1120     handleErrorCall Map.empty $
1121       withCacheFile monitor $ \res ->
1122         case res of
1123           Left _ -> return Map.empty
1124           Right (msfs, _, _) -> return (mkFileHashCache msfs)
1125   where
1126     mkFileHashCache :: MonitorStateFileSet -> FileHashCache
1127     mkFileHashCache (MonitorStateFileSet singlePaths globPaths) =
1128       collectAllFileHashes singlePaths
1129         `Map.union` collectAllGlobHashes globPaths
1130
1131     collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, Hash)
1132     collectAllFileHashes singlePaths =
1133       Map.fromList
1134         [ (fpath, (mtime, hash))
1135         | MonitorStateFile
1136             _
1137             _
1138             fpath
1139             (MonitorStateFileHashed mtime hash) <-
1140             singlePaths
1141         ]
1142
1143     collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, Hash)
1144     collectAllGlobHashes globPaths =
1145       Map.fromList
1146         [ (fpath, (mtime, hash))
1147         | MonitorStateGlob _ _ _ gstate <- globPaths
1148         , (fpath, (mtime, hash)) <- collectGlobHashes "" gstate
1149         ]
1150
1151     collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
1152     collectGlobHashes dir (MonitorStateGlobDirs _ _ _ entries) =
1153       [ res
1154       | (subdir, fstate) <- entries
1155       , res <- collectGlobHashes (dir </> subdir) fstate
1156       ]
1157     collectGlobHashes dir (MonitorStateGlobFiles _ _ entries) =
1158       [ (dir </> fname, (mtime, hash))
1159       | (fname, MonitorStateFileHashed mtime hash) <- entries
1160       ]
1161     collectGlobHashes _dir MonitorStateGlobDirTrailing =
1162       []
1163
1164 ------------------------------------------------------------------------------
1165 -- Utils
1166 --
1167
1168 -- | Within the @root@ directory, check if @file@ has its 'ModTime' is
1169 -- the same as @mtime@, short-circuiting if it is different.
1170 probeFileModificationTime :: FilePath -> FilePath -> ModTime -> ChangedM ()
1171 probeFileModificationTime root file mtime = do
1172   unchanged <- liftIO $ checkModificationTimeUnchanged root file mtime
1173   unless unchanged (somethingChanged file)
1174
1175 -- | Within the @root@ directory, check if @file@ has its 'ModTime' and
1176 -- 'Hash' is the same as @mtime@ and @hash@, short-circuiting if it is
1177 -- different.
1178 probeFileModificationTimeAndHash
1179   :: FilePath
1180   -> FilePath
1181   -> ModTime
1182   -> Hash
1183   -> ChangedM ()
1184 probeFileModificationTimeAndHash root file mtime hash = do
1185   unchanged <-
1186     liftIO $
1187       checkFileModificationTimeAndHashUnchanged root file mtime hash
1188   unless unchanged (somethingChanged file)
1189
1190 -- | Within the @root@ directory, check if @file@ still exists as a file.
1191 -- If it *does not* exist, short-circuit.
1192 probeFileExistence :: FilePath -> FilePath -> ChangedM ()
1193 probeFileExistence root file = do
1194   existsFile <- liftIO $ doesFileExist (root </> file)
1195   unless existsFile (somethingChanged file)
1196
1197 -- | Within the @root@ directory, check if @dir@ still exists.
1198 -- If it *does not* exist, short-circuit.
1199 probeDirExistence :: FilePath -> FilePath -> ChangedM ()
1200 probeDirExistence root dir = do
1201   existsDir <- liftIO $ doesDirectoryExist (root </> dir)
1202   unless existsDir (somethingChanged dir)
1203
1204 -- | Within the @root@ directory, check if @file@ still does not exist.
1205 -- If it *does* exist, short-circuit.
1206 probeFileNonExistence :: FilePath -> FilePath -> ChangedM ()
1207 probeFileNonExistence root file = do
1208   existsFile <- liftIO $ doesFileExist (root </> file)
1209   existsDir <- liftIO $ doesDirectoryExist (root </> file)
1210   when (existsFile || existsDir) (somethingChanged file)
1211
1212 -- | Returns @True@ if, inside the @root@ directory, @file@ has the same
1213 -- 'ModTime' as @mtime@.
1214 checkModificationTimeUnchanged
1215   :: FilePath
1216   -> FilePath
1217   -> ModTime
1218   -> IO Bool
1219 checkModificationTimeUnchanged root file mtime =
1220   handleIOException False $ do
1221     mtime' <- getModTime (root </> file)
1222     return (mtime == mtime')
1223
1224 -- | Returns @True@ if, inside the @root@ directory, @file@ has the
1225 -- same 'ModTime' and 'Hash' as @mtime and @chash@.
1226 checkFileModificationTimeAndHashUnchanged
1227   :: FilePath
1228   -> FilePath
1229   -> ModTime
1230   -> Hash
1231   -> IO Bool
1232 checkFileModificationTimeAndHashUnchanged root file mtime chash =
1233   handleIOException False $ do
1234     mtime' <- getModTime (root </> file)
1235     if mtime == mtime'
1236       then return True
1237       else do
1238         chash' <- readFileHash (root </> file)
1239         return (chash == chash')
1240
1241 -- | Read a non-cryptographic hash of a @file@.
1242 readFileHash :: FilePath -> IO Hash
1243 readFileHash file =
1244   withBinaryFile file ReadMode $ \hnd ->
1245     evaluate . Hashable.hash =<< BS.hGetContents hnd
1246
1247 -- | Given a directory @dir@, return @Nothing@ if its 'ModTime'
1248 -- is the same as @mtime@, and the new 'ModTime' if it is not.
1249 checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
1250 checkDirectoryModificationTime dir mtime =
1251   handleIOException Nothing $ do
1252     mtime' <- getModTime dir
1253     if mtime == mtime'
1254       then return Nothing
1255       else return (Just mtime')
1256
1257 -- | Run an IO computation, returning the first argument @e@ if there is an 'error'
1258 -- call. ('ErrorCall')
1259 handleErrorCall :: a -> IO a -> IO a
1260 handleErrorCall e = handle handler where
1261 #if MIN_VERSION_base(4,9,0)
1262     handler (ErrorCallWithLocation _ _) = return e
1263 #else
1264     handler (ErrorCall _) = return e
1265 #endif
1266
1267 -- | Run an IO computation, returning @e@ if there is any 'IOException'.
1268 --
1269 -- This policy is OK in the file monitor code because it just causes the
1270 -- monitor to report that something changed, and then code reacting to that
1271 -- will normally encounter the same IO exception when it re-runs the action
1272 -- that uses the file.
1273 handleIOException :: a -> IO a -> IO a
1274 handleIOException e =
1275   handle (anyIOException e)
1276   where
1277     anyIOException :: a -> IOException -> IO a
1278     anyIOException x _ = return x
1279
1280 ------------------------------------------------------------------------------
1281 -- Instances
1282 --