Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Reproducible #1335

Merged
merged 11 commits into from Jul 26, 2022
2 changes: 1 addition & 1 deletion .ocamlformat
@@ -1,4 +1,4 @@
version = 0.21.0
version = 0.22.4
profile = conventional
break-infix = fit-or-vertical
parse-docstrings = true
19 changes: 12 additions & 7 deletions lib/functoria/info.ml
Expand Up @@ -25,7 +25,11 @@ type t = {
keys : Key.Set.t;
context : Key.context;
packages : Package.t String.Map.t;
opam : install:Install.t -> Opam.t;
opam :
extra_repo:(string * string) list ->
install:Install.t ->
opam_name:string ->
Opam.t;
}

let name t = t.name
Expand Down Expand Up @@ -59,12 +63,13 @@ let pins packages =
let keys t = Key.Set.elements t.keys
let context t = t.context

let v ?(config_file = Fpath.v "config.ml") ~packages ~keys ~context ~build_cmd
~src name =
let v ?(config_file = Fpath.v "config.ml") ~packages ~keys ~context
?configure_cmd ?pre_build_cmd ?lock_location ~build_cmd ~src name =
let keys = Key.Set.of_list keys in
let opam ~install =
Opam.v ~depends:packages ~install ~pins:(pins packages) ~build:build_cmd
~src name
let opam ~extra_repo ~install ~opam_name =
Opam.v ~depends:packages ~install ~pins:(pins packages) ~extra_repo
?configure:configure_cmd ?pre_build:pre_build_cmd ?lock_location
~build:build_cmd ~src ~opam_name name
in
let packages =
List.fold_left
Expand Down Expand Up @@ -105,6 +110,6 @@ let pp verbose ppf ({ name; keys; context; output; _ } as t) =
let t =
let i =
v ~config_file:(Fpath.v "config.ml") ~packages:[] ~keys:[]
~build_cmd:[ "dummy" ] ~context:Key.empty_context ~src:`None "dummy"
~build_cmd:"dummy" ~context:Key.empty_context ~src:`None "dummy"
in
Type.v i
12 changes: 10 additions & 2 deletions lib/functoria/info.mli
Expand Up @@ -42,7 +42,12 @@ val libraries : t -> string list
val packages : t -> Package.t list
(** [packages t] are the opam package dependencies by the project. *)

val opam : t -> install:Install.t -> Opam.t
val opam :
t ->
extra_repo:(string * string) list ->
install:Install.t ->
opam_name:string ->
Opam.t
(** [opam scope t] is [t]'opam file to install in the [scope] context.*)

val keys : t -> Key.t list
Expand All @@ -59,7 +64,10 @@ val v :
packages:Package.t list ->
keys:Key.t list ->
context:Key.context ->
build_cmd:string list ->
?configure_cmd:string ->
?pre_build_cmd:(Fpath.t option -> string) ->
?lock_location:(Fpath.t option -> string -> string) ->
build_cmd:string ->
src:[ `Auto | `None | `Some of string ] ->
string ->
t
Expand Down
12 changes: 9 additions & 3 deletions lib/functoria/install.ml
Expand Up @@ -40,11 +40,17 @@ let pp ppf t =
Fmt.pf ppf "etc: [%s%s]" (String.concat "" etcs)
(match etcs with [] -> "" | _ -> "\n")

let pp_opam ppf t =
let pp_opam ?subdir () ppf t =
let pp_bin ppf (src, dst) =
Fmt.pf ppf {|"cp" "dist/%a" "%%{bin}%%/%a"|} Fpath.pp src Fpath.pp dst
Fmt.pf ppf {|"cp" "%adist/%a" "%%{bin}%%/%a"|}
Fmt.(option ~none:(any "") (Fpath.pp ++ any "/"))
hannesm marked this conversation as resolved.
Show resolved Hide resolved
subdir Fpath.pp src Fpath.pp dst
in
let pp_etc ppf etc =
Fmt.pf ppf {|"cp" "%adist/%a" "%%{etc}%%"|}
Fmt.(option ~none:(any "") (Fpath.pp ++ any "/"))
subdir Fpath.pp etc
in
let pp_etc ppf etc = Fmt.pf ppf {|"cp" "dist/%a" "%%{etc}%%"|} Fpath.pp etc in
Fmt.pf ppf "\n%a\n"
(Fmt.list ~sep:(Fmt.any "\n") (fun ppf -> Fmt.pf ppf " [ %a ]" pp_bin))
t.bin;
Expand Down
2 changes: 1 addition & 1 deletion lib/functoria/install.mli
Expand Up @@ -31,7 +31,7 @@ val empty : t
val pp : t Fmt.t
(** Print the .install rules to install [t] *)

val pp_opam : t Fmt.t
val pp_opam : ?subdir:Fpath.t -> unit -> t Fmt.t
(** Print the opam rules to install [t] *)
hannesm marked this conversation as resolved.
Show resolved Hide resolved

val dune :
Expand Down
76 changes: 59 additions & 17 deletions lib/functoria/lib.ml
Expand Up @@ -29,7 +29,10 @@ module Config = struct
type t = {
config_file : Fpath.t;
name : string;
build_cmd : string list;
configure_cmd : string;
pre_build_cmd : Fpath.t option -> string;
lock_location : Fpath.t option -> string -> string;
build_cmd : string;
packages : package list Key.value;
keys : Key.Set.t;
init : job impl list;
Expand All @@ -56,21 +59,47 @@ module Config = struct
Key.Set.fold f all_keys skeys

let v ?(config_file = Fpath.v "config.ml") ?(keys = []) ?(packages = [])
?(init = []) ~build_cmd ~src name jobs =
?(init = []) ~configure_cmd ~pre_build_cmd ~lock_location ~build_cmd ~src
name jobs =
let packages = Key.pure @@ packages in
let jobs = Impl.abstract jobs in
let keys = Key.Set.(union (of_list keys) (get_if_context jobs)) in
{ config_file; packages; keys; name; init; build_cmd; jobs; src }
{
config_file;
packages;
keys;
name;
init;
configure_cmd;
pre_build_cmd;
lock_location;
build_cmd;
jobs;
src;
}

let eval ~full context
{ config_file; name = n; build_cmd; packages; keys; jobs; init; src } =
{
config_file;
name = n;
configure_cmd;
pre_build_cmd;
lock_location;
build_cmd;
packages;
keys;
jobs;
init;
src;
} =
let jobs = Impl.simplify ~full ~context jobs in
let device_graph = Impl.eval ~context jobs in
let packages = Key.(pure List.append $ packages $ Engine.packages jobs) in
let keys = Key.Set.elements (Key.Set.union keys @@ Engine.all_keys jobs) in
let mk packages _ context =
let info =
Info.v ~config_file ~packages ~keys ~context ~build_cmd ~src n
Info.v ~config_file ~packages ~keys ~context ~configure_cmd
~pre_build_cmd ~lock_location ~build_cmd ~src n
in
{ init; jobs; info; device_graph }
in
Expand Down Expand Up @@ -115,13 +144,23 @@ module Make (P : S) = struct
|> List.tl
|> List.filter (fun arg ->
arg <> "configure" && arg <> "query" && arg <> "opam")
|> List.map (fun x -> "\"" ^ x ^ "\"")
|> String.concat ~sep:" "
in
[
Fmt.str {|"%s" "configure" %s|} P.name command_line_arguments;
Fmt.str {|"%s" "build"|} P.name;
]
let opts =
if command_line_arguments = "" then None else Some command_line_arguments
in
( Fmt.str {|%s configure%a --no-extra-repo|} P.name
Fmt.(option ~none:(any "") (any " " ++ string))
opts,
(fun sub ->
Fmt.str {|make %a"lock" "pull"|}
Fmt.(option ~none:(any "") (any "\"-C" ++ Fpath.pp ++ any "\" "))
sub),
(fun sub unikernel ->
Fmt.str {|%amirage/%s.opam.locked|}
Fmt.(option ~none:(any "") Fpath.pp)
sub unikernel),
Fmt.str {|%s build|} P.name )

(* STAGE 2 *)

Expand Down Expand Up @@ -202,7 +241,8 @@ module Make (P : S) = struct
let pkgs = Info.packages info in
List.iter (Fmt.pr "%a\n%!" (Package.pp ~surround:"\"")) pkgs
| `Opam ->
let opam = Info.opam ~install info in
let opam_name = Misc.Name.(Opam.to_string (opamify name)) in
let opam = Info.opam ~extra_repo ~install ~opam_name info in
Fmt.pr "%a\n%!" Opam.pp opam
| `Files ->
let files = files info jobs in
Expand Down Expand Up @@ -247,11 +287,11 @@ module Make (P : S) = struct

(* Configuration step. *)

let generate_opam ~opam_name (args : _ Cli.args) () =
let generate_opam ~opam_name ~extra_repo (args : _ Cli.args) () =
let { Config.info; jobs; _ } = args.Cli.context in
let install = Key.eval (Info.context info) (Engine.install info jobs) in
let name = Misc.Name.Opam.to_string opam_name in
let opam = Info.opam ~install info in
let opam = Info.opam ~install ~extra_repo ~opam_name:name info in
let contents = Fmt.str "%a" Opam.pp opam in
let file = Fpath.(v (name ^ ".opam")) in
Log.info (fun m ->
Expand Down Expand Up @@ -326,7 +366,7 @@ module Make (P : S) = struct
let* () =
Action.with_dir (mirage_dir args) (fun () ->
(* OPAM file *)
let* () = generate_opam ~opam_name args () in
let* () = generate_opam ~opam_name ~extra_repo args () in
(* Generate application specific-files *)
Log.info (fun m -> m "in dir %a" (Cli.pp_args (fun _ _ -> ())) args);
configure_main info init device_graph)
Expand Down Expand Up @@ -468,11 +508,13 @@ module Make (P : S) = struct
let args = Cli.peek_args ~with_setup:true ~mname:P.name argv in
let config_file = config_file args in
let run () =
let build_cmd = get_build_cmd args in
let configure_cmd, pre_build_cmd, lock_location, build_cmd =
get_build_cmd args
in
let main_dev = P.create (init @ jobs) in
let c =
Config.v ~config_file ?keys ?packages ~init ~build_cmd ~src name
main_dev
Config.v ~config_file ?keys ?packages ~init ~configure_cmd
~pre_build_cmd ~lock_location ~build_cmd ~src name main_dev
in
run_configure_with_argv argv args c
in
Expand Down
82 changes: 67 additions & 15 deletions lib/functoria/opam.ml
Expand Up @@ -29,7 +29,8 @@ let find_git () =
else find (Fpath.parent p) (Some (app_opt path (Fpath.base p)))
in
let* cwd = Action.pwd () in
let* cwd = find cwd None in
(* this is invoked from within the mirage subdirectory *)
let* cwd = find (Fpath.parent cwd) None in
match cwd with
| None -> Action.ok None
| Some subdir ->
Expand Down Expand Up @@ -101,11 +102,11 @@ let guess_src () =
let git_info =
match Action.run @@ find_git () with
| Error _ | Ok None -> None
| Ok (Some (_, branch, git_url)) -> Some (branch, git_url)
| Ok (Some (subdir, branch, git_url)) -> Some (subdir, branch, git_url)
in
match git_info with
| None -> None
| Some (branch, origin) ->
| None -> (None, None)
| Some (subdir, branch, origin) ->
(* TODO is there a library for git urls anywhere? *)
let public =
match Endpoint.of_string origin with
Expand All @@ -128,23 +129,48 @@ let guess_src () =
Fmt.str "git+https://%s:%d/%s" hostname port path
| _ -> "git+https://invalid/endpoint"
in
Some (Fmt.str "%s#%s" public branch)
(subdir, Some (Fmt.str "%s#%s" public branch))

type t = {
name : string;
depends : Package.t list;
build : string list;
configure : string option;
pre_build : (Fpath.t option -> string) option;
lock_location : (Fpath.t option -> string -> string) option;
build : string option;
install : Install.t;
extra_repo : (string * string) list;
pins : (string * string) list;
src : string option;
subdir : Fpath.t option;
opam_name : string;
}

let v ?(build = []) ?(install = Install.empty) ?(depends = []) ?(pins = []) ~src
name =
let src =
match src with `Auto -> guess_src () | `None -> None | `Some d -> Some d
let v ?configure ?pre_build ?lock_location ?build ?(install = Install.empty)
?(extra_repo = []) ?(depends = []) ?(pins = []) ?subdir ~src ~opam_name name
=
let subdir, src =
match src with
| `Auto ->
let subdir', src = guess_src () in
((match subdir with None -> subdir' | Some _ as s -> s), src)
| `None -> (subdir, None)
| `Some d -> (subdir, Some d)
in
{ name; depends; build; install; pins; src }
{
name;
depends;
configure;
pre_build;
lock_location;
build;
install;
extra_repo;
pins;
src;
subdir;
opam_name;
}

let pp_packages ppf packages =
Fmt.pf ppf "\n %a\n"
Expand All @@ -166,8 +192,20 @@ let pp_src ppf = function
let pp_switch_package ppf s = Fmt.pf ppf "%S" s

let pp ppf t =
let pp_build ppf =
Fmt.pf ppf "\n%a\n" (Fmt.list ~sep:(Fmt.any "\n") (Fmt.fmt " [ %s ]"))
let pp_build = function
| None -> ""
| Some cmd ->
Fmt.str {|"sh" "-exc" "%a%s"|}
Fmt.(option ~none:(any "") (any "cd " ++ Fpath.pp ++ any " && "))
t.subdir cmd
in
let pp_pre_build ppf pre_build =
match pre_build with None -> () | Some f -> Fmt.string ppf (f t.subdir)
in
let pp_repo =
Fmt.(
list ~sep:(any "\n")
(brackets (pair ~sep:(any " ") (quote string) (quote string))))
in
let switch_packages =
List.filter_map
Expand All @@ -190,14 +228,28 @@ It assumes that local dependencies are already
fetched.
"""

build: [%a]
build: [%s]

install: [%a]

depends: [%a]

x-mirage-opam-lock-location: %S

x-mirage-configure: [%s]

x-mirage-pre-build: [%a]

x-mirage-extra-repo: [%a]

x-opam-monorepo-opam-provided: [%a]
%a%a|}
t.name pp_build t.build Install.pp_opam t.install pp_packages t.depends
t.name (pp_build t.build)
(Install.pp_opam ?subdir:t.subdir ())
t.install pp_packages t.depends
(Option.fold ~none:""
~some:(fun l -> l t.subdir t.opam_name)
t.lock_location)
(pp_build t.configure) pp_pre_build t.pre_build pp_repo t.extra_repo
(Fmt.list pp_switch_package)
switch_packages pp_src t.src pp_pins t.pins
8 changes: 7 additions & 1 deletion lib/functoria/opam.mli
Expand Up @@ -19,11 +19,17 @@
type t

val v :
?build:string list ->
?configure:string ->
?pre_build:(Fpath.t option -> string) ->
?lock_location:(Fpath.t option -> string -> string) ->
?build:string ->
?install:Install.t ->
?extra_repo:(string * string) list ->
?depends:Package.t list ->
?pins:(string * string) list ->
?subdir:Fpath.t ->
src:[ `Auto | `None | `Some of string ] ->
opam_name:string ->
string ->
t

Expand Down