95 lines
3.1 KiB
OCaml
95 lines
3.1 KiB
OCaml
(*
|
|
* Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
|
|
* Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
|
|
* Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
|
|
*
|
|
* Permission to use, copy, modify, and distribute this software for any
|
|
* purpose with or without fee is hereby granted, provided that the above
|
|
* copyright notice and this permission notice appear in all copies.
|
|
*
|
|
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
*)
|
|
|
|
type t = { bin : (Fpath.t * Fpath.t) list; etc : Fpath.t list }
|
|
|
|
let v ?(bin = []) ?(etc = []) () = { bin; etc }
|
|
let empty = v ()
|
|
|
|
let dump ppf t =
|
|
let bin ppf t = Fmt.Dump.(list (pair Fpath.pp Fpath.pp)) ppf t.bin in
|
|
let etc ppf t = Fmt.Dump.(list Fpath.pp) ppf t.etc in
|
|
Fmt.Dump.record [ bin; etc ] ppf t
|
|
|
|
let pp ppf t =
|
|
let pp_bin ppf (src, dst) =
|
|
Fmt.pf ppf "\n \"%a\" {\"%a\"}" Fpath.pp src Fpath.pp dst
|
|
in
|
|
let pp_etc ppf file =
|
|
Fmt.pf ppf "\n \"%a\" {\"%s\"}" Fpath.pp file Fpath.(basename file)
|
|
in
|
|
let bins = List.map (Fmt.to_to_string pp_bin) t.bin in
|
|
let etcs = List.map (Fmt.to_to_string pp_etc) t.etc in
|
|
Fmt.pf ppf "bin: [%s%s]\n" (String.concat "" bins)
|
|
(match bins with [] -> "" | _ -> "\n");
|
|
Fmt.pf ppf "etc: [%s%s]" (String.concat "" etcs)
|
|
(match etcs with [] -> "" | _ -> "\n")
|
|
|
|
let pp_opam ?subdir () ppf t =
|
|
let pp_bin ppf (src, dst) =
|
|
Fmt.pf ppf {|"cp" "%adist/%a" "%%{bin}%%/%a"|}
|
|
Fmt.(option ~none:(any "") Fpath.pp)
|
|
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)
|
|
subdir 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;
|
|
match t.etc with
|
|
| [] -> ()
|
|
| _ ->
|
|
Fmt.pf ppf "%a\n"
|
|
(Fmt.list ~sep:(Fmt.any "\n") (fun ppf -> Fmt.pf ppf " [ %a ]" pp_etc))
|
|
t.etc
|
|
|
|
let promote_artifact ~context_name ~src ~dst =
|
|
Dune.stanzaf
|
|
{|
|
|
(rule
|
|
(mode (promote (until-clean)))
|
|
(target %a)
|
|
(enabled_if (= %%{context_name} "%s"))
|
|
(action
|
|
(copy %a %%{target}))
|
|
)
|
|
|}
|
|
Fpath.pp dst context_name Fpath.pp
|
|
Fpath.(v ".." // src)
|
|
|
|
let dune ~context_name_for_bin ~context_name_for_etc t =
|
|
let bin_rules =
|
|
List.map
|
|
(fun (src, dst) ->
|
|
promote_artifact ~context_name:context_name_for_bin ~src ~dst)
|
|
t.bin
|
|
in
|
|
let etc_rules =
|
|
List.map
|
|
(fun etc ->
|
|
promote_artifact ~context_name:context_name_for_etc ~src:etc ~dst:etc)
|
|
t.etc
|
|
in
|
|
Dune.v (bin_rules @ etc_rules)
|
|
|
|
let union_etc x y = Fpath.Set.(elements (union (of_list x) (of_list y)))
|
|
let union_bin x y = x @ y
|
|
let union x y = { bin = union_bin x.bin y.bin; etc = union_etc x.etc y.etc }
|