136 lines
4.5 KiB
OCaml
136 lines
4.5 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.
|
|
*)
|
|
|
|
open Astring
|
|
|
|
type scope = [ `Switch | `Monorepo ]
|
|
|
|
type t = {
|
|
name : string;
|
|
pin : (string * string) option; (** [name_version * url] *)
|
|
scope : scope;
|
|
build : bool;
|
|
libs : String.Set.t;
|
|
min : String.Set.t;
|
|
max : String.Set.t;
|
|
}
|
|
|
|
let name t = t.name
|
|
|
|
let key t =
|
|
match t.scope with
|
|
| `Switch -> "switch-" ^ t.name
|
|
| `Monorepo -> "monorepo-" ^ t.name
|
|
|
|
let pin t = t.pin
|
|
let build_dependency t = t.build
|
|
let scope t = t.scope
|
|
let libraries t = String.Set.elements t.libs
|
|
let min_versions t = String.Set.elements t.min
|
|
let max_versions t = String.Set.elements t.max
|
|
|
|
let merge a b =
|
|
if a.name <> b.name then None
|
|
else if a.scope <> b.scope then None
|
|
else
|
|
let name = a.name in
|
|
let libs = String.Set.union a.libs b.libs
|
|
and min = String.Set.union a.min b.min
|
|
and max = String.Set.union a.max b.max
|
|
and pin =
|
|
match (a.pin, b.pin) with
|
|
| None, None -> None
|
|
| None, Some a | Some a, None -> Some a
|
|
| Some (an, au), Some (bn, bu)
|
|
when String.equal an au && String.equal bn bu ->
|
|
a.pin
|
|
| _ -> invalid_arg ("conflicting pin depends for " ^ name)
|
|
and build = a.build || b.build
|
|
and scope = a.scope in
|
|
match pin with
|
|
| None -> Some { name; build; scope; libs; min; max; pin }
|
|
| Some _ ->
|
|
(* pin wins over min and max *)
|
|
let empty = String.Set.empty in
|
|
Some { name; build; scope; libs; min = empty; max = empty; pin }
|
|
|
|
let package_name_is_valid name =
|
|
let has_letter = String.exists Char.Ascii.is_letter name in
|
|
let only_allowed_chars =
|
|
String.for_all
|
|
(function
|
|
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true | _ -> false)
|
|
name
|
|
in
|
|
only_allowed_chars && has_letter
|
|
|
|
let v ?(scope = `Monorepo) ?(build = false) ?sublibs ?libs ?min ?max ?pin
|
|
?(pin_version = "dev") name =
|
|
if not (package_name_is_valid name) then
|
|
Fmt.invalid_arg "package name %S is invalid" name;
|
|
let libs =
|
|
match (sublibs, libs) with
|
|
| None, None -> [ name ]
|
|
| Some xs, None ->
|
|
List.map (fun x -> if x = "" then name else name ^ "." ^ x) xs
|
|
| None, Some a -> a
|
|
| Some _, Some _ ->
|
|
Fmt.invalid_arg
|
|
"dependent package %s may either specify ~sublibs or ~ocamlfind" name
|
|
in
|
|
let libs = String.Set.of_list libs in
|
|
let to_set = function
|
|
| None -> String.Set.empty
|
|
| Some m -> String.Set.singleton m
|
|
in
|
|
let min = to_set min
|
|
and max = to_set max
|
|
and pin =
|
|
match pin with Some p -> Some (name ^ "." ^ pin_version, p) | None -> None
|
|
in
|
|
{ name; build; scope; libs; min; max; pin }
|
|
|
|
let with_scope ~scope t = { t with scope }
|
|
|
|
let exts_to_string ppf (min, max, build, scope) =
|
|
let build_strs = if build then [ "build" ] else [] in
|
|
let esc_prefix prefix e = Fmt.str "%s %S" prefix e in
|
|
let min_strs = List.map (esc_prefix ">=") (String.Set.elements min)
|
|
and max_strs = List.map (esc_prefix "<") (String.Set.elements max) in
|
|
let constr_list = build_strs @ min_strs @ max_strs in
|
|
let constr_list =
|
|
match scope with
|
|
| `Monorepo -> "?monorepo" :: constr_list
|
|
| `Switch -> constr_list
|
|
in
|
|
if List.length constr_list > 0 then
|
|
Fmt.pf ppf " { %s }" (String.concat ~sep:" & " constr_list)
|
|
|
|
let pp ?(surround = "") ppf p =
|
|
Fmt.pf ppf "%s%s%s%a" surround p.name surround exts_to_string
|
|
(p.min, p.max, p.build, p.scope)
|
|
|
|
module Set = struct
|
|
type elt = t
|
|
type t = elt String.Map.t
|
|
|
|
let of_list x = String.Map.of_list (List.map (fun p -> (name p, p)) x)
|
|
let to_list x = String.Map.fold (fun _ v acc -> v :: acc) x [] |> List.rev
|
|
let union x y = String.Map.union (fun _ -> merge) x y
|
|
let empty = String.Map.empty
|
|
end
|