Include the package in the public status of libraries
This commit is contained in:
parent
4c69d3e540
commit
b59dab57da
|
@ -8,20 +8,20 @@ open Result.O
|
||||||
module Status = struct
|
module Status = struct
|
||||||
type t =
|
type t =
|
||||||
| Installed
|
| Installed
|
||||||
| Public
|
| Public of Package.t
|
||||||
| Private of Jbuild.Scope_info.Name.t
|
| Private of Jbuild.Scope_info.Name.t
|
||||||
|
|
||||||
let pp ppf t =
|
let pp ppf t =
|
||||||
Format.pp_print_string ppf
|
Format.pp_print_string ppf
|
||||||
(match t with
|
(match t with
|
||||||
| Installed -> "installed"
|
| Installed -> "installed"
|
||||||
| Public -> "public"
|
| Public _ -> "public"
|
||||||
| Private s ->
|
| Private s ->
|
||||||
sprintf "private (%s)" (Jbuild.Scope_info.Name.to_string s))
|
sprintf "private (%s)" (Jbuild.Scope_info.Name.to_string s))
|
||||||
|
|
||||||
let is_private = function
|
let is_private = function
|
||||||
| Private _ -> true
|
| Private _ -> true
|
||||||
| Installed | Public -> false
|
| Installed | Public _ -> false
|
||||||
end
|
end
|
||||||
|
|
||||||
module Info = struct
|
module Info = struct
|
||||||
|
@ -89,7 +89,7 @@ module Info = struct
|
||||||
let status =
|
let status =
|
||||||
match conf.public with
|
match conf.public with
|
||||||
| None -> Status.Private conf.scope_name
|
| None -> Status.Private conf.scope_name
|
||||||
| Some _ -> Public
|
| Some p -> Public p.package
|
||||||
in
|
in
|
||||||
let foreign_archives =
|
let foreign_archives =
|
||||||
{ Mode.Dict.
|
{ Mode.Dict.
|
||||||
|
|
|
@ -35,7 +35,7 @@ module Set : Set.S with type elt = t
|
||||||
module Status : sig
|
module Status : sig
|
||||||
type t =
|
type t =
|
||||||
| Installed
|
| Installed
|
||||||
| Public
|
| Public of Package.t
|
||||||
| Private of Jbuild.Scope_info.Name.t
|
| Private of Jbuild.Scope_info.Name.t
|
||||||
|
|
||||||
val pp : t Fmt.t
|
val pp : t Fmt.t
|
||||||
|
|
|
@ -35,7 +35,7 @@ module Doc = struct
|
||||||
dir_internal t
|
dir_internal t
|
||||||
(match Lib.status lib with
|
(match Lib.status lib with
|
||||||
| Installed -> assert false
|
| Installed -> assert false
|
||||||
| Public -> Public (Lib.name lib)
|
| Public _ -> Public (Lib.name lib)
|
||||||
| Private s -> Private (Lib.name lib, s))
|
| Private s -> Private (Lib.name lib, s))
|
||||||
in
|
in
|
||||||
Build_system.Alias.stamp_file (alias ~dir) :: acc
|
Build_system.Alias.stamp_file (alias ~dir) :: acc
|
||||||
|
@ -220,7 +220,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~scope ~modules ~mld_files
|
||||||
let name = Lib.name lib in
|
let name = Lib.name lib in
|
||||||
match Lib.status lib with
|
match Lib.status lib with
|
||||||
| Installed -> assert false
|
| Installed -> assert false
|
||||||
| Public -> name
|
| Public _ -> name
|
||||||
| Private scope_name ->
|
| Private scope_name ->
|
||||||
sprintf "%s@%s" name (Scope_info.Name.to_string scope_name)
|
sprintf "%s@%s" name (Scope_info.Name.to_string scope_name)
|
||||||
in
|
in
|
||||||
|
|
|
@ -126,15 +126,6 @@ let gen_rules sctx components =
|
||||||
build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe
|
build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
|
|
||||||
let most_specific_db (a : Lib.Status.t) (b : Lib.Status.t) =
|
|
||||||
match a, b with
|
|
||||||
| Private x, Private y -> assert (x = y); a
|
|
||||||
| Private _, _ -> a
|
|
||||||
| _ , Private _ -> b
|
|
||||||
| Public , _
|
|
||||||
| _ , Public -> Public
|
|
||||||
| Installed, Installed -> Installed
|
|
||||||
|
|
||||||
let get_ppx_driver sctx ~scope pps =
|
let get_ppx_driver sctx ~scope pps =
|
||||||
let driver, names =
|
let driver, names =
|
||||||
match List.rev_map pps ~f:(fun (_loc, pp) -> Pp.to_string pp) with
|
match List.rev_map pps ~f:(fun (_loc, pp) -> Pp.to_string pp) with
|
||||||
|
@ -142,25 +133,34 @@ let get_ppx_driver sctx ~scope pps =
|
||||||
| driver :: rest -> (Some driver, rest)
|
| driver :: rest -> (Some driver, rest)
|
||||||
in
|
in
|
||||||
let sctx = SC.host sctx in
|
let sctx = SC.host sctx in
|
||||||
let name_and_db name =
|
let name_and_scope_for_key name =
|
||||||
match Lib.DB.find (Scope.libs scope) name with
|
match Lib.DB.find (Scope.libs scope) name with
|
||||||
| Error _ ->
|
| Error _ ->
|
||||||
(* XXX unknown but assume it's public *)
|
(* XXX unknown but assume it's public *)
|
||||||
(name, Lib.Status.Installed)
|
(name, None)
|
||||||
| Ok lib ->
|
| Ok lib ->
|
||||||
(Lib.name lib, Lib.status lib)
|
(Lib.name lib,
|
||||||
|
match Lib.status lib with
|
||||||
|
| Private scope_name -> Some scope_name
|
||||||
|
| Public _ | Installed -> None)
|
||||||
in
|
in
|
||||||
let driver, driver_db =
|
let driver, scope_for_key =
|
||||||
match driver with
|
match driver with
|
||||||
| None -> (None, Lib.Status.Installed)
|
| None -> (None, None)
|
||||||
| Some driver ->
|
| Some driver ->
|
||||||
let name, db = name_and_db driver in
|
let name, scope_for_key = name_and_scope_for_key driver in
|
||||||
(Some name, db)
|
(Some name, scope_for_key)
|
||||||
in
|
in
|
||||||
let names, db =
|
let names, scope_for_key =
|
||||||
List.fold_left names ~init:([], driver_db) ~f:(fun (names, db) lib ->
|
List.fold_left names ~init:([], scope_for_key)
|
||||||
let name, db' = name_and_db lib in
|
~f:(fun (names, scope_for_key) lib ->
|
||||||
(name :: names, most_specific_db db db'))
|
let name, scope_for_key' = name_and_scope_for_key lib in
|
||||||
|
(name :: names,
|
||||||
|
match scope_for_key, scope_for_key' with
|
||||||
|
| Some a, Some b -> assert (a = b); scope_for_key
|
||||||
|
| Some _, None -> scope_for_key
|
||||||
|
| None , Some _ -> scope_for_key'
|
||||||
|
| None , None -> None))
|
||||||
in
|
in
|
||||||
let names = List.sort ~compare:String.compare names in
|
let names = List.sort ~compare:String.compare names in
|
||||||
let names =
|
let names =
|
||||||
|
@ -174,9 +174,9 @@ let get_ppx_driver sctx ~scope pps =
|
||||||
| _ -> String.concat names ~sep:"+"
|
| _ -> String.concat names ~sep:"+"
|
||||||
in
|
in
|
||||||
let key =
|
let key =
|
||||||
match db with
|
match scope_for_key with
|
||||||
| Installed | Public -> key
|
| None -> key
|
||||||
| Private scope_name -> SC.Scope_key.to_string key scope_name
|
| Some scope_name -> SC.Scope_key.to_string key scope_name
|
||||||
in
|
in
|
||||||
let sctx = SC.host sctx in
|
let sctx = SC.host sctx in
|
||||||
ppx_exe sctx ~key
|
ppx_exe sctx ~key
|
||||||
|
|
Loading…
Reference in New Issue