Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Distribution.Client.RebuildMonad
Description
An abstraction for re-running actions if values or files have changed.
This is not a full-blown make-style incremental build system, it's a bit more ad-hoc than that, but it's easier to integrate with existing code.
It's a convenient interface to the Distribution.Client.FileMonitor functions.
Synopsis
- data Rebuild a
- runRebuild :: FilePath -> Rebuild a -> IO a
- execRebuild :: FilePath -> Rebuild a -> IO [MonitorFilePath]
- askRoot :: Rebuild FilePath
- monitorFiles :: [MonitorFilePath] -> Rebuild ()
- data MonitorFilePath
- monitorFile :: FilePath -> MonitorFilePath
- monitorFileHashed :: FilePath -> MonitorFilePath
- monitorNonExistentFile :: FilePath -> MonitorFilePath
- monitorDirectory :: FilePath -> MonitorFilePath
- monitorNonExistentDirectory :: FilePath -> MonitorFilePath
- monitorDirectoryExistence :: FilePath -> MonitorFilePath
- monitorFileOrDirectory :: FilePath -> MonitorFilePath
- monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
- monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
- monitorFileGlob :: RootedGlob -> MonitorFilePath
- monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
- data RootedGlob = RootedGlob FilePathRoot Glob
- data FilePathRoot
- data Glob
- data GlobPiece
- = WildCard
- | Literal String
- | Union [GlobPieces]
- data FileMonitor a b = FileMonitor {}
- newFileMonitor :: Eq a => FilePath -> FileMonitor a b
- rerunIfChanged :: (Binary a, Structured a, Binary b, Structured b) => Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
- delayInitSharedResource :: forall a. IO a -> Rebuild (Rebuild a)
- delayInitSharedResources :: forall k v. Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v)
- matchFileGlob :: RootedGlob -> Rebuild [FilePath]
- getDirectoryContentsMonitored :: FilePath -> Rebuild [FilePath]
- createDirectoryMonitored :: Bool -> FilePath -> Rebuild ()
- monitorDirectoryStatus :: FilePath -> Rebuild Bool
- doesFileExistMonitored :: FilePath -> Rebuild Bool
- need :: FilePath -> Rebuild ()
- needIfExists :: FilePath -> Rebuild ()
- findFileWithExtensionMonitored :: [Suffix] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
- findFirstFileMonitored :: forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
- findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
Rebuild monad
A monad layered on top of IO
to help with re-running actions when the
input files and values they depend on change. The crucial operations are
rerunIfChanged
and monitorFiles
.
execRebuild :: FilePath -> Rebuild a -> IO [MonitorFilePath] Source #
Run a Rebuild
IO action.
askRoot :: Rebuild FilePath Source #
The root that relative paths are interpreted as being relative to.
Setting up file monitoring
monitorFiles :: [MonitorFilePath] -> Rebuild () Source #
Use this within the body action of rerunIfChanged
to declare that the
action depends on the given files. This can be based on what the action
actually did. It is these files that will be checked for changes next
time rerunIfChanged
is called for that FileMonitor
.
Relative paths are interpreted as relative to an implicit root, ultimately
passed in to runRebuild
.
data MonitorFilePath #
A description of a file (or set of files) to monitor for changes.
Where file paths are relative they are relative to a common directory (e.g. project root), not necessarily the process current directory.
Instances
monitorFile :: FilePath -> MonitorFilePath #
Monitor a single file for changes, based on its modification time. The monitored file is considered to have changed if it no longer exists or if its modification time has changed.
monitorFileHashed :: FilePath -> MonitorFilePath #
Monitor a single file for changes, based on its modification time and content hash. The monitored file is considered to have changed if it no longer exists or if its modification time and content hash have changed.
monitorNonExistentFile :: FilePath -> MonitorFilePath #
Monitor a single non-existent file for changes. The monitored file is considered to have changed if it exists.
monitorDirectory :: FilePath -> MonitorFilePath #
Monitor a single directory for changes, based on its modification time. The monitored directory is considered to have changed if it no longer exists or if its modification time has changed.
monitorNonExistentDirectory :: FilePath -> MonitorFilePath #
Monitor a single non-existent directory for changes. The monitored directory is considered to have changed if it exists.
monitorDirectoryExistence :: FilePath -> MonitorFilePath #
Monitor a single directory for existence. The monitored directory is considered to have changed only if it no longer exists.
monitorFileOrDirectory :: FilePath -> MonitorFilePath #
Monitor a single file or directory for changes, based on its modification time. The monitored file is considered to have changed if it no longer exists or if its modification time has changed.
monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath] #
Creates a list of files to monitor when you search for a file which
unsuccessfully looked in notFoundAtPaths
before finding it at
foundAtPath
.
monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath] #
Similar to monitorFileSearchPath
, but also instructs us to
monitor the hash of the found file.
Monitoring file globs
monitorFileGlob :: RootedGlob -> MonitorFilePath #
Monitor a set of files (or directories) identified by a file glob. The monitored glob is considered to have changed if the set of files matching the glob changes (i.e. creations or deletions), or for files if the modification time and content hash of any matching file has changed.
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath #
Monitor a set of files (or directories) identified by a file glob for existence only. The monitored glob is considered to have changed if the set of files matching the glob changes (i.e. creations or deletions).
data RootedGlob #
A file path specified by globbing, relative to some root directory.
Constructors
RootedGlob | |
Fields
|
Instances
data FilePathRoot #
Constructors
FilePathRelative | |
FilePathRoot FilePath | e.g. |
FilePathHomeDir |
Instances
A filepath specified by globbing.
Constructors
GlobDir !GlobPieces !Glob | dirGlob/glob |
GlobDirRecursive !GlobPieces |
|
GlobFile !GlobPieces | A file glob. |
GlobDirTrailing | Trailing dir; a glob ending in |
Instances
A piece of a globbing pattern
Constructors
WildCard | A wildcard |
Literal String | A literal string |
Union [GlobPieces] | A union of patterns, e.g. |
Instances
Structured GlobPiece | |
Defined in Distribution.Simple.Glob.Internal | |
Generic GlobPiece | |
Show GlobPiece | |
Binary GlobPiece | |
Eq GlobPiece | |
type Rep GlobPiece | |
Defined in Distribution.Simple.Glob.Internal type Rep GlobPiece = D1 ('MetaData "GlobPiece" "Distribution.Simple.Glob.Internal" "Cabal-3.14.2.0-FceiKquS3QmE92x05ewD3q" 'False) (C1 ('MetaCons "WildCard" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Literal" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)) :+: C1 ('MetaCons "Union" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [GlobPieces])))) |
Using a file monitor
data FileMonitor a b Source #
A monitor for detecting changes to a set of files. It can be used to
efficiently test if any of a set of files (specified individually or by
glob patterns) has changed since some snapshot. In addition, it also checks
for changes in a value (of type a
), and when there are no changes in
either it returns a saved value (of type b
).
The main use case looks like this: suppose we have some expensive action that depends on certain pure inputs and reads some set of files, and produces some pure result. We want to avoid re-running this action when it would produce the same result. So we need to monitor the files the action looked at, the other pure input values, and we need to cache the result. Then at some later point, if the input value didn't change, and none of the files changed, then we can re-use the cached result rather than re-running the action.
This can be achieved using a FileMonitor
. Each FileMonitor
instance
saves state in a disk file, so the file for that has to be specified,
making sure it is unique. The pattern is to use checkFileMonitorChanged
to see if there's been any change. If there is, re-run the action, keeping
track of the files, then use updateFileMonitor
to record the current
set of files to monitor, the current input value for the action, and the
result of the action.
The typical occurrence of this pattern is captured by rerunIfChanged
and the Rebuild
monad. More complicated cases may need to use
checkFileMonitorChanged
and updateFileMonitor
directly.
Constructors
FileMonitor | |
Fields
|
Arguments
:: Eq a | |
=> FilePath | The file to cache the state of the file monitor. Must be unique. |
-> FileMonitor a b |
Define a new file monitor.
It's best practice to define file monitor values once, and then use the
same value for checkFileMonitorChanged
and updateFileMonitor
as this
ensures you get the same types a
and b
for reading and writing.
The path of the file monitor itself must be unique because it keeps state on disk and these would clash.
rerunIfChanged :: (Binary a, Structured a, Binary b, Structured b) => Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b Source #
This captures the standard use pattern for a FileMonitor
: given a
monitor, an action and the input value the action depends on, either
re-run the action to get its output, or if the value and files the action
depends on have not changed then return a previously cached action result.
The result is still in the Rebuild
monad, so these can be nested.
Do not share FileMonitor
s between different uses of rerunIfChanged
.
Utils
delayInitSharedResource :: forall a. IO a -> Rebuild (Rebuild a) Source #
When using rerunIfChanged
for each element of a list of actions, it is
sometimes the case that each action needs to make use of some resource. e.g.
sequence [ rerunIfChanged verbosity monitor key $ do resource <- mkResource ... -- use the resource | ... ]
For efficiency one would like to share the resource between the actions but the straightforward way of doing this means initialising it every time even when no actions need re-running.
resource <- mkResource sequence [ rerunIfChanged verbosity monitor key $ do ... -- use the resource | ... ]
This utility allows one to get the best of both worlds:
getResource <- delayInitSharedResource mkResource sequence [ rerunIfChanged verbosity monitor key $ do resource <- getResource ... -- use the resource | ... ]
delayInitSharedResources :: forall k v. Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v) Source #
Much like delayInitSharedResource
but for a keyed set of resources.
getResource <- delayInitSharedResource mkResource sequence [ rerunIfChanged verbosity monitor key $ do resource <- getResource key ... -- use the resource | ... ]
matchFileGlob :: RootedGlob -> Rebuild [FilePath] Source #
Utility to match a file glob against the file system, starting from a given root directory. The results are all relative to the given root.
Since this operates in the Rebuild
monad, it also monitors the given glob
for changes.
monitorDirectoryStatus :: FilePath -> Rebuild Bool Source #
Monitor a directory as in monitorDirectory
if it currently exists or
as monitorNonExistentDirectory
if it does not.
doesFileExistMonitored :: FilePath -> Rebuild Bool Source #
Like doesFileExist
, but in the Rebuild
monad. This does
NOT track the contents of FilePath
; use need
in that case.
needIfExists :: FilePath -> Rebuild () Source #
Monitor a file if it exists; otherwise check for when it gets created. This is a bit better for recompilation avoidance because sometimes users give bad package metadata, and we don't want to repeatedly rebuild in this case (which we would if we need'ed a non-existent file).
findFileWithExtensionMonitored :: [Suffix] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath) Source #
Like findFileWithExtension
, but in the Rebuild
monad.