(* goaljobs * Copyright (C) 2013 Red Hat Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) (** {1 Goaljobs library of useful helper functions.} *) (** {2 Targets and requires} These are used to write goals. Normally you write a goal with one or more [target]s and zero or more [require]s, as the examples below should make clear. In the first example, there are two targets: that [o_file] (object) exists, and that it is newer than [c_file] (source). The rule meets that target by running the C compiler ([cc]) which, if it succeeds, will ensure that the object file exists and is newer than the source file. {v let goal compiled c_file = let o_file = change_file_extension "o" c_file in target (more_recent [o_file] [c_file]); sh "cd $builddir && cc -c %s -o %s" c_file o_file } In the second example, the rule requires that several files have been compiled ([require (compiled ...)] before it can link the final program: {v let goal built program source = target (more_recent [program] [source]); require (compiled source); let object = change_file_extension "o" source in sh "cd $builddir && cc %s -o %s" object program } *) val target : bool -> unit (** [target] {i condition} defines the target condition that {b will} be met once the current rule has run. Goaljobs is much more flexible than [make]. In [make] only a single type of target is possible. The following are roughly equivalent: {v foo.o: foo.c ... let goal compiled () = target (more_recent ["foo.o"] ["foo.c"]); requires (file_exists "foo.c"); ... } Targets in goaljobs can be any arbitrary expression, and you can have any number of different targets. Almost every rule should have one or more targets, which should accurately state the outcome once the rule has been run. If you have more than one [target]s then it's as if they have been ORed together ({b not} ANDed which you might expect). You can make this explicit by using a single target and [&&] or [||] between the expressions. See also {!target_all} and {!target_exists}. Normally you put the target(s) early on in the rule, before any running code and before any [require]s. This is not a hard-and-fast rule and it is not enforced, but doing it will ensure the rule runs most efficiently since if the target is met already then the rest of the rule doesn't run. *) val target_all : bool list -> unit (** [target_all [t1; t2; ...]] is the same as writing [target (t1 && t2 && ...)] *) val target_exists : bool list -> unit (** [target_exists [t1; t2; ...]] is the same as writing [target (t1 || t2 || ...)] *) val require : unit -> unit (** [require] {!goal} defines the requirements of this rule, that is, other goals that have to be met before this rule is able to run. In terms of [make], [require]s are roughly equivalent to the right hand side after the [:], but in goaljobs the requirements can be much richer than simply "that file must exist". Some very simple rules don't need any [require]s. Unlike with [make], the requirements of a rule can be placed anywhere within the rule, as long as you put them before they are needed. *) (** {2 Periodic jobs} If you want to have a rule that runs when some outside event happens you have three choices: Manually run the script (this is basically what [make] forces you to do). Have some sort of hook that runs the script (eg. a git hook). Or use a periodic job to poll for an event or change. Periodic jobs run regularly to poll for an outside event or change. If a script has periodic jobs, then it runs continuously (or until you kill it). An example of a script that checks for new git commits and when it sees one it will ensure it passes the tests: {v let repo = Sys.getenv "HOME" // "repo" let goal git_commit_tested commit = let key = sprintf "repo-tested-%s" commit in target (memory_exists key); sh " git clone %s test cd test ./configure make make check "; (* Record that this commit was tested successfully. *) memory_set key "1" every 30 minutes (fun () -> let commit = shout "cd %s && git rev-parse HEAD" repo in (* Require that this commit has been tested. *) require (git_commit_tested commit) ) } Some notes about the above example: Firstly only the current HEAD commit is required to be tested. This is because older commits are irrelevant and because if they failed the test before there is not point retesting them (commits are immutable). Secondly we use the Memory to remember that we have successfully tested a commit. This is what stops the program from repeatedly testing the same commit. *) (* This is what lets you write '30 minutes' etc: *) type period_t = Seconds | Days | Months | Years val seconds : int * period_t val sec : int * period_t val secs : int * period_t val second : int * period_t val minutes : int * period_t val min : int * period_t val mins : int * period_t val minute : int * period_t val hours : int * period_t val hour : int * period_t val days : int * period_t val day : int * period_t val weeks : int * period_t val week : int * period_t val months : int * period_t val month : int * period_t val years : int * period_t val year : int * period_t val every : ?name:string -> int -> int * period_t -> (unit -> unit) -> unit (** [every N (seconds|minutes|hours|days|weeks|months|years) f] runs the function [f] periodically. The optional [~name] parameter can be used to name the job (for debugging). *) (** {2 File and URL testing} Various functions to test the existence of files, URLs. *) val file_exists : string -> bool (** Return true if the named file exists. This function also exists as a goal. Writing: {v require (file_exists "somefile");} will die unless ["somefile"] exists. *) val directory_exists : string -> bool (** Return true if the named directory exists. There is also a goal version of this function. *) val file_newer_than : string -> string -> bool (** [file_newer_than file_a file_b] returns true if [file_a] is newer than [file_b]. Note that if [file_a] does not exist, it returns false. If [file_b] does not exist, it is an error. There is also a goal version of this function. *) val more_recent : string list -> string list -> bool (** [more_recent objects sources] expresses the [make] relationship: {v object(s) ...: source(s) ...} in a convenient way: {v let goal built objects sources = target (more_recent objects sources); ... code to rebuild ... } It is roughly equivalent to checking that all the object files exist and are newer than all of the source files. Note that both parameters are lists (since in [make] you can have a list of source files and a list of object files). If you don't want a list, pass a single-element list containing the single the object/source file. There is also a goal version of this function. *) val url_exists : string -> bool (** The URL is tested to see if it exists. There is also a goal version of this function. *) val file_contains_string : string -> string -> bool (** [file_contains_string filename str] checks if the named file contains the given substring [str]. There is also a goal version of this function. *) val url_contains_string : string -> string -> bool (** [url_contains_string url str] downloads the URL and checks whether the content contains the given substring [str]. There is also a goal version of this function. *) val (//) : string -> string -> string (** Concatenate two paths. *) val quote : string -> string (** Quote the string to make it safe to pass directly to the shell. *) (** {2 Shell} Call out to the Unix shell. [/bin/sh] is used unless you set {!shell} to some other value. Note that the environment variable [SHELL] is {i not} used. {!sh}, {!shout}, {!shlines} work like [printf]. ie. You can substitute variables using [%s], [%d] and so on. For example: {v sh "rsync foo-%s.tar.gz example.com:/html/" version } Each invocation of {!sh} (etc) is a single shell (this is slightly different from how [make] works). For example: {v sh " package=foo-%s tarball=$package.tar.gz cp $HOME/$tarball . tar zxf $tarball cd $package ./configure make " version } The shell error mode is set such that if any single command returns an error then the {!sh} function as a whole exits with an error. Write: {v command ||: } to ignore the result of a command. Each shell runs in a new temporary directory. The temporary directory and all its contents is deleted after the shell exits. If you want to save any data, [cd] somewhere. The environment variable [$builddir] is exported to the script. This is the current directory when the goaljobs program was started. For example you could start the command sequence with [cd $HOME/data/] or [cd $builddir]. *) val sh : ('a, unit, string, unit) format4 -> 'a (** Run the command(s). *) val shout : ('a, unit, string, string) format4 -> 'a (** Run the command(s). Anything printed on stdout is returned as a string. The trailing [\n] character, if any, is not returned. *) val shlines : ('a, unit, string, string list) format4 -> 'a (** Run the command(s). Any lines printed to stdout is returned as a list of strings. Trailing [\n] characters are not returned. *) val shell : string ref (** Set this variable to override the default shell ([/bin/sh]). *) (** {2 String functions} Most string functions are provided by the OCaml standard library (see the module [String]). For convenience some extra functions are provided here. *) (* val replace_substring : string -> string -> string -> string (** [replace_substring patt repl string] replaces all occurrences of [patt] with [repl] in [string]. *) *) val change_file_extension : string -> string -> string (** [change_file_extension ext filename] changes the file extension of [filename] to [.ext]. For example [change_file_extension "o" "main.c"] returns ["main.o"]. If the original filename has no extension, this function adds the extension. *) (* val filter_file_extension : string -> string list -> string (** [filter_file_extension ext filenames] returns only those filenames in the list which have the given file extension. For example [filter_file_extension "o" ["foo.c"; "bar.o"]] would return [["bar.o"]] (a single element list). *) *) (** {2 Memory (persistent key/value storage) "The Memory" is key/value storage which persists across goaljobs sessions. It is stored in the file [$HOME/.goaljobs-memory] (which is a binary file, but you can delete it if you want). The Memory is locked during accesses, so it is safe to read or write it from multiple parallel goaljobs sessions. Keys and values are strings. The keys should be globally unique, so it is suggested you use some application-specific prefix. eg: "myapp-key" A common pattern is: {v let goal tested version = let key = "myapp-tested-" ^ version in target (memory_exists key); ... some work to test version ... memory_set key "1" } Note in that example the value ["1"] is arbitrary. You just want to store {i any} value so that a later call to {!memory_exists} will succeed. *) val memory_exists : string -> bool (** [memory_exists key] checks that the named [key] exists in the Memory. It doesn't matter what value it has. This is also available as a goal, so you can write [requires (memory_exists key)] *) val memory_set : string -> string -> unit (** Set [key] to [value] in the Memory. *) val memory_get : string -> string option (** Return the current value of [key] in the Memory. Returns [None] if the key has never been set or was deleted. *) val memory_delete : string -> unit (** Delete the [key]. If the key doesn't exist, has no effect. *) (** {2 Publishing goals} To "publish" a goal means it's available on the command line for users to use directly. Goals that have zero arguments are {b automatically published}. So for example: {v let goal clean () = sh "rm *~" } can be used on the command line: {v ./script clean } The special goal called [all] (if it exists) is run implicitly unless the user specifies another goal. Unlike [make], there is nothing special about the first rule in the file. You can also publish goals, especially ones which take a non-zero number of parameters, by calling {!publish}. *) val publish : string -> (string list -> unit) -> unit (** Publish the named goal. Use this function as in this example: {v let goal compiled program sources = ... stuff for building the program from sources ... let () = publish "compiled" ( fun args -> let program = List.hd args in let sources = List.tl args in require (compiled program sources) ) } This could be used as follows: {v ./script compiled program main.c utils.c } You will notice you have to write a bit of OCaml code to map the string arguments from the command line on to the goal arguments. In the example it means taking the first string argument as the program name, and the rest of the string arguments as the source filenames. This is also the place to perform string to int conversion, checks, and so on (remember that OCaml is strongly typed). *) (**/**) (* Goal versions of some common functions. You are using these * versions when you write something like: * require (file_exists "foo"); * They work the same way as the regular function, except they die * if the predicate returns false. *) val goal_file_exists : string -> unit val goal_directory_exists : string -> unit val goal_file_newer_than : string -> string -> unit val goal_more_recent : string list -> string list -> unit val goal_url_exists : string -> unit val goal_file_contains_string : string -> string -> unit val goal_url_contains_string : string -> string -> unit val goal_memory_exists : string -> unit (* A single call to this function is added by the 'goaljobs' script. * It is responsible for parsing the command line and so on. *) val init : unit -> unit (* Export this so the macros can catch these exceptions. *) type goal_result_t = Goal_OK | Goal_failed of string exception Goal_result of goal_result_t