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