open Ketrew_pervasives
module Path = Ketrew_path
module Target = Ketrew_target
module Host = struct
include Ketrew_host
let ssh
?add_ssh_options
?playground
?port ?user ?name str =
let playground = Option.map ~f:Path.absolute_directory_exn playground in
ssh ?default_shell:None
?execution_timeout:None
?add_ssh_options
?playground
?port ?user ?name str
let parse = of_string
let cmdliner_term
?(doc="URI of the host (e.g. ssh://user@example.com:42/tmp/ketrewplayground).") how =
let open Cmdliner in
Term.(
pure (fun s -> parse s)
$ begin match how with
| `Flag (flags) ->
Arg.(value & opt string "/tmp/" & info flags ~doc ~docv:"URI")
| `Required p ->
Arg.(required & pos p (some string) None & info [] ~doc ~docv:"URI")
end
)
end
class type user_artifact = object
method path : string
method exists: Target.Condition.t
method is_bigger_than: int -> Target.Condition.t
end
let unit = object
method path = failwith "Unit has no path"
method exists = failwith "Unit does not “exist”"
method is_bigger_than _ = failwith "Unit has no size"
end
let file ?(host= Host.tmp_on_localhost) path =
let basename = Filename.basename path in
object
val vol =
Target.Volume.(
create ~host
~root:(Path.absolute_directory_exn (Filename.dirname path))
(file basename))
method path = path
method exists = `Volume_exists vol
method is_bigger_than n = `Volume_size_bigger_than (vol, n)
end
class type user_target =
object
method activate : unit
method name : string
method is_active: bool
method id: Unique_id.t
method render: Ketrew_target.t
method depends_on: user_target list
method on_failure_activate: user_target list
method on_success_activate: user_target list
method metadata: [`String of string ] option
method product: user_artifact
end
let user_target_internal
?(active = false)
?(depends_on = [])
?(on_failure_activate = [])
?(on_success_activate = [])
?(name: string option)
?(make: Target.Build_process.t = Target.Build_process.nop)
?done_when
?metadata
?product
?equivalence
?tags
()
=
let id = Unique_id.create () in
object (self)
val mutable active = active
method name =
match name with
| None -> id
| Some s -> s
method id = id
method depends_on = depends_on
method on_failure_activate = on_failure_activate
method on_success_activate = on_success_activate
method activate = active <- true
method is_active = active
method metadata = metadata
method render =
Target.create ?metadata
~id:self#id
~depends_on:(List.map depends_on ~f:(fun t -> t#id))
~on_failure_activate:(List.map on_failure_activate ~f:(fun t -> t#id))
~on_success_activate:(List.map on_success_activate ~f:(fun t -> t#id))
~name:self#name ?condition:done_when
?equivalence ?tags
~make ()
|> (fun x ->
if active then Target.activate_exn ~reason:`User x else x)
method product =
Option.value_exn product
~msg:(fmt "Target %s has no known product" self#name)
end
let target ?active ?depends_on ?make ?done_when ?metadata ?product
?equivalence ?on_failure_activate ?on_success_activate ?tags name =
user_target_internal
?equivalence ?on_failure_activate ?tags ?on_success_activate
?active ?depends_on ~name ?make ?metadata ?done_when ?product ()
let file_target
?depends_on ?make ?metadata ?name ?host ?equivalence ?on_failure_activate
?on_success_activate ?tags path =
let product = file ?host path in
let name = Option.value name ~default:("Make:" ^ path) in
target ~product ?equivalence ?on_failure_activate ?tags ?on_success_activate
~done_when:product#exists ?depends_on ?make ?metadata name
module Program = struct
type t = Ketrew_program.t
let (&&) a b = `And [a; b]
let sh c = `Shell_command c
let shf fmt = Printf.ksprintf sh fmt
let exec l = `Exec l
let chain l = `And l
end
module Condition = struct
type t = Ketrew_target.Condition.t
let (&&) a b = `And [a; b]
let chain_and l = `And l
let never = `Never
let program ?(returns=0) ?host p =
`Command_returns (Ketrew_target.Command.program ?host p, returns)
end
let daemonize = Ketrew_daemonize.create
let lsf = Ketrew_lsf.create
let pbs = Ketrew_pbs.create
let yarn_application ?host ?daemonize_using ?daemon_start_timeout program =
Ketrew_yarn.create
?host ?daemonize_using ?daemon_start_timeout (`Yarn_application program)
let yarn_distributed_shell
?host ?daemonize_using ?daemon_start_timeout
?hadoop_bin ?distributed_shell_shell_jar
~container_memory ~timeout ~application_name program =
Ketrew_yarn.(
create
?host ?daemonize_using ?daemon_start_timeout
(distributed_shell_program
?hadoop_bin ?distributed_shell_shell_jar
~container_memory ~timeout ~application_name program))
let to_display_string ?(ansi_colors=false) ?(indentation=2) ut =
let escape c = fmt "\027[%sm" c in
let color c t = if ansi_colors then escape c ^ t ^ escape "0" else t in
let bold_red t = color "1;31" t in
let bold_yellow t = color "1;33" t in
let bold_green t = color "1;32" t in
let rec dump_workflow ?(kind=`Dep) ?(depth=0) ut =
let sublist ~kind l =
String.concat ~sep:""
(List.map l ~f:(dump_workflow ~kind ~depth:(depth + 1))) in
let line content =
match kind with
| `Dep -> bold_green (fmt "* %s" content)
| `OFA -> bold_red (fmt "× %s" content)
| `OSA -> bold_yellow (fmt "→ %s" content)
in
fmt "%s%s\n%s%s%s"
(String.make (depth * indentation) ' ')
(line ut#name)
(sublist ut#depends_on ~kind:`Dep)
(sublist ut#on_failure_activate ~kind:`OFA)
(sublist ut#on_success_activate ~kind:`OSA)
in
dump_workflow ut