{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric, DeriveFunctor, GeneralizedNewtypeDeriving,
NamedFieldPuns, BangPatterns, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.FileMonitor (
MonitorFilePath(..),
MonitorKindFile(..),
MonitorKindDir(..),
FilePathGlob(..),
monitorFile,
monitorFileHashed,
monitorNonExistentFile,
monitorFileExistence,
monitorDirectory,
monitorNonExistentDirectory,
monitorDirectoryExistence,
monitorFileOrDirectory,
monitorFileGlob,
monitorFileGlobExistence,
monitorFileSearchPath,
monitorFileHashedSearchPath,
FileMonitor(..),
newFileMonitor,
MonitorChanged(..),
MonitorChangedReason(..),
checkFileMonitorChanged,
updateFileMonitor,
MonitorTimestamp,
beginUpdateFileMonitor,
MonitorStateFileSet,
MonitorStateFile,
MonitorStateGlob,
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import qualified Distribution.Compat.Binary as Binary
import qualified Data.Map.Strict as Map
import Data.Binary.Get (runGetOrFail)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Hashable as Hashable
import Control.Monad
import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.State (StateT, mapStateT)
import qualified Control.Monad.State as State
import Control.Monad.Except (ExceptT, runExceptT, withExceptT,
throwError)
import Control.Exception
import Distribution.Compat.Time
import Distribution.Client.Glob
import Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
import Distribution.Client.Utils (mergeBy, MergeResult(..))
import Distribution.Utils.Structured (structuredEncode, Tag (..))
import System.FilePath
import System.Directory
import System.IO
data MonitorFilePath =
MonitorFile {
MonitorFilePath -> MonitorKindFile
monitorKindFile :: !MonitorKindFile,
MonitorFilePath -> MonitorKindDir
monitorKindDir :: !MonitorKindDir,
MonitorFilePath -> FilePath
monitorPath :: !FilePath
}
| MonitorFileGlob {
monitorKindFile :: !MonitorKindFile,
monitorKindDir :: !MonitorKindDir,
MonitorFilePath -> FilePathGlob
monitorPathGlob :: !FilePathGlob
}
deriving (MonitorFilePath -> MonitorFilePath -> Bool
(MonitorFilePath -> MonitorFilePath -> Bool)
-> (MonitorFilePath -> MonitorFilePath -> Bool)
-> Eq MonitorFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorFilePath -> MonitorFilePath -> Bool
$c/= :: MonitorFilePath -> MonitorFilePath -> Bool
== :: MonitorFilePath -> MonitorFilePath -> Bool
$c== :: MonitorFilePath -> MonitorFilePath -> Bool
Eq, Int -> MonitorFilePath -> ShowS
[MonitorFilePath] -> ShowS
MonitorFilePath -> FilePath
(Int -> MonitorFilePath -> ShowS)
-> (MonitorFilePath -> FilePath)
-> ([MonitorFilePath] -> ShowS)
-> Show MonitorFilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorFilePath] -> ShowS
$cshowList :: [MonitorFilePath] -> ShowS
show :: MonitorFilePath -> FilePath
$cshow :: MonitorFilePath -> FilePath
showsPrec :: Int -> MonitorFilePath -> ShowS
$cshowsPrec :: Int -> MonitorFilePath -> ShowS
Show, (forall x. MonitorFilePath -> Rep MonitorFilePath x)
-> (forall x. Rep MonitorFilePath x -> MonitorFilePath)
-> Generic MonitorFilePath
forall x. Rep MonitorFilePath x -> MonitorFilePath
forall x. MonitorFilePath -> Rep MonitorFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorFilePath x -> MonitorFilePath
$cfrom :: forall x. MonitorFilePath -> Rep MonitorFilePath x
Generic)
data MonitorKindFile = FileExists
| FileModTime
| FileHashed
| FileNotExists
deriving (MonitorKindFile -> MonitorKindFile -> Bool
(MonitorKindFile -> MonitorKindFile -> Bool)
-> (MonitorKindFile -> MonitorKindFile -> Bool)
-> Eq MonitorKindFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorKindFile -> MonitorKindFile -> Bool
$c/= :: MonitorKindFile -> MonitorKindFile -> Bool
== :: MonitorKindFile -> MonitorKindFile -> Bool
$c== :: MonitorKindFile -> MonitorKindFile -> Bool
Eq, Int -> MonitorKindFile -> ShowS
[MonitorKindFile] -> ShowS
MonitorKindFile -> FilePath
(Int -> MonitorKindFile -> ShowS)
-> (MonitorKindFile -> FilePath)
-> ([MonitorKindFile] -> ShowS)
-> Show MonitorKindFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindFile] -> ShowS
$cshowList :: [MonitorKindFile] -> ShowS
show :: MonitorKindFile -> FilePath
$cshow :: MonitorKindFile -> FilePath
showsPrec :: Int -> MonitorKindFile -> ShowS
$cshowsPrec :: Int -> MonitorKindFile -> ShowS
Show, (forall x. MonitorKindFile -> Rep MonitorKindFile x)
-> (forall x. Rep MonitorKindFile x -> MonitorKindFile)
-> Generic MonitorKindFile
forall x. Rep MonitorKindFile x -> MonitorKindFile
forall x. MonitorKindFile -> Rep MonitorKindFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorKindFile x -> MonitorKindFile
$cfrom :: forall x. MonitorKindFile -> Rep MonitorKindFile x
Generic)
data MonitorKindDir = DirExists
| DirModTime
| DirNotExists
deriving (MonitorKindDir -> MonitorKindDir -> Bool
(MonitorKindDir -> MonitorKindDir -> Bool)
-> (MonitorKindDir -> MonitorKindDir -> Bool) -> Eq MonitorKindDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorKindDir -> MonitorKindDir -> Bool
$c/= :: MonitorKindDir -> MonitorKindDir -> Bool
== :: MonitorKindDir -> MonitorKindDir -> Bool
$c== :: MonitorKindDir -> MonitorKindDir -> Bool
Eq, Int -> MonitorKindDir -> ShowS
[MonitorKindDir] -> ShowS
MonitorKindDir -> FilePath
(Int -> MonitorKindDir -> ShowS)
-> (MonitorKindDir -> FilePath)
-> ([MonitorKindDir] -> ShowS)
-> Show MonitorKindDir
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorKindDir] -> ShowS
$cshowList :: [MonitorKindDir] -> ShowS
show :: MonitorKindDir -> FilePath
$cshow :: MonitorKindDir -> FilePath
showsPrec :: Int -> MonitorKindDir -> ShowS
$cshowsPrec :: Int -> MonitorKindDir -> ShowS
Show, (forall x. MonitorKindDir -> Rep MonitorKindDir x)
-> (forall x. Rep MonitorKindDir x -> MonitorKindDir)
-> Generic MonitorKindDir
forall x. Rep MonitorKindDir x -> MonitorKindDir
forall x. MonitorKindDir -> Rep MonitorKindDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorKindDir x -> MonitorKindDir
$cfrom :: forall x. MonitorKindDir -> Rep MonitorKindDir x
Generic)
instance Binary MonitorFilePath
instance Binary MonitorKindFile
instance Binary MonitorKindDir
instance Structured MonitorFilePath
instance Structured MonitorKindFile
instance Structured MonitorKindDir
monitorFile :: FilePath -> MonitorFilePath
monitorFile :: FilePath -> MonitorFilePath
monitorFile = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirNotExists
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed :: FilePath -> MonitorFilePath
monitorFileHashed = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileHashed MonitorKindDir
DirNotExists
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirNotExists
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileExists MonitorKindDir
DirNotExists
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory :: FilePath -> MonitorFilePath
monitorDirectory = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirModTime
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
monitorNonExistentDirectory = FilePath -> MonitorFilePath
monitorNonExistentFile
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence :: FilePath -> MonitorFilePath
monitorDirectoryExistence = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileNotExists MonitorKindDir
DirExists
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory :: FilePath -> MonitorFilePath
monitorFileOrDirectory = MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
FileModTime MonitorKindDir
DirModTime
monitorFileGlob :: FilePathGlob -> MonitorFilePath
monitorFileGlob :: FilePathGlob -> MonitorFilePath
monitorFileGlob = MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileHashed MonitorKindDir
DirExists
monitorFileGlobExistence :: FilePathGlob -> MonitorFilePath
monitorFileGlobExistence :: FilePathGlob -> MonitorFilePath
monitorFileGlobExistence = MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
FileExists MonitorKindDir
DirExists
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
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
data MonitorStateFileSet
= MonitorStateFileSet ![MonitorStateFile]
![MonitorStateGlob]
deriving (Int -> MonitorStateFileSet -> ShowS
[MonitorStateFileSet] -> ShowS
MonitorStateFileSet -> FilePath
(Int -> MonitorStateFileSet -> ShowS)
-> (MonitorStateFileSet -> FilePath)
-> ([MonitorStateFileSet] -> ShowS)
-> Show MonitorStateFileSet
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileSet] -> ShowS
$cshowList :: [MonitorStateFileSet] -> ShowS
show :: MonitorStateFileSet -> FilePath
$cshow :: MonitorStateFileSet -> FilePath
showsPrec :: Int -> MonitorStateFileSet -> ShowS
$cshowsPrec :: Int -> MonitorStateFileSet -> ShowS
Show, (forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x)
-> (forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet)
-> Generic MonitorStateFileSet
forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorStateFileSet x -> MonitorStateFileSet
$cfrom :: forall x. MonitorStateFileSet -> Rep MonitorStateFileSet x
Generic)
instance Binary MonitorStateFileSet
instance Structured MonitorStateFileSet
type Hash = Int
data MonitorStateFile = MonitorStateFile !MonitorKindFile !MonitorKindDir
!FilePath !MonitorStateFileStatus
deriving (Int -> MonitorStateFile -> ShowS
[MonitorStateFile] -> ShowS
MonitorStateFile -> FilePath
(Int -> MonitorStateFile -> ShowS)
-> (MonitorStateFile -> FilePath)
-> ([MonitorStateFile] -> ShowS)
-> Show MonitorStateFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFile] -> ShowS
$cshowList :: [MonitorStateFile] -> ShowS
show :: MonitorStateFile -> FilePath
$cshow :: MonitorStateFile -> FilePath
showsPrec :: Int -> MonitorStateFile -> ShowS
$cshowsPrec :: Int -> MonitorStateFile -> ShowS
Show, (forall x. MonitorStateFile -> Rep MonitorStateFile x)
-> (forall x. Rep MonitorStateFile x -> MonitorStateFile)
-> Generic MonitorStateFile
forall x. Rep MonitorStateFile x -> MonitorStateFile
forall x. MonitorStateFile -> Rep MonitorStateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorStateFile x -> MonitorStateFile
$cfrom :: forall x. MonitorStateFile -> Rep MonitorStateFile x
Generic)
data MonitorStateFileStatus
= MonitorStateFileExists
| MonitorStateFileModTime !ModTime
| MonitorStateFileHashed !ModTime !Hash
| MonitorStateDirExists
| MonitorStateDirModTime !ModTime
| MonitorStateNonExistent
| MonitorStateAlreadyChanged
deriving (Int -> MonitorStateFileStatus -> ShowS
[MonitorStateFileStatus] -> ShowS
MonitorStateFileStatus -> FilePath
(Int -> MonitorStateFileStatus -> ShowS)
-> (MonitorStateFileStatus -> FilePath)
-> ([MonitorStateFileStatus] -> ShowS)
-> Show MonitorStateFileStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateFileStatus] -> ShowS
$cshowList :: [MonitorStateFileStatus] -> ShowS
show :: MonitorStateFileStatus -> FilePath
$cshow :: MonitorStateFileStatus -> FilePath
showsPrec :: Int -> MonitorStateFileStatus -> ShowS
$cshowsPrec :: Int -> MonitorStateFileStatus -> ShowS
Show, (forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x)
-> (forall x.
Rep MonitorStateFileStatus x -> MonitorStateFileStatus)
-> Generic MonitorStateFileStatus
forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorStateFileStatus x -> MonitorStateFileStatus
$cfrom :: forall x. MonitorStateFileStatus -> Rep MonitorStateFileStatus x
Generic)
instance Binary MonitorStateFile
instance Binary MonitorStateFileStatus
instance Structured MonitorStateFile
instance Structured MonitorStateFileStatus
data MonitorStateGlob = MonitorStateGlob !MonitorKindFile !MonitorKindDir
!FilePathRoot !MonitorStateGlobRel
deriving (Int -> MonitorStateGlob -> ShowS
[MonitorStateGlob] -> ShowS
MonitorStateGlob -> FilePath
(Int -> MonitorStateGlob -> ShowS)
-> (MonitorStateGlob -> FilePath)
-> ([MonitorStateGlob] -> ShowS)
-> Show MonitorStateGlob
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlob] -> ShowS
$cshowList :: [MonitorStateGlob] -> ShowS
show :: MonitorStateGlob -> FilePath
$cshow :: MonitorStateGlob -> FilePath
showsPrec :: Int -> MonitorStateGlob -> ShowS
$cshowsPrec :: Int -> MonitorStateGlob -> ShowS
Show, (forall x. MonitorStateGlob -> Rep MonitorStateGlob x)
-> (forall x. Rep MonitorStateGlob x -> MonitorStateGlob)
-> Generic MonitorStateGlob
forall x. Rep MonitorStateGlob x -> MonitorStateGlob
forall x. MonitorStateGlob -> Rep MonitorStateGlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorStateGlob x -> MonitorStateGlob
$cfrom :: forall x. MonitorStateGlob -> Rep MonitorStateGlob x
Generic)
data MonitorStateGlobRel
= MonitorStateGlobDirs
!Glob !FilePathGlobRel
!ModTime
![(FilePath, MonitorStateGlobRel)]
| MonitorStateGlobFiles
!Glob
!ModTime
![(FilePath, MonitorStateFileStatus)]
| MonitorStateGlobDirTrailing
deriving (Int -> MonitorStateGlobRel -> ShowS
[MonitorStateGlobRel] -> ShowS
MonitorStateGlobRel -> FilePath
(Int -> MonitorStateGlobRel -> ShowS)
-> (MonitorStateGlobRel -> FilePath)
-> ([MonitorStateGlobRel] -> ShowS)
-> Show MonitorStateGlobRel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorStateGlobRel] -> ShowS
$cshowList :: [MonitorStateGlobRel] -> ShowS
show :: MonitorStateGlobRel -> FilePath
$cshow :: MonitorStateGlobRel -> FilePath
showsPrec :: Int -> MonitorStateGlobRel -> ShowS
$cshowsPrec :: Int -> MonitorStateGlobRel -> ShowS
Show, (forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x)
-> (forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel)
-> Generic MonitorStateGlobRel
forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonitorStateGlobRel x -> MonitorStateGlobRel
$cfrom :: forall x. MonitorStateGlobRel -> Rep MonitorStateGlobRel x
Generic)
instance Binary MonitorStateGlob
instance Binary MonitorStateGlobRel
instance Structured MonitorStateGlob
instance Structured MonitorStateGlobRel
reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
(MonitorStateFile -> MonitorFilePath)
-> [MonitorStateFile] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateFile -> MonitorFilePath
getSinglePath [MonitorStateFile]
singlePaths [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++ (MonitorStateGlob -> MonitorFilePath)
-> [MonitorStateGlob] -> [MonitorFilePath]
forall a b. (a -> b) -> [a] -> [b]
map MonitorStateGlob -> MonitorFilePath
getGlobPath [MonitorStateGlob]
globPaths
where
getSinglePath :: MonitorStateFile -> MonitorFilePath
getSinglePath :: MonitorStateFile -> MonitorFilePath
getSinglePath (MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath MonitorStateFileStatus
_) =
MonitorKindFile -> MonitorKindDir -> FilePath -> MonitorFilePath
MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
filepath
getGlobPath :: MonitorStateGlob -> MonitorFilePath
getGlobPath :: MonitorStateGlob -> MonitorFilePath
getGlobPath (MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
root MonitorStateGlobRel
gstate) =
MonitorKindFile
-> MonitorKindDir -> FilePathGlob -> MonitorFilePath
MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir (FilePathGlob -> MonitorFilePath)
-> FilePathGlob -> MonitorFilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob FilePathRoot
root (FilePathGlobRel -> FilePathGlob)
-> FilePathGlobRel -> FilePathGlob
forall a b. (a -> b) -> a -> b
$
case MonitorStateGlobRel
gstate of
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globs ModTime
_ [(FilePath, MonitorStateGlobRel)]
_ -> Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir Glob
glob FilePathGlobRel
globs
MonitorStateGlobFiles Glob
glob ModTime
_ [(FilePath, MonitorStateFileStatus)]
_ -> Glob -> FilePathGlobRel
GlobFile Glob
glob
MonitorStateGlobRel
MonitorStateGlobDirTrailing -> FilePathGlobRel
GlobDirTrailing
data FileMonitor a b
= FileMonitor {
FileMonitor a b -> FilePath
fileMonitorCacheFile :: FilePath,
FileMonitor a b -> a -> a -> Bool
fileMonitorKeyValid :: a -> a -> Bool,
FileMonitor a b -> Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
}
newFileMonitor :: Eq a => FilePath
-> FileMonitor a b
newFileMonitor :: FilePath -> FileMonitor a b
newFileMonitor FilePath
path = FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
forall a b. FilePath -> (a -> a -> Bool) -> Bool -> FileMonitor a b
FileMonitor FilePath
path a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Bool
False
data MonitorChanged a b =
MonitorUnchanged b [MonitorFilePath]
| MonitorChanged (MonitorChangedReason a)
deriving Int -> MonitorChanged a b -> ShowS
[MonitorChanged a b] -> ShowS
MonitorChanged a b -> FilePath
(Int -> MonitorChanged a b -> ShowS)
-> (MonitorChanged a b -> FilePath)
-> ([MonitorChanged a b] -> ShowS)
-> Show (MonitorChanged a b)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
showList :: [MonitorChanged a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [MonitorChanged a b] -> ShowS
show :: MonitorChanged a b -> FilePath
$cshow :: forall a b. (Show b, Show a) => MonitorChanged a b -> FilePath
showsPrec :: Int -> MonitorChanged a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> MonitorChanged a b -> ShowS
Show
data MonitorChangedReason a =
MonitoredFileChanged FilePath
| MonitoredValueChanged a
| MonitorFirstRun
| MonitorCorruptCache
deriving (MonitorChangedReason a -> MonitorChangedReason a -> Bool
(MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> (MonitorChangedReason a -> MonitorChangedReason a -> Bool)
-> Eq (MonitorChangedReason a)
forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorChangedReason a -> MonitorChangedReason a -> Bool
$c/= :: forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
== :: MonitorChangedReason a -> MonitorChangedReason a -> Bool
$c== :: forall a.
Eq a =>
MonitorChangedReason a -> MonitorChangedReason a -> Bool
Eq, Int -> MonitorChangedReason a -> ShowS
[MonitorChangedReason a] -> ShowS
MonitorChangedReason a -> FilePath
(Int -> MonitorChangedReason a -> ShowS)
-> (MonitorChangedReason a -> FilePath)
-> ([MonitorChangedReason a] -> ShowS)
-> Show (MonitorChangedReason a)
forall a. Show a => Int -> MonitorChangedReason a -> ShowS
forall a. Show a => [MonitorChangedReason a] -> ShowS
forall a. Show a => MonitorChangedReason a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MonitorChangedReason a] -> ShowS
$cshowList :: forall a. Show a => [MonitorChangedReason a] -> ShowS
show :: MonitorChangedReason a -> FilePath
$cshow :: forall a. Show a => MonitorChangedReason a -> FilePath
showsPrec :: Int -> MonitorChangedReason a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MonitorChangedReason a -> ShowS
Show, a -> MonitorChangedReason b -> MonitorChangedReason a
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
(forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b)
-> (forall a b.
a -> MonitorChangedReason b -> MonitorChangedReason a)
-> Functor MonitorChangedReason
forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MonitorChangedReason b -> MonitorChangedReason a
$c<$ :: forall a b. a -> MonitorChangedReason b -> MonitorChangedReason a
fmap :: (a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
$cfmap :: forall a b.
(a -> b) -> MonitorChangedReason a -> MonitorChangedReason b
Functor)
checkFileMonitorChanged
:: forall a b. (Binary a, Structured a, Binary b, Structured b)
=> FileMonitor a b
-> FilePath
-> a
-> IO (MonitorChanged a b)
checkFileMonitorChanged :: FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged
monitor :: FileMonitor a b
monitor@FileMonitor { a -> a -> Bool
fileMonitorKeyValid :: a -> a -> Bool
fileMonitorKeyValid :: forall a b. FileMonitor a b -> a -> a -> Bool
fileMonitorKeyValid,
Bool
fileMonitorCheckIfOnlyValueChanged :: Bool
fileMonitorCheckIfOnlyValueChanged :: forall a b. FileMonitor a b -> Bool
fileMonitorCheckIfOnlyValueChanged }
FilePath
root a
currentKey =
MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleDoesNotExist (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorFirstRun) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
MonitorChanged a b
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a. a -> IO a -> IO a
handleErrorCall (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache) (IO (MonitorChanged a b) -> IO (MonitorChanged a b))
-> IO (MonitorChanged a b) -> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b))
-> IO (MonitorChanged a b))
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b))
-> IO (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$
(FilePath -> IO (MonitorChanged a b))
-> ((MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b))
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
_ -> MonitorChanged a b -> IO (MonitorChanged a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache))
(MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
checkStatusCache
where
checkStatusCache :: (MonitorStateFileSet, a, Either String b) -> IO (MonitorChanged a b)
checkStatusCache :: (MonitorStateFileSet, a, Either FilePath b)
-> IO (MonitorChanged a b)
checkStatusCache (MonitorStateFileSet
cachedFileStatus, a
cachedKey, Either FilePath b
cachedResult) = do
Maybe (MonitorChangedReason a)
change <- IO (Maybe (MonitorChangedReason a))
checkForChanges
case Maybe (MonitorChangedReason a)
change of
Just MonitorChangedReason a
reason -> MonitorChanged a b -> IO (MonitorChanged a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
reason)
Maybe (MonitorChangedReason a)
Nothing -> case Either FilePath b
cachedResult of
Left FilePath
_ -> MonitorChanged a b -> IO (MonitorChanged a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MonitorChangedReason a -> MonitorChanged a b
forall a b. MonitorChangedReason a -> MonitorChanged a b
MonitorChanged MonitorChangedReason a
forall a. MonitorChangedReason a
MonitorCorruptCache)
Right b
cr -> MonitorChanged a b -> IO (MonitorChanged a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> [MonitorFilePath] -> MonitorChanged a b
forall a b. b -> [MonitorFilePath] -> MonitorChanged a b
MonitorUnchanged b
cr [MonitorFilePath]
monitorFiles)
where monitorFiles :: [MonitorFilePath]
monitorFiles = MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths MonitorStateFileSet
cachedFileStatus
where
checkForChanges :: IO (Maybe (MonitorChangedReason a))
checkForChanges :: IO (Maybe (MonitorChangedReason a))
checkForChanges
| Bool
fileMonitorCheckIfOnlyValueChanged
= MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult
IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
`mplusMaybeT`
a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
| Bool
otherwise
= a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a1.
Monad m =>
m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
`mplusMaybeT`
MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult
mplusMaybeT :: Monad m => m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
mplusMaybeT :: m (Maybe a1) -> m (Maybe a1) -> m (Maybe a1)
mplusMaybeT m (Maybe a1)
ma m (Maybe a1)
mb = do
Maybe a1
mx <- m (Maybe a1)
ma
case Maybe a1
mx of
Maybe a1
Nothing -> m (Maybe a1)
mb
Just a1
x -> Maybe a1 -> m (Maybe a1)
forall (m :: * -> *) a. Monad m => a -> m a
return (a1 -> Maybe a1
forall a. a -> Maybe a
Just a1
x)
checkValueChange :: a -> IO (Maybe (MonitorChangedReason a))
checkValueChange :: a -> IO (Maybe (MonitorChangedReason a))
checkValueChange a
cachedKey
| Bool -> Bool
not (a -> a -> Bool
fileMonitorKeyValid a
currentKey a
cachedKey)
= Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> Maybe (MonitorChangedReason a)
forall a. a -> Maybe a
Just (a -> MonitorChangedReason a
forall a. a -> MonitorChangedReason a
MonitoredValueChanged a
cachedKey))
| Bool
otherwise
= Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MonitorChangedReason a)
forall a. Maybe a
Nothing
checkFileChange :: MonitorStateFileSet -> a -> Either String b -> IO (Maybe (MonitorChangedReason a))
checkFileChange :: MonitorStateFileSet
-> a -> Either FilePath b -> IO (Maybe (MonitorChangedReason a))
checkFileChange MonitorStateFileSet
cachedFileStatus a
cachedKey Either FilePath b
cachedResult = do
Either FilePath (MonitorStateFileSet, CacheChanged)
res <- FilePath
-> MonitorStateFileSet
-> IO (Either FilePath (MonitorStateFileSet, CacheChanged))
probeFileSystem FilePath
root MonitorStateFileSet
cachedFileStatus
case Either FilePath (MonitorStateFileSet, CacheChanged)
res of
Left FilePath
changedPath ->
Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorChangedReason a -> Maybe (MonitorChangedReason a)
forall a. a -> Maybe a
Just (FilePath -> MonitorChangedReason a
forall a. FilePath -> MonitorChangedReason a
MonitoredFileChanged (ShowS
normalise FilePath
changedPath)))
Right (MonitorStateFileSet
cachedFileStatus', CacheChanged
cacheStatus) -> do
CacheChanged -> IO () -> IO ()
forall (m :: * -> *). Monad m => CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
cacheStatus (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
case Either FilePath b
cachedResult of
Left FilePath
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right b
cr -> FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
cachedFileStatus' a
cachedKey b
cr
Maybe (MonitorChangedReason a)
-> IO (Maybe (MonitorChangedReason a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MonitorChangedReason a)
forall a. Maybe a
Nothing
structuredDecodeTriple
:: forall a b c. (Structured a, Structured b, Structured c, Binary.Binary a, Binary.Binary b, Binary.Binary c)
=> BS.ByteString -> Either String (a, b, Either String c)
structuredDecodeTriple :: ByteString -> Either FilePath (a, b, Either FilePath c)
structuredDecodeTriple ByteString
lbs =
let partialDecode :: Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
partialDecode =
(Get (a, b)
-> ByteString
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
`runGetOrFail` ByteString
lbs) (Get (a, b)
-> Either
(ByteString, ByteOffset, FilePath)
(ByteString, ByteOffset, (a, b)))
-> Get (a, b)
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
forall a b. (a -> b) -> a -> b
$ do
(Tag (a, b, c)
_ :: Tag (a,b,c)) <- Get (Tag (a, b, c))
forall t. Binary t => Get t
Binary.get
(a
a :: a) <- Get a
forall t. Binary t => Get t
Binary.get
(b
b :: b) <- Get b
forall t. Binary t => Get t
Binary.get
(a, b) -> Get (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
cleanEither :: Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither (Left (a
_, a
pos, FilePath
msg)) = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
pos FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
cleanEither (Right (a
_,b
_,b
v)) = b -> Either FilePath b
forall a b. b -> Either a b
Right b
v
in case Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, (a, b))
partialDecode of
Left (ByteString
_, ByteOffset
pos, FilePath
msg) -> FilePath -> Either FilePath (a, b, Either FilePath c)
forall a b. a -> Either a b
Left (FilePath
"Data.Binary.Get.runGet at position " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteOffset -> FilePath
forall a. Show a => a -> FilePath
show ByteOffset
pos FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
Right (ByteString
lbs', ByteOffset
_, (a
x,b
y)) -> (a, b, Either FilePath c)
-> Either FilePath (a, b, Either FilePath c)
forall a b. b -> Either a b
Right (a
x, b
y, Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall a a a b b.
Show a =>
Either (a, a, FilePath) (a, b, b) -> Either FilePath b
cleanEither (Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c)
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
-> Either FilePath c
forall a b. (a -> b) -> a -> b
$ Get c
-> ByteString
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, c)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
runGetOrFail (Get c
forall t. Binary t => Get t
Binary.get :: Binary.Get c) ByteString
lbs')
withCacheFile :: (Binary a, Structured a, Binary b, Structured b)
=> FileMonitor a b
-> (Either String (MonitorStateFileSet, a, Either String b) -> IO r)
-> IO r
withCacheFile :: FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO r)
-> IO r
withCacheFile (FileMonitor {FilePath
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile}) Either FilePath (MonitorStateFileSet, a, Either FilePath b) -> IO r
k =
FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fileMonitorCacheFile IOMode
ReadMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
Either FilePath (MonitorStateFileSet, a, Either FilePath b)
contents <- ByteString
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b)
forall a b c.
(Structured a, Structured b, Structured c, Binary a, Binary b,
Binary c) =>
ByteString -> Either FilePath (a, b, Either FilePath c)
structuredDecodeTriple (ByteString
-> Either FilePath (MonitorStateFileSet, a, Either FilePath b))
-> IO ByteString
-> IO (Either FilePath (MonitorStateFileSet, a, Either FilePath b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BS.hGetContents Handle
hnd
Either FilePath (MonitorStateFileSet, a, Either FilePath b) -> IO r
k Either FilePath (MonitorStateFileSet, a, Either FilePath b)
contents
rewriteCacheFile :: (Binary a, Structured a, Binary b, Structured b)
=> FileMonitor a b
-> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile :: FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor {FilePath
fileMonitorCacheFile :: FilePath
fileMonitorCacheFile :: forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile} MonitorStateFileSet
fileset a
key b
result =
FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
fileMonitorCacheFile (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
(MonitorStateFileSet, a, b) -> ByteString
forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode (MonitorStateFileSet
fileset, a
key, b
result)
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 ]
[MonitorStateGlob]
globPaths' <-
[ChangedM MonitorStateGlob] -> ChangedM [MonitorStateGlob]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ FilePath -> MonitorStateGlob -> ChangedM MonitorStateGlob
probeMonitorStateGlob FilePath
root MonitorStateGlob
globPath
| MonitorStateGlob
globPath <- [MonitorStateGlob]
globPaths ]
MonitorStateFileSet -> ChangedM MonitorStateFileSet
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths')
newtype ChangedM a = ChangedM (StateT CacheChanged (ExceptT FilePath IO) a)
deriving (a -> ChangedM b -> ChangedM a
(a -> b) -> ChangedM a -> ChangedM b
(forall a b. (a -> b) -> ChangedM a -> ChangedM b)
-> (forall a b. a -> ChangedM b -> ChangedM a) -> Functor ChangedM
forall a b. a -> ChangedM b -> ChangedM a
forall a b. (a -> b) -> ChangedM a -> ChangedM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ChangedM b -> ChangedM a
$c<$ :: forall a b. a -> ChangedM b -> ChangedM a
fmap :: (a -> b) -> ChangedM a -> ChangedM b
$cfmap :: forall a b. (a -> b) -> ChangedM a -> ChangedM b
Functor, Functor ChangedM
a -> ChangedM a
Functor ChangedM
-> (forall a. a -> ChangedM a)
-> (forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b)
-> (forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM b)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM a)
-> Applicative ChangedM
ChangedM a -> ChangedM b -> ChangedM b
ChangedM a -> ChangedM b -> ChangedM a
ChangedM (a -> b) -> ChangedM a -> ChangedM b
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
forall a. a -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM b
forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ChangedM a -> ChangedM b -> ChangedM a
$c<* :: forall a b. ChangedM a -> ChangedM b -> ChangedM a
*> :: ChangedM a -> ChangedM b -> ChangedM b
$c*> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
liftA2 :: (a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ChangedM a -> ChangedM b -> ChangedM c
<*> :: ChangedM (a -> b) -> ChangedM a -> ChangedM b
$c<*> :: forall a b. ChangedM (a -> b) -> ChangedM a -> ChangedM b
pure :: a -> ChangedM a
$cpure :: forall a. a -> ChangedM a
$cp1Applicative :: Functor ChangedM
Applicative, Applicative ChangedM
a -> ChangedM a
Applicative ChangedM
-> (forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b)
-> (forall a b. ChangedM a -> ChangedM b -> ChangedM b)
-> (forall a. a -> ChangedM a)
-> Monad ChangedM
ChangedM a -> (a -> ChangedM b) -> ChangedM b
ChangedM a -> ChangedM b -> ChangedM b
forall a. a -> ChangedM a
forall a b. ChangedM a -> ChangedM b -> ChangedM b
forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ChangedM a
$creturn :: forall a. a -> ChangedM a
>> :: ChangedM a -> ChangedM b -> ChangedM b
$c>> :: forall a b. ChangedM a -> ChangedM b -> ChangedM b
>>= :: ChangedM a -> (a -> ChangedM b) -> ChangedM b
$c>>= :: forall a b. ChangedM a -> (a -> ChangedM b) -> ChangedM b
$cp1Monad :: Applicative ChangedM
Monad, Monad ChangedM
Monad ChangedM
-> (forall a. IO a -> ChangedM a) -> MonadIO ChangedM
IO a -> ChangedM a
forall a. IO a -> ChangedM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ChangedM a
$cliftIO :: forall a. IO a -> ChangedM a
$cp1MonadIO :: Monad ChangedM
MonadIO)
runChangedM :: ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM :: ChangedM a -> IO (Either FilePath (a, CacheChanged))
runChangedM (ChangedM StateT CacheChanged (ExceptT FilePath IO) a
action) =
ExceptT FilePath IO (a, CacheChanged)
-> IO (Either FilePath (a, CacheChanged))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO (a, CacheChanged)
-> IO (Either FilePath (a, CacheChanged)))
-> ExceptT FilePath IO (a, CacheChanged)
-> IO (Either FilePath (a, CacheChanged))
forall a b. (a -> b) -> a -> b
$ StateT CacheChanged (ExceptT FilePath IO) a
-> CacheChanged -> ExceptT FilePath IO (a, CacheChanged)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT StateT CacheChanged (ExceptT FilePath IO) a
action CacheChanged
CacheUnchanged
somethingChanged :: FilePath -> ChangedM a
somethingChanged :: FilePath -> ChangedM a
somethingChanged FilePath
path = StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM (StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a)
-> StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a b. (a -> b) -> a -> b
$ FilePath -> StateT CacheChanged (ExceptT FilePath IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
path
cacheChanged :: ChangedM ()
cacheChanged :: ChangedM ()
cacheChanged = StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ()
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM (StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ())
-> StateT CacheChanged (ExceptT FilePath IO) () -> ChangedM ()
forall a b. (a -> b) -> a -> b
$ CacheChanged -> StateT CacheChanged (ExceptT FilePath IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put CacheChanged
CacheChanged
mapChangedFile :: (FilePath -> FilePath) -> ChangedM a -> ChangedM a
mapChangedFile :: ShowS -> ChangedM a -> ChangedM a
mapChangedFile ShowS
adjust (ChangedM StateT CacheChanged (ExceptT FilePath IO) a
a) =
StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
forall a. StateT CacheChanged (ExceptT FilePath IO) a -> ChangedM a
ChangedM ((ExceptT FilePath IO (a, CacheChanged)
-> ExceptT FilePath IO (a, CacheChanged))
-> StateT CacheChanged (ExceptT FilePath IO) a
-> StateT CacheChanged (ExceptT FilePath IO) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (ShowS
-> ExceptT FilePath IO (a, CacheChanged)
-> ExceptT FilePath IO (a, CacheChanged)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ShowS
adjust) StateT CacheChanged (ExceptT FilePath IO) a
a)
data CacheChanged = CacheChanged | CacheUnchanged
whenCacheChanged :: Monad m => CacheChanged -> m () -> m ()
whenCacheChanged :: CacheChanged -> m () -> m ()
whenCacheChanged CacheChanged
CacheChanged m ()
action = m ()
action
whenCacheChanged CacheChanged
CacheUnchanged m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
probeMonitorStateFileStatus :: FilePath -> FilePath
-> MonitorStateFileStatus
-> ChangedM ()
probeMonitorStateFileStatus :: FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root FilePath
file MonitorStateFileStatus
status =
case MonitorStateFileStatus
status of
MonitorStateFileStatus
MonitorStateFileExists ->
FilePath -> FilePath -> ChangedM ()
probeFileExistence FilePath
root FilePath
file
MonitorStateFileModTime ModTime
mtime ->
FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
MonitorStateFileHashed ModTime
mtime Int
hash ->
FilePath -> FilePath -> ModTime -> Int -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Int
hash
MonitorStateFileStatus
MonitorStateDirExists ->
FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
file
MonitorStateDirModTime ModTime
mtime ->
FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime
MonitorStateFileStatus
MonitorStateNonExistent ->
FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file
MonitorStateFileStatus
MonitorStateAlreadyChanged ->
FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file
probeMonitorStateGlob :: FilePath
-> MonitorStateGlob
-> ChangedM MonitorStateGlob
probeMonitorStateGlob :: FilePath -> MonitorStateGlob -> ChangedM MonitorStateGlob
probeMonitorStateGlob FilePath
relroot
(MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot MonitorStateGlobRel
glob) = do
FilePath
root <- IO FilePath -> ChangedM FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ChangedM FilePath)
-> IO FilePath -> ChangedM FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
case FilePathRoot
globroot of
FilePathRoot
FilePathRelative ->
MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot (MonitorStateGlobRel -> MonitorStateGlob)
-> ChangedM MonitorStateGlobRel -> ChangedM MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"." MonitorStateGlobRel
glob
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
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel :: MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
dirName
(MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children) = do
Maybe ModTime
change <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
case Maybe ModTime
change of
Maybe ModTime
Nothing -> do
[(FilePath, MonitorStateGlobRel)]
children' <- [ChangedM (FilePath, MonitorStateGlobRel)]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ do MonitorStateGlobRel
fstate' <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel
MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
(FilePath
dirName FilePath -> ShowS
</> FilePath
fname) MonitorStateGlobRel
fstate
(FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fname, MonitorStateGlobRel
fstate')
| (FilePath
fname, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
children ]
MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath ModTime
mtime [(FilePath, MonitorStateGlobRel)]
children'
Just ModTime
mtime' -> do
[FilePath]
matches <- (FilePath -> ChangedM Bool) -> [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
entry -> let subdir :: FilePath
subdir = FilePath
root FilePath -> ShowS
</> FilePath
dirName FilePath -> ShowS
</> FilePath
entry
in IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
subdir)
([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))
[(FilePath, MonitorStateGlobRel)]
children' <- (MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel))
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult ([MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)])
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
-> ChangedM [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$
((FilePath, MonitorStateGlobRel) -> FilePath -> Ordering)
-> [(FilePath, MonitorStateGlobRel)]
-> [FilePath]
-> [MergeResult (FilePath, MonitorStateGlobRel) FilePath]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(FilePath
path1,MonitorStateGlobRel
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
[(FilePath, MonitorStateGlobRel)]
children
([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath ModTime
mtime' [(FilePath, MonitorStateGlobRel)]
children'
where
probeMergeResult :: MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult :: MergeResult (FilePath, MonitorStateGlobRel) FilePath
-> ChangedM (FilePath, MonitorStateGlobRel)
probeMergeResult (OnlyInLeft (FilePath
path, MonitorStateGlobRel
fstate)) = do
case FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate of
[] -> (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate)
(FilePath
file:[FilePath]
_) -> FilePath -> ChangedM (FilePath, MonitorStateGlobRel)
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file
probeMergeResult (OnlyInRight FilePath
path) = do
MonitorStateGlobRel
fstate <- IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel)
-> IO MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$ Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel Maybe MonitorTimestamp
forall a. Maybe a
Nothing FileHashCache
forall k a. Map k a
Map.empty
MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
path) FilePathGlobRel
globPath
case FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate of
(FilePath
file:[FilePath]
_) -> FilePath -> ChangedM (FilePath, MonitorStateGlobRel)
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file
[] -> ChangedM ()
cacheChanged ChangedM ()
-> ChangedM (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate)
probeMergeResult (InBoth (FilePath
path, MonitorStateGlobRel
fstate) FilePath
_) = do
MonitorStateGlobRel
fstate' <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> MonitorStateGlobRel
-> ChangedM MonitorStateGlobRel
probeMonitorStateGlobRel MonitorKindFile
kindfile MonitorKindDir
kinddir
FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
path) MonitorStateGlobRel
fstate
(FilePath, MonitorStateGlobRel)
-> ChangedM (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, MonitorStateGlobRel
fstate')
allMatchingFiles :: FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles :: FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles FilePath
dir (MonitorStateGlobFiles Glob
_ ModTime
_ [(FilePath, MonitorStateFileStatus)]
entries) =
[ FilePath
dir FilePath -> ShowS
</> FilePath
fname | (FilePath
fname, MonitorStateFileStatus
_) <- [(FilePath, MonitorStateFileStatus)]
entries ]
allMatchingFiles FilePath
dir (MonitorStateGlobDirs Glob
_ FilePathGlobRel
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
[ FilePath
res
| (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
, FilePath
res <- FilePath -> MonitorStateGlobRel -> [FilePath]
allMatchingFiles (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) MonitorStateGlobRel
fstate ]
allMatchingFiles FilePath
dir MonitorStateGlobRel
MonitorStateGlobDirTrailing =
[FilePath
dir]
probeMonitorStateGlobRel MonitorKindFile
_ MonitorKindDir
_ FilePath
root FilePath
dirName
(MonitorStateGlobFiles Glob
glob ModTime
mtime [(FilePath, MonitorStateFileStatus)]
children) = do
Maybe ModTime
change <- IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModTime) -> ChangedM (Maybe ModTime))
-> IO (Maybe ModTime) -> ChangedM (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime (FilePath
root FilePath -> ShowS
</> FilePath
dirName) ModTime
mtime
ModTime
mtime' <- case Maybe ModTime
change of
Maybe ModTime
Nothing -> ModTime -> ChangedM ModTime
forall (m :: * -> *) a. Monad m => a -> m a
return ModTime
mtime
Just ModTime
mtime' -> do
[FilePath]
matches <- [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> ChangedM [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> ChangedM [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob)
([FilePath] -> ChangedM [FilePath])
-> ChangedM [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> ChangedM [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> ShowS
</> FilePath
dirName))
(MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ())
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
-> ChangedM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ()
probeMergeResult ([MergeResult (FilePath, MonitorStateFileStatus) FilePath]
-> ChangedM ())
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
-> ChangedM ()
forall a b. (a -> b) -> a -> b
$
((FilePath, MonitorStateFileStatus) -> FilePath -> Ordering)
-> [(FilePath, MonitorStateFileStatus)]
-> [FilePath]
-> [MergeResult (FilePath, MonitorStateFileStatus) FilePath]
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy (\(FilePath
path1,MonitorStateFileStatus
_) FilePath
path2 -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
path1 FilePath
path2)
[(FilePath, MonitorStateFileStatus)]
children
([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
matches)
ModTime -> ChangedM ModTime
forall (m :: * -> *) a. Monad m => a -> m a
return ModTime
mtime'
[(FilePath, MonitorStateFileStatus)]
-> ((FilePath, MonitorStateFileStatus) -> ChangedM ())
-> ChangedM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(FilePath, MonitorStateFileStatus)]
children (((FilePath, MonitorStateFileStatus) -> ChangedM ())
-> ChangedM ())
-> ((FilePath, MonitorStateFileStatus) -> ChangedM ())
-> ChangedM ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
file, MonitorStateFileStatus
status) ->
FilePath -> FilePath -> MonitorStateFileStatus -> ChangedM ()
probeMonitorStateFileStatus FilePath
root (FilePath
dirName FilePath -> ShowS
</> FilePath
file) MonitorStateFileStatus
status
MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (Glob
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles Glob
glob ModTime
mtime' [(FilePath, MonitorStateFileStatus)]
children)
where
probeMergeResult :: MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ()
probeMergeResult :: MergeResult (FilePath, MonitorStateFileStatus) FilePath
-> ChangedM ()
probeMergeResult MergeResult (FilePath, MonitorStateFileStatus) FilePath
mr = case MergeResult (FilePath, MonitorStateFileStatus) FilePath
mr of
InBoth (FilePath, MonitorStateFileStatus)
_ FilePath
_ -> () -> ChangedM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
OnlyInLeft (FilePath
path, MonitorStateFileStatus
_) -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
OnlyInRight FilePath
path -> FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged (FilePath
dirName FilePath -> ShowS
</> FilePath
path)
probeMonitorStateGlobRel MonitorKindFile
_ MonitorKindDir
_ FilePath
_ FilePath
_ MonitorStateGlobRel
MonitorStateGlobDirTrailing =
MonitorStateGlobRel -> ChangedM MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateGlobRel
MonitorStateGlobDirTrailing
updateFileMonitor
:: (Binary a, Structured a, Binary b, Structured b)
=> FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor :: FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor a b
monitor FilePath
root Maybe MonitorTimestamp
startTime [MonitorFilePath]
monitorFiles
a
cachedKey b
cachedResult = do
FileHashCache
hashcache <- FileMonitor a b -> IO FileHashCache
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor
MonitorStateFileSet
msfs <- Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
startTime FileHashCache
hashcache FilePath
root [MonitorFilePath]
monitorFiles
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> MonitorStateFileSet -> a -> b -> IO ()
rewriteCacheFile FileMonitor a b
monitor MonitorStateFileSet
msfs a
cachedKey b
cachedResult
newtype MonitorTimestamp = MonitorTimestamp ModTime
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
buildMonitorStateFileSet :: Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet :: Maybe MonitorTimestamp
-> FileHashCache
-> FilePath
-> [MonitorFilePath]
-> IO MonitorStateFileSet
buildMonitorStateFileSet Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache FilePath
root =
[MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [] []
where
go :: [MonitorStateFile] -> [MonitorStateGlob]
-> [MonitorFilePath] -> IO MonitorStateFileSet
go :: [MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths [] =
MonitorStateFileSet -> IO MonitorStateFileSet
forall (m :: * -> *) a. Monad m => a -> m a
return ([MonitorStateFile] -> [MonitorStateGlob] -> MonitorStateFileSet
MonitorStateFileSet ([MonitorStateFile] -> [MonitorStateFile]
forall a. [a] -> [a]
reverse [MonitorStateFile]
singlePaths) ([MonitorStateGlob] -> [MonitorStateGlob]
forall a. [a] -> [a]
reverse [MonitorStateGlob]
globPaths))
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths
(MonitorFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path : [MonitorFilePath]
monitors) = do
MonitorStateFile
monitorState <- MonitorKindFile
-> MonitorKindDir
-> FilePath
-> MonitorStateFileStatus
-> MonitorStateFile
MonitorStateFile MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
path
(MonitorStateFileStatus -> MonitorStateFile)
-> IO MonitorStateFileStatus -> IO MonitorStateFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache
MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
path
[MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go (MonitorStateFile
monitorState MonitorStateFile -> [MonitorStateFile] -> [MonitorStateFile]
forall a. a -> [a] -> [a]
: [MonitorStateFile]
singlePaths) [MonitorStateGlob]
globPaths [MonitorFilePath]
monitors
go ![MonitorStateFile]
singlePaths ![MonitorStateGlob]
globPaths
(MonitorFileGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathGlob
globPath : [MonitorFilePath]
monitors) = do
MonitorStateGlob
monitorState <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePathGlob
-> IO MonitorStateGlob
buildMonitorStateGlob Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache
MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePathGlob
globPath
[MonitorStateFile]
-> [MonitorStateGlob]
-> [MonitorFilePath]
-> IO MonitorStateFileSet
go [MonitorStateFile]
singlePaths (MonitorStateGlob
monitorState MonitorStateGlob -> [MonitorStateGlob] -> [MonitorStateGlob]
forall a. a -> [a] -> [a]
: [MonitorStateGlob]
globPaths) [MonitorFilePath]
monitors
buildMonitorStateFile :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile -> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
path = do
let abspath :: FilePath
abspath = FilePath
root FilePath -> ShowS
</> FilePath
path
Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
abspath
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
abspath
case (Bool
isFile, MonitorKindFile
kindfile, Bool
isDir, MonitorKindDir
kinddir) of
(Bool
_, MonitorKindFile
FileNotExists, Bool
_, MonitorKindDir
DirNotExists) ->
MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateNonExistent
(Bool
False, MonitorKindFile
_, Bool
False, MonitorKindDir
_) ->
MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
(Bool
True, MonitorKindFile
FileExists, Bool
_, MonitorKindDir
_) ->
MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateFileExists
(Bool
True, MonitorKindFile
FileModTime, Bool
_, MonitorKindDir
_) ->
MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateFileModTime ModTime
mtime)
(Bool
True, MonitorKindFile
FileHashed, Bool
_, MonitorKindDir
_) ->
MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
else do Int
hash <- FileHashCache -> FilePath -> FilePath -> ModTime -> IO Int
getFileHash FileHashCache
hashcache FilePath
abspath FilePath
abspath ModTime
mtime
MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Int -> MonitorStateFileStatus
MonitorStateFileHashed ModTime
mtime Int
hash)
(Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirExists) ->
MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateDirExists
(Bool
_, MonitorKindFile
_, Bool
True, MonitorKindDir
DirModTime) ->
MonitorStateFileStatus
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a. a -> IO a -> IO a
handleIOException MonitorStateFileStatus
MonitorStateAlreadyChanged (IO MonitorStateFileStatus -> IO MonitorStateFileStatus)
-> IO MonitorStateFileStatus -> IO MonitorStateFileStatus
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime <- FilePath -> IO ModTime
getModTime FilePath
abspath
if Maybe MonitorTimestamp -> ModTime -> Bool
changedDuringUpdate Maybe MonitorTimestamp
mstartTime ModTime
mtime
then MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
else MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> MonitorStateFileStatus
MonitorStateDirModTime ModTime
mtime)
(Bool
False, MonitorKindFile
_, Bool
True, MonitorKindDir
DirNotExists) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
(Bool
True, MonitorKindFile
FileNotExists, Bool
False, MonitorKindDir
_) -> MonitorStateFileStatus -> IO MonitorStateFileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateFileStatus
MonitorStateAlreadyChanged
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
buildMonitorStateGlob :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile -> MonitorKindDir
-> FilePath
-> FilePathGlob
-> IO MonitorStateGlob
buildMonitorStateGlob :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePathGlob
-> IO MonitorStateGlob
buildMonitorStateGlob Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
relroot
(FilePathGlob FilePathRoot
globroot FilePathGlobRel
globPath) = do
FilePath
root <- IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePathRoot -> FilePath -> IO FilePath
getFilePathRootDirectory FilePathRoot
globroot FilePath
relroot
MonitorKindFile
-> MonitorKindDir
-> FilePathRoot
-> MonitorStateGlobRel
-> MonitorStateGlob
MonitorStateGlob MonitorKindFile
kindfile MonitorKindDir
kinddir FilePathRoot
globroot (MonitorStateGlobRel -> MonitorStateGlob)
-> IO MonitorStateGlobRel -> IO MonitorStateGlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root FilePath
"." FilePathGlobRel
globPath
buildMonitorStateGlobRel :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile -> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel :: Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
FilePath
dir FilePathGlobRel
globPath = do
let absdir :: FilePath
absdir = FilePath
root FilePath -> ShowS
</> FilePath
dir
[FilePath]
dirEntries <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
absdir
ModTime
dirMTime <- FilePath -> IO ModTime
getModTime FilePath
absdir
case FilePathGlobRel
globPath of
GlobDir Glob
glob FilePathGlobRel
globPath' -> do
[FilePath]
subdirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
subdir -> FilePath -> IO Bool
doesDirectoryExist (FilePath
absdir FilePath -> ShowS
</> FilePath
subdir))
([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
[(FilePath, MonitorStateGlobRel)]
subdirStates <-
[FilePath]
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
subdirs) ((FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)])
-> (FilePath -> IO (FilePath, MonitorStateGlobRel))
-> IO [(FilePath, MonitorStateGlobRel)]
forall a b. (a -> b) -> a -> b
$ \FilePath
subdir -> do
MonitorStateGlobRel
fstate <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> FilePathGlobRel
-> IO MonitorStateGlobRel
buildMonitorStateGlobRel
Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
(FilePath
dir FilePath -> ShowS
</> FilePath
subdir) FilePathGlobRel
globPath'
(FilePath, MonitorStateGlobRel)
-> IO (FilePath, MonitorStateGlobRel)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
subdir, MonitorStateGlobRel
fstate)
MonitorStateGlobRel -> IO MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! Glob
-> FilePathGlobRel
-> ModTime
-> [(FilePath, MonitorStateGlobRel)]
-> MonitorStateGlobRel
MonitorStateGlobDirs Glob
glob FilePathGlobRel
globPath' ModTime
dirMTime [(FilePath, MonitorStateGlobRel)]
subdirStates
GlobFile Glob
glob -> do
let files :: [FilePath]
files = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
matchGlob Glob
glob) [FilePath]
dirEntries
[(FilePath, MonitorStateFileStatus)]
filesStates <-
[FilePath]
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
files) ((FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)])
-> (FilePath -> IO (FilePath, MonitorStateFileStatus))
-> IO [(FilePath, MonitorStateFileStatus)]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
MonitorStateFileStatus
fstate <- Maybe MonitorTimestamp
-> FileHashCache
-> MonitorKindFile
-> MonitorKindDir
-> FilePath
-> FilePath
-> IO MonitorStateFileStatus
buildMonitorStateFile
Maybe MonitorTimestamp
mstartTime FileHashCache
hashcache MonitorKindFile
kindfile MonitorKindDir
kinddir FilePath
root
(FilePath
dir FilePath -> ShowS
</> FilePath
file)
(FilePath, MonitorStateFileStatus)
-> IO (FilePath, MonitorStateFileStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, MonitorStateFileStatus
fstate)
MonitorStateGlobRel -> IO MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateGlobRel -> IO MonitorStateGlobRel)
-> MonitorStateGlobRel -> IO MonitorStateGlobRel
forall a b. (a -> b) -> a -> b
$! Glob
-> ModTime
-> [(FilePath, MonitorStateFileStatus)]
-> MonitorStateGlobRel
MonitorStateGlobFiles Glob
glob ModTime
dirMTime [(FilePath, MonitorStateFileStatus)]
filesStates
FilePathGlobRel
GlobDirTrailing ->
MonitorStateGlobRel -> IO MonitorStateGlobRel
forall (m :: * -> *) a. Monad m => a -> m a
return MonitorStateGlobRel
MonitorStateGlobDirTrailing
type FileHashCache = Map FilePath (ModTime, Hash)
lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe Hash
lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe Int
lookupFileHashCache FileHashCache
hashcache FilePath
file ModTime
mtime = do
(ModTime
mtime', Int
hash) <- FilePath -> FileHashCache -> Maybe (ModTime, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
file FileHashCache
hashcache
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModTime
mtime' ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime)
Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
hash
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Int
getFileHash FileHashCache
hashcache FilePath
relfile FilePath
absfile ModTime
mtime =
case FileHashCache -> FilePath -> ModTime -> Maybe Int
lookupFileHashCache FileHashCache
hashcache FilePath
relfile ModTime
mtime of
Just Int
hash -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
hash
Maybe Int
Nothing -> FilePath -> IO Int
readFileHash FilePath
absfile
readCacheFileHashes :: (Binary a, Structured a, Binary b, Structured b)
=> FileMonitor a b -> IO FileHashCache
readCacheFileHashes :: FileMonitor a b -> IO FileHashCache
readCacheFileHashes FileMonitor a b
monitor =
FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleDoesNotExist FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
FileHashCache -> IO FileHashCache -> IO FileHashCache
forall a. a -> IO a -> IO a
handleErrorCall FileHashCache
forall k a. Map k a
Map.empty (IO FileHashCache -> IO FileHashCache)
-> IO FileHashCache -> IO FileHashCache
forall a b. (a -> b) -> a -> b
$
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO FileHashCache)
-> IO FileHashCache
forall a b r.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO r)
-> IO r
withCacheFile FileMonitor a b
monitor ((Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO FileHashCache)
-> IO FileHashCache)
-> (Either FilePath (MonitorStateFileSet, a, Either FilePath b)
-> IO FileHashCache)
-> IO FileHashCache
forall a b. (a -> b) -> a -> b
$ \Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res ->
case Either FilePath (MonitorStateFileSet, a, Either FilePath b)
res of
Left FilePath
_ -> FileHashCache -> IO FileHashCache
forall (m :: * -> *) a. Monad m => a -> m a
return FileHashCache
forall k a. Map k a
Map.empty
Right (MonitorStateFileSet
msfs, a
_, Either FilePath b
_) -> FileHashCache -> IO FileHashCache
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorStateFileSet -> FileHashCache
mkFileHashCache MonitorStateFileSet
msfs)
where
mkFileHashCache :: MonitorStateFileSet -> FileHashCache
mkFileHashCache :: MonitorStateFileSet -> FileHashCache
mkFileHashCache (MonitorStateFileSet [MonitorStateFile]
singlePaths [MonitorStateGlob]
globPaths) =
[MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths
FileHashCache -> FileHashCache -> FileHashCache
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [MonitorStateGlob] -> FileHashCache
collectAllGlobHashes [MonitorStateGlob]
globPaths
collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, Hash)
collectAllFileHashes :: [MonitorStateFile] -> FileHashCache
collectAllFileHashes [MonitorStateFile]
singlePaths =
[(FilePath, (ModTime, Int))] -> FileHashCache
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (FilePath
fpath, (ModTime
mtime, Int
hash))
| MonitorStateFile MonitorKindFile
_ MonitorKindDir
_ FilePath
fpath
(MonitorStateFileHashed ModTime
mtime Int
hash) <- [MonitorStateFile]
singlePaths ]
collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, Hash)
collectAllGlobHashes :: [MonitorStateGlob] -> FileHashCache
collectAllGlobHashes [MonitorStateGlob]
globPaths =
[(FilePath, (ModTime, Int))] -> FileHashCache
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (FilePath
fpath, (ModTime
mtime, Int
hash))
| MonitorStateGlob MonitorKindFile
_ MonitorKindDir
_ FilePathRoot
_ MonitorStateGlobRel
gstate <- [MonitorStateGlob]
globPaths
, (FilePath
fpath, (ModTime
mtime, Int
hash)) <- FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Int))]
collectGlobHashes FilePath
"" MonitorStateGlobRel
gstate ]
collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Int))]
collectGlobHashes FilePath
dir (MonitorStateGlobDirs Glob
_ FilePathGlobRel
_ ModTime
_ [(FilePath, MonitorStateGlobRel)]
entries) =
[ (FilePath, (ModTime, Int))
res
| (FilePath
subdir, MonitorStateGlobRel
fstate) <- [(FilePath, MonitorStateGlobRel)]
entries
, (FilePath, (ModTime, Int))
res <- FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Int))]
collectGlobHashes (FilePath
dir FilePath -> ShowS
</> FilePath
subdir) MonitorStateGlobRel
fstate ]
collectGlobHashes FilePath
dir (MonitorStateGlobFiles Glob
_ ModTime
_ [(FilePath, MonitorStateFileStatus)]
entries) =
[ (FilePath
dir FilePath -> ShowS
</> FilePath
fname, (ModTime
mtime, Int
hash))
| (FilePath
fname, MonitorStateFileHashed ModTime
mtime Int
hash) <- [(FilePath, MonitorStateFileStatus)]
entries ]
collectGlobHashes FilePath
_dir MonitorStateGlobRel
MonitorStateGlobDirTrailing =
[]
probeFileModificationTime :: FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime :: FilePath -> FilePath -> ModTime -> ChangedM ()
probeFileModificationTime FilePath
root FilePath
file ModTime
mtime = do
Bool
unchanged <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ModTime -> IO Bool
checkModificationTimeUnchanged FilePath
root FilePath
file ModTime
mtime
Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)
probeFileModificationTimeAndHash :: FilePath -> FilePath -> ModTime -> Hash
-> ChangedM ()
probeFileModificationTimeAndHash :: FilePath -> FilePath -> ModTime -> Int -> ChangedM ()
probeFileModificationTimeAndHash FilePath
root FilePath
file ModTime
mtime Int
hash = do
Bool
unchanged <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> ModTime -> Int -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime Int
hash
Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
unchanged (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)
probeFileExistence :: FilePath -> FilePath -> ChangedM ()
probeFileExistence :: FilePath -> FilePath -> ChangedM ()
probeFileExistence FilePath
root FilePath
file = do
Bool
existsFile <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsFile (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)
probeDirExistence :: FilePath -> FilePath -> ChangedM ()
probeDirExistence :: FilePath -> FilePath -> ChangedM ()
probeDirExistence FilePath
root FilePath
dir = do
Bool
existsDir <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
dir)
Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsDir (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
dir)
probeFileNonExistence :: FilePath -> FilePath -> ChangedM ()
probeFileNonExistence :: FilePath -> FilePath -> ChangedM ()
probeFileNonExistence FilePath
root FilePath
file = do
Bool
existsFile <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
Bool
existsDir <- IO Bool -> ChangedM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ChangedM Bool) -> IO Bool -> ChangedM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
root FilePath -> ShowS
</> FilePath
file)
Bool -> ChangedM () -> ChangedM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
existsFile Bool -> Bool -> Bool
|| Bool
existsDir) (FilePath -> ChangedM ()
forall a. FilePath -> ChangedM a
somethingChanged FilePath
file)
checkModificationTimeUnchanged :: FilePath -> FilePath
-> ModTime -> IO Bool
checkModificationTimeUnchanged :: FilePath -> FilePath -> ModTime -> IO Bool
checkModificationTimeUnchanged FilePath
root FilePath
file ModTime
mtime =
Bool -> IO Bool -> IO Bool
forall a. a -> IO a -> IO a
handleIOException Bool
False (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime')
checkFileModificationTimeAndHashUnchanged :: FilePath -> FilePath
-> ModTime -> Hash -> IO Bool
checkFileModificationTimeAndHashUnchanged :: FilePath -> FilePath -> ModTime -> Int -> IO Bool
checkFileModificationTimeAndHashUnchanged FilePath
root FilePath
file ModTime
mtime Int
chash =
Bool -> IO Bool -> IO Bool
forall a. a -> IO a -> IO a
handleIOException Bool
False (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime' <- FilePath -> IO ModTime
getModTime (FilePath
root FilePath -> ShowS
</> FilePath
file)
if ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
Int
chash' <- FilePath -> IO Int
readFileHash (FilePath
root FilePath -> ShowS
</> FilePath
file)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
chash Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chash')
readFileHash :: FilePath -> IO Hash
readFileHash :: FilePath -> IO Int
readFileHash FilePath
file =
FilePath -> IOMode -> (Handle -> IO Int) -> IO Int
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
file IOMode
ReadMode ((Handle -> IO Int) -> IO Int) -> (Handle -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> (ByteString -> Int) -> ByteString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall a. Hashable a => a -> Int
Hashable.hash (ByteString -> IO Int) -> IO ByteString -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
BS.hGetContents Handle
hnd
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)
checkDirectoryModificationTime FilePath
dir ModTime
mtime =
Maybe ModTime -> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a. a -> IO a -> IO a
handleIOException Maybe ModTime
forall a. Maybe a
Nothing (IO (Maybe ModTime) -> IO (Maybe ModTime))
-> IO (Maybe ModTime) -> IO (Maybe ModTime)
forall a b. (a -> b) -> a -> b
$ do
ModTime
mtime' <- FilePath -> IO ModTime
getModTime FilePath
dir
if ModTime
mtime ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
mtime'
then Maybe ModTime -> IO (Maybe ModTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModTime
forall a. Maybe a
Nothing
else Maybe ModTime -> IO (Maybe ModTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModTime -> Maybe ModTime
forall a. a -> Maybe a
Just ModTime
mtime')
handleErrorCall :: a -> IO a -> IO a
handleErrorCall :: a -> IO a -> IO a
handleErrorCall a
e = (ErrorCall -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ErrorCall -> IO a
forall (m :: * -> *). Monad m => ErrorCall -> m a
handler where
#if MIN_VERSION_base(4,9,0)
handler :: ErrorCall -> m a
handler (ErrorCallWithLocation FilePath
_ FilePath
_) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e
#else
handler (ErrorCall _) = return e
#endif
handleIOException :: a -> IO a -> IO a
handleIOException :: a -> IO a -> IO a
handleIOException a
e =
(IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (a -> IOException -> IO a
forall a. a -> IOException -> IO a
anyIOException a
e)
where
anyIOException :: a -> IOException -> IO a
anyIOException :: a -> IOException -> IO a
anyIOException a
x IOException
_ = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x