| Safe Haskell | None |
|---|
Development.Shake
Contents
Description
This module is used for defining Shake build systems. As a simple example of a Shake build system,
let us build the file result.tar from the files listed by result.txt:
import Development.Shake import Development.Shake.FilePath main =shakeArgsshakeOptions$ dowant["result.tar"] "*.tar"*>\out -> do contents <-readFileLines$ out-<.>"txt"needcontentscmd"tar -cf" [out] contents
We start by importing the modules defining both Shake and routines for manipulating FilePath values.
We define main to call shake with the default shakeOptions. As the second argument to
shake, we provide a set of rules. There are two common forms of rules, want to specify target files,
and *> to define a rule which builds a FilePattern. We use want to require that after the build
completes the file result.tar should be ready.
The *.tar rule describes how to build files with the extension .tar, including result.tar.
We readFileLines on result.txt, after changing the .tar extension to .txt. We read each line
into the variable contents -- being a list of the files that should go into result.tar. Next, we
depend (need) all the files in contents. If any of these files change, the rule will be repeated.
Finally we call the tar program. If either result.txt changes, or any of the files listed by result.txt
change, then result.tar will be rebuilt.
When writing a Shake build system, start by defining what you want, then write rules
with *> to produce the results. Before calling cmd you should ensure that any files the command
requires are demanded with calls to need. We offer the following advice to Shake users:
- If
ghc --makeorcabalis capable of building your project, use that instead. Custom build systems are necessary for many complex projects, but many projects are not complex. - The
shakeArgsfunction automatically handles command line arguments. To define non-file targets usephony. - Put all result files in a distinguished directory, for example
_make. You can implement acleancommand by removing that directory, using.removeFilesAfter"_make" ["//*"] - To obtain parallel builds set
shakeThreadsto a number greater than 1. You may also need to compile with-threaded. - Lots of compilers produce
.ofiles. To avoid overlapping rules, use.c.ofor C compilers,.hs.ofor Haskell compilers etc. - Do not be afraid to mix Shake rules, system commands and other Haskell libraries -- use each for what it does best.
- The more accurate the dependencies are, the better. Use additional rules like
doesFileExistandgetDirectoryFilesto track information other than just the contents of files. For information in the environment that you suspect will change regularly (perhapsghcversion number), either write the information to a file withalwaysRerunandwriteFileChanged, or useaddOracle.
The theory behind Shake is described in an ICFP 2012 paper, Shake Before Building -- Replacing Make with Haskell http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf. The associated talk forms a short overview of Shake http://www.youtube.com/watch?v=xYCPpXVlqFM.
Acknowledgements: Thanks to Austin Seipp for properly integrating the profiling code.
- shake :: ShakeOptions -> Rules () -> IO ()
- shakeOptions :: ShakeOptions
- type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)
- class (ShakeValue key, ShakeValue value) => Rule key value where
- storedValue :: key -> IO (Maybe value)
- data Rules a
- defaultRule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()
- rule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()
- action :: Action a -> Rules ()
- withoutActions :: Rules () -> Rules ()
- data Action a
- apply :: Rule key value => [key] -> Action [value]
- apply1 :: Rule key value => key -> Action value
- traced :: String -> IO a -> Action a
- liftIO :: MonadIO m => forall a. IO a -> m a
- actionOnException :: Action a -> IO b -> Action a
- actionFinally :: Action a -> IO b -> Action a
- data ShakeException = ShakeException {}
- data ShakeOptions = ShakeOptions {
- shakeFiles :: FilePath
- shakeThreads :: Int
- shakeVersion :: String
- shakeVerbosity :: Verbosity
- shakeStaunch :: Bool
- shakeReport :: Maybe FilePath
- shakeLint :: Bool
- shakeFlush :: Maybe Double
- shakeAssume :: Maybe Assume
- shakeAbbreviations :: [(String, String)]
- shakeStorageLog :: Bool
- shakeLineBuffering :: Bool
- shakeTimings :: Bool
- shakeProgress :: IO Progress -> IO ()
- shakeOutput :: Verbosity -> String -> IO ()
- data Assume
- = AssumeDirty
- | AssumeClean
- | AssumeSkip
- shakeArgs :: ShakeOptions -> Rules () -> IO ()
- shakeArgsWith :: ShakeOptions -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
- shakeOptDescrs :: [OptDescr (Either String (ShakeOptions -> ShakeOptions))]
- data Progress = Progress {
- isRunning :: !Bool
- isFailure :: !(Maybe String)
- countSkipped :: !Int
- countBuilt :: !Int
- countUnknown :: !Int
- countTodo :: !Int
- timeSkipped :: !Double
- timeBuilt :: !Double
- timeUnknown :: !Double
- timeTodo :: !(Double, Int)
- progressSimple :: IO Progress -> IO ()
- progressDisplay :: Double -> (String -> IO ()) -> IO Progress -> IO ()
- progressTitlebar :: String -> IO ()
- data Verbosity
- getVerbosity :: Action Verbosity
- putLoud :: String -> Action ()
- putNormal :: String -> Action ()
- putQuiet :: String -> Action ()
- quietly :: Action a -> Action a
- command :: CmdResult r => [CmdOption] -> String -> [String] -> Action r
- command_ :: [CmdOption] -> String -> [String] -> Action ()
- cmd :: CmdArguments args => args :-> Action r
- newtype Stdout = Stdout {
- fromStdout :: String
- newtype Stderr = Stderr {
- fromStderr :: String
- newtype Exit = Exit {}
- class CmdResult a
- data CmdOption
- = Cwd FilePath
- | Env [(String, String)]
- | Stdin String
- | Shell
- | BinaryPipes
- | Traced String
- | WithStderr Bool
- | EchoStdout Bool
- | EchoStderr Bool
- system' :: FilePath -> [String] -> Action ()
- systemCwd :: FilePath -> FilePath -> [String] -> Action ()
- systemOutput :: FilePath -> [String] -> Action (String, String)
- copyFile' :: FilePath -> FilePath -> Action ()
- readFile' :: FilePath -> Action String
- readFileLines :: FilePath -> Action [String]
- writeFile' :: FilePath -> String -> Action ()
- writeFileLines :: FilePath -> [String] -> Action ()
- writeFileChanged :: FilePath -> String -> Action ()
- removeFiles :: FilePath -> [FilePattern] -> IO ()
- removeFilesAfter :: FilePath -> [FilePattern] -> Action ()
- need :: [FilePath] -> Action ()
- want :: [FilePath] -> Rules ()
- (*>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()
- (**>) :: [FilePattern] -> (FilePath -> Action ()) -> Rules ()
- (?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
- phony :: String -> Action () -> Rules ()
- (?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()
- (*>>) :: [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()
- type FilePattern = String
- (?==) :: FilePattern -> FilePath -> Bool
- doesFileExist :: FilePath -> Action Bool
- doesDirectoryExist :: FilePath -> Action Bool
- getDirectoryContents :: FilePath -> Action [FilePath]
- getDirectoryFiles :: FilePath -> [FilePattern] -> Action [FilePath]
- getDirectoryDirs :: FilePath -> Action [FilePath]
- getEnv :: String -> Action (Maybe String)
- addOracle :: (ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)
- askOracle :: (ShakeValue q, ShakeValue a) => q -> Action a
- askOracleWith :: (ShakeValue q, ShakeValue a) => q -> a -> Action a
- alwaysRerun :: Action ()
- data Resource
- newResource :: String -> Int -> Rules Resource
- newResourceIO :: String -> Int -> IO Resource
- withResource :: Resource -> Int -> Action a -> Action a
- withResources :: [(Resource, Int)] -> Action a -> Action a
- newCache :: (FilePath -> IO a) -> Rules (FilePath -> Action a)
- newCacheIO :: (FilePath -> IO a) -> IO (FilePath -> Action a)
Core
shake :: ShakeOptions -> Rules () -> IO ()Source
Main entry point for running Shake build systems. For an example see the top of the module Development.Shake.
Use ShakeOptions to specify how the system runs, and Rules to specify what to build. The function will throw
an exception if the build fails.
To use command line flags to modify ShakeOptions see shakeArgs.
shakeOptions :: ShakeOptionsSource
The default set of ShakeOptions.
type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)Source
Define an alias for the six type classes required for things involved in Shake Rules.
This alias is only available in GHC 7.4 and above, and requires the ConstraintKinds extension.
To define your own values meeting the necessary constraints it is convenient to use the extensions
GeneralizedNewtypeDeriving and DeriveDataTypeable to write:
newtype MyType = MyType (String, Bool) deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
class (ShakeValue key, ShakeValue value) => Rule key value whereSource
Define a pair of types that can be used by Shake rules. To import all the type classes required see Development.Shake.Classes.
Methods
storedValue :: key -> IO (Maybe value)Source
Retrieve the value associated with a key, if available.
As an example for filenames/timestamps, if the file exists you should return Just
the timestamp, but otherwise return Nothing. For rules whose values are not
stored externally, storedValue should return Nothing.
Define a set of rules. Rules can be created with calls to rule, defaultRule or action. Rules are combined
with either the Monoid instance, or (more commonly) the Monad instance and do notation.
defaultRule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()Source
Like rule, but lower priority, if no rule exists then defaultRule is checked.
All default rules must be disjoint.
rule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()Source
Add a rule to build a key, returning an appropriate Action. All rules must be disjoint.
To define lower priority rules use defaultRule.
action :: Action a -> Rules ()Source
Run an action, usually used for specifying top-level requirements.
withoutActions :: Rules () -> Rules ()Source
Remove all actions specified in a set of rules, usually used for implementing command line specification of what to build.
apply :: Rule key value => [key] -> Action [value]Source
Execute a rule, returning the associated values. If possible, the rules will be run in parallel.
This function requires that appropriate rules have been added with rule or defaultRule.
traced :: String -> IO a -> Action aSource
Write an action to the trace list, along with the start/end time of running the IO action.
The cmd and command functions automatically call traced.
The trace list is used for profile reports (see shakeReport).
actionOnException :: Action a -> IO b -> Action aSource
actionFinally :: Action a -> IO b -> Action aSource
data ShakeException Source
Error representing all expected exceptions thrown by Shake. Problems when executing rules will be raising using this exception type.
Constructors
| ShakeException | |
Fields
| |
Configuration
data ShakeOptions Source
Options to control the execution of Shake, usually specified by overriding fields in
shakeOptions:
shakeOptions{shakeThreads=4,shakeReport=Just "report.html"}
The Data instance for this type reports the shakeProgress and shakeOutput fields as having the abstract type Function,
because Data cannot be defined for functions.
Constructors
| ShakeOptions | |
Fields
| |
Instances
The current assumptions made by the build system, used by shakeAssume. These options
allow the end user to specify that any rules run are either to be treated as clean, or as
dirty, regardless of what the build system thinks.
These assumptions only operate on files reached by the current action commands. Any
other files in the database are left unchanged.
Constructors
| AssumeDirty | Assume that all rules reached are dirty and require rebuilding, equivalent to |
| AssumeClean | This assumption is unsafe, and may lead to incorrect build results in this run, and in future runs.
Assume and record that all rules reached are clean and do not require rebuilding, provided the rule
has a |
| AssumeSkip | This assumption is unsafe, and may lead to incorrect build results in this run.
Assume that all rules reached are clean in this run. Only useful for benchmarking, to remove any overhead
from running |
Command line
shakeArgs :: ShakeOptions -> Rules () -> IO ()Source
Run a build system using command line arguments for configuration.
The available flags are those from shakeOptDescrs, along with a few additional
make compatible flags that are not represented in ShakeOptions, such as --print-directory.
If there are no file arguments then the Rules are used directly, otherwise the file arguments
are wanted (after calling withoutActions). As an example:
main =shakeArgsshakeOptions{shakeFiles= "_make/",shakeProgress=progressSimple} $ dophony"clean" $removeFilesAfter"_make" ["//*"]want["_make/neil.txt","_make/emily.txt"] "_make/*.txt"*>\out -> ... build action here ...
This build system will default to building neil.txt and emily.txt, while showing progress messages,
and putting the Shake files in locations such as _make/.database. Some example command line flags:
-
main --no-progresswill turn off progress messages. -
main -j6will build on 6 threads. -
main --helpwill display a list of supported flags. -
main cleanwill not build anything, but will remove the_makedirectory, including the anyshakeFiles. -
main _make/henry.txtwill not buildneil.txtoremily.txt, but will instead buildhenry.txt.
shakeArgsWith :: ShakeOptions -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()Source
A version of shakeArgs with more flexible handling of command line arguments.
The caller of shakeArgsWith can add additional flags (the second argument) and chose how to convert
the flags/arguments into rules (the third argument). Given:
shakeArgsWith opts flags (\flagValues argValues -> result)
-
optsis the initialShakeOptionsvalue, which may have some fields overriden by command line flags. This argument is usuallyshakeOptions, perhaps with a few fields overriden. -
flagsis a list of flag descriptions, which either produce aStringcontaining an error message (typically for flags with invalid arguments, .e.g.), or a value that is passed asLeft"could not parse as int"flagValues. If you have no custom flags, pass[]. -
flagValuesis a list of custom flags that the user supplied. Ifflags == []then this list will be[]. -
argValuesis a list of non-flag arguments, which are often treated as files and passed towant. -
resultshould produce aNothingto indicate that no building needs to take place, or aJustproviding the rules that should be used.
As an example of a build system that can use either gcc or distcc for compiling:
import System.Console.GetOpt data Flags = DistCC deriving Eq flags = [Option "" ["distcc"] (NoArg $ Right DistCC) "Run distributed."] main =shakeArgsWithshakeOptionsflags $ \flags targets -> return $ Just $ do if null targets thenwant["result.exe"] elsewanttargets let compiler = if DistCC `elem` flags then "distcc" else "gcc" "*.o"*>\out -> doneed...cmdcompiler ... ...
Now you can pass --distcc to use the distcc compiler.
shakeOptDescrs :: [OptDescr (Either String (ShakeOptions -> ShakeOptions))]Source
A list of command line options that can be used to modify ShakeOptions. Each option returns
either an error message (invalid argument to the flag) or a function that changes some fields
in ShakeOptions. The command line flags are make compatible where possbile, but additional
flags have been added for the extra options Shake supports.
Progress reporting
Information about the current state of the build, obtained by passing a callback function
to shakeProgress. Typically a program will use progressDisplay to poll this value and produce
status messages, which is implemented using this data type.
Constructors
| Progress | |
Fields
| |
progressSimple :: IO Progress -> IO ()Source
A simple method for displaying progress messages, suitable for using as
shakeProgress. This function writes the current progress to
the titlebar every five seconds. The function is defined as:
progressSimple =progressDisplay5progressTitlebar
progressDisplay :: Double -> (String -> IO ()) -> IO Progress -> IO ()Source
Given a sampling interval (in seconds) and a way to display the status message,
produce a function suitable for using as shakeProgress.
This function polls the progress information every n seconds, produces a status
message and displays it using the display function.
Typical status messages will take the form of 1m25s (15%), indicating that the build
is predicted to complete in 1 minute 25 seconds (85 seconds total), and 15% of the necessary build time has elapsed.
This function uses past observations to predict future behaviour, and as such, is only
guessing. The time is likely to go up as well as down, and will be less accurate from a
clean build (as the system has fewer past observations).
The current implementation is to predict the time remaining (based on timeTodo) and the
work already done (timeBuilt). The percentage is then calculated as remaining / (done + remaining),
while time left is calculated by scaling remaining by the observed work rate in this build,
roughly done / time_elapsed.
progressTitlebar :: String -> IO ()Source
Set the title of the current console window to the given text. If the
environment variable $TERM is set to xterm this uses xterm escape sequences.
On Windows, if not detected as an xterm, this function uses the SetConsoleTitle API.
Verbosity
The verbosity data type, used by shakeVerbosity.
Constructors
| Silent | Don't print any messages. |
| Quiet | Only print essential messages, typically errors. |
| Normal | Print errors and |
| Loud | Print errors and full command lines when running a |
| Chatty | Print errors, full command line and status messages when starting a rule. |
| Diagnostic | Print messages for virtually everything (mostly for debugging). |
getVerbosity :: Action VerbositySource
Get the current verbosity level, as set by shakeVerbosity. If you
want to output information to the console, you are recommended to use
putLoud / putNormal / putQuiet, which ensures multiple messages are
not interleaved.
putLoud :: String -> Action ()Source
Write a message to the output when the verbosity (shakeVerbosity) is appropriate.
The output will not be interleaved with any other Shake messages
(other than those generated by system commands).
putNormal :: String -> Action ()Source
Write a message to the output when the verbosity (shakeVerbosity) is appropriate.
The output will not be interleaved with any other Shake messages
(other than those generated by system commands).
putQuiet :: String -> Action ()Source
Write a message to the output when the verbosity (shakeVerbosity) is appropriate.
The output will not be interleaved with any other Shake messages
(other than those generated by system commands).
Running commands
command :: CmdResult r => [CmdOption] -> String -> [String] -> Action rSource
Execute a system command. Before running command make sure you need any files
that are required by the command.
This function takes a list of options (often just [], see CmdOption for the available
options), the name of the executable (either a full name, or a program on the $PATH) and
a list of arguments. The result is often (), but can be a tuple containg any of Stdout,
Stderr and Exit. Some examples:
command_[] "gcc" ["-c","myfile.c"] -- compile a file, throwing an exception on failureExitc <-command[] "gcc" ["-c",myfile] -- run a command, recording the exit code (Exitc,Stderrerr) <-command[] "gcc" ["-c","myfile.c"] -- run a command, recording the exit code and error outputStdoutout <-command[] "gcc" ["-MM","myfile.c"] -- run a command, recording the outputcommand_[Cwd"generated"] "gcc" ["-c",myfile] -- run a command in a directory
Unless you retrieve the ExitCode using Exit, any ExitFailure will throw an error, including
the Stderr in the exception message. If you capture the Stdout or Stderr, that stream will not be echoed to the console,
unless you use the option EchoStdout or EchoStderr.
If you use command inside a do block and do not use the result, you may get a compile-time error about being
unable to deduce CmdResult. To avoid this error, use command_.
cmd :: CmdArguments args => args :-> Action rSource
A variable arity version of command.
-
Stringarguments are treated as whitespace separated arguments. -
[String]arguments are treated as literal arguments. -
CmdOptionarguments are used as options.
To take the examples from command:
() <-cmd"gcc -c myfile.c" -- compile a file, throwing an exception on failureExitc <-cmd"gcc -c" [myfile] -- run a command, recording the exit code (Exitc,Stderrerr) <-cmd"gcc -c myfile.c" -- run a command, recording the exit code and error outputStdoutout <-cmd"gcc -MM myfile.c" -- run a command, recording the outputcmd(Cwd"generated") "gcc -c" [myfile] ::Action() -- run a command in a directory
When passing file arguments we use [myfile] so that if the myfile variable contains spaces they are properly escaped.
If you use cmd inside a do block and do not use the result, you may get a compile-time error about being
unable to deduce CmdResult. To avoid this error, bind the result to (), or include a type signature.
Collect the stdout of the process.
If you are collecting the stdout, it will not be echoed to the terminal, unless you include EchoStdout.
Constructors
| Stdout | |
Fields
| |
Collect the stderr of the process.
If you are collecting the stderr, it will not be echoed to the terminal, unless you include EchoStderr.
Constructors
| Stderr | |
Fields
| |
Collect the ExitCode of the process.
If you do not collect the exit code, any ExitFailure will cause an exception.
Constructors
| Cwd FilePath | Change the current directory in the spawned process. By default uses this processes current directory. |
| Env [(String, String)] | Change the environment variables in the spawned process. By default uses this processes environment. |
| Stdin String | Given as the |
| Shell | Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly. |
| BinaryPipes | Treat the |
| Traced String | Name to use with |
| WithStderr Bool | Should I include the |
| EchoStdout Bool | Should I echo the |
| EchoStderr Bool | Should I echo the |
Utility functions
systemCwd :: FilePath -> FilePath -> [String] -> Action ()Source
Deprecated: Please use command or cmd instead, with Cwd.
This function will be removed in a future version.
Execute a system command with a specified current working directory (first argument).
This function will raise an error if the exit code is non-zero.
Before running systemCwd make sure you need any required files.
systemCwd "/usr/MyDirectory" "pwd" []
systemOutput :: FilePath -> [String] -> Action (String, String)Source
Deprecated: Please use command or cmd instead, with Stdout or Stderr.
This function will be removed in a future version.
Execute a system command, returning (stdout,stderr).
This function will raise an error if the exit code is non-zero.
Before running systemOutput make sure you need any required files.
copyFile' :: FilePath -> FilePath -> Action ()Source
copyFile' old new copies the existing file from old to new. The old file is has need called on it
before copying the file.
readFileLines :: FilePath -> Action [String]Source
A version of readFile' which also splits the result into lines.
writeFileLines :: FilePath -> [String] -> Action ()Source
A version of writeFile' which writes out a list of lines.
writeFileChanged :: FilePath -> String -> Action ()Source
Write a file, but only if the contents would change.
removeFiles :: FilePath -> [FilePattern] -> IO ()Source
Remove all empty directories and files that match any of the patterns beneath a directory. Some examples:
removeFiles"output" ["//*"]removeFiles"." ["//*.hi","//*.o"]
This function is often useful when writing a clean action for your build system,
often as a phony rule.
removeFilesAfter :: FilePath -> [FilePattern] -> Action ()Source
Remove files, like removeFiles, but executed after the build completes successfully.
Useful for implementing clean actions that delete files Shake may have open for building.
File rules
want :: [FilePath] -> Rules ()Source
Require that the following are built by the rules, used to specify the target.
main =shakeshakeOptions$ dowant["Main.exe"] ...
This program will build Main.exe, given sufficient rules.
(*>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()Source
Define a rule that matches a FilePattern. No file required by the system must be
matched by more than one pattern. For the pattern rules, see ?==.
"*.asm.o"*>\out -> do let src =dropExtensionoutneed[src]cmd"as" [src] "-o" [out]
To define a build system for multiple compiled languages, we recommend using .asm.o,
.cpp.o, .hs.o, to indicate which language produces an object file.
I.e., the file foo.cpp produces object file foo.cpp.o.
Note that matching is case-sensitive, even on Windows.
(**>) :: [FilePattern] -> (FilePath -> Action ()) -> Rules ()Source
Define a set of patterns, and if any of them match, run the associated rule. See *>.
(?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()Source
Define a rule to build files. If the first argument returns True for a given file,
the second argument will be used to build it. Usually *> is sufficient, but ?> gives
additional power. For any file used by the build system, only one rule should return True.
(all isUpper .takeBaseName)?>\out -> do let src =replaceBaseNameout $ map toLower $ takeBaseName outwriteFile'out . map toUpper =<<readFile'src
phony :: String -> Action () -> Rules ()Source
Declare a phony action, this is an action that does not produce a file, and will be rerun
in every execution that requires it. You can demand phony rules using want / need.
Phony actions are intended to define command-line abbreviations. You should not need phony actions
as dependencies of rules, as that will cause excessive rebuilding.
(?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()Source
Define a rule for building multiple files at the same time, a more powerful
and more dangerous version of *>>.
Given an application test ?>> ..., test should return Just if the rule applies, and should
return the list of files that will be produced. This list must include the file passed as an argument and should
obey the invariant:
forAll $ \x ys -> test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys
As an example of a function satisfying the invariaint:
test x |takeExtensionx `elem` [".hi",".o"] = Just [dropExtensionx<.>"hi",dropExtensionx<.>"o"] test _ = Nothing
Regardless of whether Foo.hi or Foo.o is passed, the function always returns [Foo.hi, Foo.o].
(*>>) :: [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()Source
Define a rule for building multiple files at the same time.
As an example, a single invokation of GHC produces both .hi and .o files:
["*.o","*.hi"]*>>\[o,hi] -> do let hs = o-<.>"hs"need... -- all files the .hs importcmd"ghc -c" [hs]
However, in practice, it's usually easier to define rules with *> and make the .hi depend
on the .o. When defining rules that build multiple files, all the FilePattern values must
have the same sequence of // and * wildcards in the same order.
type FilePattern = StringSource
A type synonym for file patterns, containing // and *. For the syntax
and semantics of FilePattern see ?==.
(?==) :: FilePattern -> FilePath -> BoolSource
Match a FilePattern against a FilePath, There are only two special forms:
-
*matches an entire path component, excluding any separators. -
//matches an arbitrary number of path components.
Some examples that match:
"//*.c"?=="foo/bar/baz.c" "*.c"?=="baz.c" "//*.c"?=="baz.c" "test.c"?=="test.c"
Examples that don't match:
"*.c"?=="foo/bar.c" "*/*.c"?=="foo/bar/baz.c"
An example that only matches on Windows:
"foo/bar" ?== "foo\\bar"
Directory rules
getDirectoryContents :: FilePath -> Action [FilePath]Source
Get the contents of a directory. The result will be sorted, and will not contain
the entries . or .. (unlike the standard Haskell version). The resulting paths will be relative
to the first argument.
It is usually simpler to call either getDirectoryFiles or getDirectoryDirs.
getDirectoryFiles :: FilePath -> [FilePattern] -> Action [FilePath]Source
Get the files anywhere under a directory that match any of a set of patterns.
For the interpretation of the patterns see ?==. All results will be
relative to the FilePath argument. Some examples:
getDirectoryFiles "Config" ["//*.xml"]
-- All .xml files anywhere under the Config directory
-- If Config/foo/bar.xml exists it will return ["foo/bar.xml"]
getDirectoryFiles "Modules" ["*.hs","*.lhs"]
-- All .hs or .lhs in the Modules directory
-- If Modules/foo.hs and Modules/foo.lhs exist, it will return ["foo.hs","foo.lhs"]
If you require a qualified file name it is often easier to use "" as FilePath argument,
for example the following two expressions are equivalent:
fmap (map ("Config" </>)) (getDirectoryFiles "Config" ["//*.xml"])
getDirectoryFiles "" ["Config//*.xml"]
getDirectoryDirs :: FilePath -> Action [FilePath]Source
Get the directories in a directory, not including . or ...
All directories are relative to the argument directory.
getDirectoryDirs "/Users"
-- Return all directories in the /Users directory
-- e.g. ["Emily","Henry","Neil"]
Environment rules
Oracle rules
addOracle :: (ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)Source
Add extra information which rules can depend on.
An oracle is a function from a question type q, to an answer type a.
As an example, we can define an oracle allowing you to depend on the current version of GHC:
newtype GhcVersion = GhcVersion () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
rules = do
addOracle $ \(GhcVersion _) -> fmap (last . words . fromStdout) $ cmd "ghc --version"
... rules ...
If a rule calls , that rule will be rerun whenever the GHC version changes.
Some notes:
askOracle (GhcVersion ())
- We define
GhcVersionwith anewtypearound(), allowing the use ofGeneralizedNewtypeDeriving. All the necessary type classes are exported from Development.Shake.Classes. - Each call to
addOraclemust use a different type of question. - Actions passed to
addOraclewill be run in every build they are required, but if their value does not change they will not invalidate any rules depending on them. To get a similar behaviour using data stored in files, seealwaysRerun. - If the value returned by
askOracleis ignored thenaskOracleWithmay help avoid ambiguous type messages. Alternatively, use the result ofaddOracle, which isaskOraclerestricted to the correct type.
As a more complex example, consider tracking Haskell package versions:
newtype GhcPkgList = GhcPkgList () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
newtype GhcPkgVersion = GhcPkgVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
rules = do
getPkgList <- addOracle $ \GhcPkgList{} -> do
Stdout out <- cmd "ghc-pkg list --simple-output"
return [(reverse b, reverse a) | x <- words out, let (a,_:b) = break (== '-') $ reverse x]
--
getPkgVersion <- addOracle $ \(GhcPkgVersion pkg) -> do
pkgs <- getPkgList $ GhcPkgList ()
return $ lookup pkg pkgs
--
"myrule" *> \_ -> do
getPkgVersion $ GhcPkgVersion "shake"
... rule using the shake version ...
Using these definitions, any rule depending on the version of shake
should call getPkgVersion $ GhcPkgVersion "shake" to rebuild when shake is upgraded.
askOracle :: (ShakeValue q, ShakeValue a) => q -> Action aSource
askOracleWith :: (ShakeValue q, ShakeValue a) => q -> a -> Action aSource
Get information previously added with addOracle. The second argument is not used, but can
be useful to fix the answer type, avoiding ambiguous type error messages.
Special rules
alwaysRerun :: Action ()Source
Always rerun the associated action. Useful for defining rules that query the environment. For example:
"ghcVersion.txt"*>\out -> doalwaysRerunStdout stdout <-cmd"ghc --version"writeFileChangedout stdout
Finite resources
A type representing a finite resource, which multiple build actions should respect.
Created with newResource and used with withResource
when defining rules.
As an example, only one set of calls to the Excel API can occur at one time, therefore Excel is a finite resource of quantity 1. You can write:
shakeshakeOptions{shakeThreads=2} $ dowant["a.xls","b.xls"] excel <-newResource"Excel" 1 "*.xls"*>\out ->withResourceexcel 1 $cmd"excel" out ...
Now the two calls to excel will not happen in parallel. Using Resource
is better than MVar as it will not block any other threads from executing. Be careful that the
actions run within withResource do not themselves require further quantities of this resource, or
you may get a "thread blocked indefinitely in an MVar operation" exception. Typically only
system commands (such as cmd) should be run inside withResource,
not commands such as need. If an action requires multiple resources, use
withResources to avoid deadlock.
As another example, calls to compilers are usually CPU bound but calls to linkers are usually disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit ourselves to 4 linkers with:
disk <-newResource"Disk" 4want[show i<.>"exe" | i <- [1..100]] "*.exe"*>\out ->withResourcedisk 1 $cmd"ld -o" [out] ... "*.o"*>\out ->cmd"cl -o" [out] ...
newResource :: String -> Int -> Rules ResourceSource
Create a new finite resource, given a name (for error messages) and a quantity of the resource that exists.
For an example see Resource.
newResourceIO :: String -> Int -> IO ResourceSource
A version of newResource that runs in IO, and can be called before calling shake.
Most people should use newResource instead.
withResource :: Resource -> Int -> Action a -> Action aSource
Run an action which uses part of a finite resource. For an example see Resource.
withResources :: [(Resource, Int)] -> Action a -> Action aSource
Run an action which uses part of several finite resources. Acquires the resources in a stable
order, to prevent deadlock. If all rules requiring more than one resource acquire those
resources with a single call to withResources, resources will not deadlock.
Cached file contents
newCache :: (FilePath -> IO a) -> Rules (FilePath -> Action a)Source
Given a way of loading information from a file, produce a cached version that will load each file at most once.
Using the cached function will still result in a dependency on the original file.
The argument function should not access any files other than the one passed as its argument.
Each call to newCache creates a separate cache that is independent of all other calls to newCache.
This function is useful when creating files that store intermediate values, to avoid the overhead of repeatedly reading from disk, particularly if the file requires expensive parsing. As an example:
digits <-newCache$ \file -> do src <- readFile file return $ length $ filter isDigit src "*.digits"*>\x -> do v1 <- digits (dropExtensionx) v2 <- digits (dropExtensionx)writeFile'x $ show (v1,v2)
To create the result MyFile.txt.digits the file MyFile.txt will be read and counted, but only at most
once per execution.