rattle-0.2: Forward build system, with caching and speculation

Safe HaskellNone
LanguageHaskell2010

Development.Rattle

Description

General rules for writing consistent rattle build systems:

  • Never write to the same file twice. Never read then write.
  • Don't delete files that have been produced. Each command should make new files, not delete old files.
Synopsis

Documentation

rattleRun :: RattleOptions -> Run a -> IO a Source #

Given an Action to run, and a list of previous commands that got run, run it again

data Run a Source #

Type of actions to run. Executed using rattle.

Instances
Monad Run Source # 
Instance details

Defined in Development.Rattle.Server

Methods

(>>=) :: Run a -> (a -> Run b) -> Run b #

(>>) :: Run a -> Run b -> Run b #

return :: a -> Run a #

fail :: String -> Run a #

Functor Run Source # 
Instance details

Defined in Development.Rattle.Server

Methods

fmap :: (a -> b) -> Run a -> Run b #

(<$) :: a -> Run b -> Run a #

Applicative Run Source # 
Instance details

Defined in Development.Rattle.Server

Methods

pure :: a -> Run a #

(<*>) :: Run (a -> b) -> Run a -> Run b #

liftA2 :: (a -> b -> c) -> Run a -> Run b -> Run c #

(*>) :: Run a -> Run b -> Run b #

(<*) :: Run a -> Run b -> Run a #

MonadIO Run Source # 
Instance details

Defined in Development.Rattle.Server

Methods

liftIO :: IO a -> Run a #

a ~ () => CmdArguments (Run a) Source # 
Instance details

Defined in Development.Rattle.Server

Methods

cmdArguments :: CmdArgument -> Run a #

rattleDump :: (String -> IO ()) -> FilePath -> IO () Source #

Dunmp the contents of a shared cache

data Hazard Source #

Type of exception thrown if there is a hazard when running the build system.

data RattleOptions Source #

Basic options for configuring rattle.

Constructors

RattleOptions 

Fields

data RattleUI Source #

What UI should rattle show the user.

Constructors

RattleSerial

Show a series of lines for each command run

RattleFancy

Show a few lines that change as commands run

RattleQuiet

Don't show commands

Instances
Show RattleUI Source # 
Instance details

Defined in Development.Rattle.UI

cmd :: (Partial, CmdArguments args) => args :-> Action r #

Build or execute a system command. Before using cmd to run a command, make sure you need any files that are used by the command.

  • String arguments are treated as a list of whitespace separated arguments.
  • [String] arguments are treated as a list of literal arguments.
  • CmdOption arguments are used as options.
  • CmdArgument arguments, which can be built by cmd itself, are spliced into the containing command.

Typically only string literals should be passed as String arguments. When using variables prefer [myvar] so that if myvar contains spaces they are properly escaped.

As some examples, here are some calls, and the resulting command string:

cmd_ "git log --pretty=" "oneline"           -- git log --pretty= oneline
cmd_ "git log --pretty=" ["oneline"]         -- git log --pretty= oneline
cmd_ "git log" ("--pretty=" ++ "oneline")    -- git log --pretty=oneline
cmd_ "git log" ("--pretty=" ++ "one line")   -- git log --pretty=one line
cmd_ "git log" ["--pretty=" ++ "one line"]   -- git log "--pretty=one line"

More examples, including return values, see this translation of the examples given for the command function:

cmd_ "gcc -c myfile.c"                                       -- compile a file, throwing an exception on failure
Exit c <- cmd "gcc -c" [myfile]                              -- run a command, recording the exit code
(Exit c, Stderr err) <- cmd "gcc -c myfile.c"                -- run a command, recording the exit code and error output
Stdout out <- cmd "gcc -MM myfile.c"                         -- run a command, recording the output
cmd (Cwd "generated") "gcc -c" [myfile] :: Action ()         -- run a command in a directory

let gccCommand = cmd "gcc -c" :: CmdArgument                 -- build a sub-command. cmd can return CmdArgument values as well as execute commands
cmd (Cwd "generated") gccCommand [myfile]                 -- splice that command into a greater command

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, use cmd_. If you enable OverloadedStrings or OverloadedLists you may have to give type signatures to the arguments, or use the more constrained command instead.

The cmd function can also be run in the IO monad, but then Traced is ignored and command lines are not echoed. As an example:

cmd (Cwd "generated") Shell "gcc -c myfile.c" :: IO ()

data CmdOption #

Options passed to command or cmd to control how processes are executed.

Constructors

Cwd FilePath

Change the current directory in the spawned process. By default uses this processes current directory. Successive Cwd options are joined together, to change into nested directories.

Env [(String, String)]

Change the environment variables in the spawned process. By default uses this processes environment.

AddEnv String String

Add an environment variable in the child process.

RemEnv String

Remove an environment variable from the child process.

AddPath [String] [String]

Add some items to the prefix and suffix of the $PATH variable.

Stdin String

Given as the stdin of the spawned process. By default the stdin is inherited.

StdinBS ByteString

Given as the stdin of the spawned process.

FileStdin FilePath

Take the stdin from a file.

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 stdin/stdout/stderr messages as binary. By default String results use text encoding and ByteString results use binary encoding.

Traced String

Name to use with traced, or "" for no tracing. By default traces using the name of the executable.

Timeout Double

Abort the computation after N seconds, will raise a failure exit code. Calls interruptProcessGroupOf and terminateProcess, but may sometimes fail to abort the process and not timeout.

WithStdout Bool

Should I include the stdout in the exception if the command fails? Defaults to False.

WithStderr Bool

Should I include the stderr in the exception if the command fails? Defaults to True.

EchoStdout Bool

Should I echo the stdout? Defaults to True unless a Stdout result is required or you use FileStdout.

EchoStderr Bool

Should I echo the stderr? Defaults to True unless a Stderr result is required or you use FileStderr.

FileStdout FilePath

Should I put the stdout to a file.

FileStderr FilePath

Should I put the stderr to a file.

AutoDeps

Compute dependencies automatically. Only works if shakeLintInside has been set to the files where autodeps might live.

UserCommand String

The command the user thinks about, before any munging. Defaults to the actual command.

FSAOptions String

Options to fsatrace, a list of strings with characters such as "r" (reads) "w" (writes). Defaults to "rwmdqt" if the output of fsatrace is required.

CloseFileHandles

Before starting the command in the child process, close all file handles except stdin, stdout, stderr in the child process. Uses close_fds from package process and comes with the same caveats, i.e. runtime is linear with the maximum number of open file handles (RLIMIT_NOFILE, see man 2 getrlimit on Linux).

NoProcessGroup

Don't run the process in its own group. Required when running docker. Will mean that process timeouts and asyncronous exceptions may not properly clean up child processes.

InheritStdin

Cause the stdin from the parent to be inherited. Might also require NoProcessGroup on Linux. Ignored if you explicitly pass a stdin.

Instances
Eq CmdOption 
Instance details

Defined in Development.Shake.Internal.CmdOption

Data CmdOption 
Instance details

Defined in Development.Shake.Internal.CmdOption

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CmdOption -> c CmdOption #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CmdOption #

toConstr :: CmdOption -> Constr #

dataTypeOf :: CmdOption -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CmdOption) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmdOption) #

gmapT :: (forall b. Data b => b -> b) -> CmdOption -> CmdOption #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CmdOption -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CmdOption -> r #

gmapQ :: (forall d. Data d => d -> u) -> CmdOption -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> CmdOption -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption #

Ord CmdOption 
Instance details

Defined in Development.Shake.Internal.CmdOption

Read CmdOption Source # 
Instance details

Defined in Development.Rattle.Types

Show CmdOption 
Instance details

Defined in Development.Shake.Internal.CmdOption

Generic CmdOption Source # 
Instance details

Defined in Development.Rattle.Types

Associated Types

type Rep CmdOption :: Type -> Type #

Hashable CmdOption Source # 
Instance details

Defined in Development.Rattle.Types

IsCmdArgument CmdOption 
Instance details

Defined in Development.Shake.Command

IsCmdArgument [CmdOption] 
Instance details

Defined in Development.Shake.Command

type Rep CmdOption Source # 
Instance details

Defined in Development.Rattle.Types

type Rep CmdOption = D1 (MetaData "CmdOption" "Development.Shake.Internal.CmdOption" "shake-0.19-GqSaJkHeRkoDJ7vwpNMh" False) ((((C1 (MetaCons "Cwd" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)) :+: (C1 (MetaCons "Env" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(String, String)])) :+: C1 (MetaCons "AddEnv" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))) :+: (C1 (MetaCons "RemEnv" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) :+: (C1 (MetaCons "AddPath" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String]) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String])) :+: C1 (MetaCons "Stdin" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String))))) :+: ((C1 (MetaCons "StdinBS" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ByteString)) :+: (C1 (MetaCons "FileStdin" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)) :+: C1 (MetaCons "Shell" PrefixI False) (U1 :: Type -> Type))) :+: (C1 (MetaCons "BinaryPipes" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "Traced" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) :+: C1 (MetaCons "Timeout" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Double)))))) :+: (((C1 (MetaCons "WithStdout" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) :+: (C1 (MetaCons "WithStderr" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) :+: C1 (MetaCons "EchoStdout" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)))) :+: (C1 (MetaCons "EchoStderr" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) :+: (C1 (MetaCons "FileStdout" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath)) :+: C1 (MetaCons "FileStderr" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath))))) :+: ((C1 (MetaCons "AutoDeps" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "UserCommand" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) :+: C1 (MetaCons "FSAOptions" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))) :+: (C1 (MetaCons "CloseFileHandles" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "NoProcessGroup" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "InheritStdin" PrefixI False) (U1 :: Type -> Type))))))

toCmdOption :: CmdOption2 -> CmdOption Source #

Convert a new option into a standard one.

parallel :: [Run a] -> Run [a] Source #

Run a sequence of Run actions in parallel. They will be run in parallel with no limit on simultaneous executions.

forP :: [a] -> (a -> Run b) -> Run [b] Source #

Parallel version of forM.

forP_ :: [a] -> (a -> Run b) -> Run () Source #

Parallel version of forM.

withCmdOptions :: [CmdOption] -> Run a -> Run a Source #

Apply specific options ot all nested Run values.

memo :: (Eq a, Hashable a, MonadIO m) => (a -> m b) -> m (a -> m b) Source #

Memoize an IO action

memoRec :: (Eq a, Hashable a, MonadIO m) => ((a -> m b) -> a -> m b) -> m (a -> m b) Source #

Memoize an IO action which is recursive

data Program a Source #

A program that can be run externally.

newProgram :: (Show a, Read a) => (a -> String) -> Q (TExp (a -> IO ())) -> Program a Source #

Create a new program which is based on a TH splice.

runProgram :: Show a => Program a -> a -> Run () Source #

Run a program.

liftIO :: MonadIO m => IO a -> m a #

Lift a computation from the IO monad.

writeProfile :: RattleOptions -> FilePath -> IO () Source #

Generate a profile report given a file.

graphData :: RattleOptions -> IO (Seconds, Seconds, Seconds) Source #

Given some options, produce various statistics.