Skip to content

Commit

Permalink
Add dune-sites-locations.plugins
Browse files Browse the repository at this point in the history 
 - simplifies the generated modules
 - hides the dependency with findlib
 - simplifies the API

Signed-off-by: François Bobot <[email protected]>
  • Loading branch information
@bobot
bobot committed Mar 23, 2020
1 parent bf97510 commit ed18fa3
Show file tree
Hide file tree
Showing 7 changed files with 193 additions and 182 deletions.
5 changes: 5 additions & 0 deletions otherlibs/sites_locations/src/plugins/dune
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
(library
(name sites_locations_plugins)
(public_name dune-sites-locations.plugins)
(libraries dune-sites-locations findlib.dynload)
)
42 changes: 42 additions & 0 deletions otherlibs/sites_locations/src/plugins/sites_locations_plugins.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,42 @@
module Private_ = struct

let readdir dirs =
List.concat
(List.map (fun dir -> (Array.to_list (Sys.readdir dir)))
(List.filter Sys.file_exists dirs))

let file_exists dirs plugin =
List.exists (fun d -> Sys.file_exists (Filename.concat d plugin)) dirs

module type S = sig
val paths: string list
val list: unit -> string list
val load_all: unit -> unit
val load: string -> unit
end

let new_id = let next_id = ref (-1) in fun () -> incr next_id; !next_id

let initialized_id = ref (-1)
let init id paths ocamlpath () =
if !initialized_id <> id
then
let env_ocamlpath =
String.concat Sites_locations.Private_.path_sep (paths@[ocamlpath])
in
Findlib.init ~env_ocamlpath ()

module Make (X:sig val paths: string list val ocamlpath: string end) : S = struct
include X
let id = new_id ()
let init () = init id paths ocamlpath ()
let list () = readdir paths
let load_all () = init (); Fl_dynload.load_packages (list ())
let exists name = file_exists paths name
let load name =
if exists name
then begin init (); Fl_dynload.load_packages [name] end
else raise Not_found
end

end
12 changes: 12 additions & 0 deletions otherlibs/sites_locations/src/plugins/sites_locations_plugins.mli
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
module Private_ : sig

module type S = sig
val paths: string list
val list: unit -> string list
val load_all: unit -> unit
val load: string -> unit
end

module Make(X:sig val paths : string list val ocamlpath : string end): S

end
231 changes: 102 additions & 129 deletions otherlibs/sites_locations/src/sites_locations.ml
View file
Original file line number Diff line number Diff line change
@@ -1,136 +1,109 @@
module V1 = struct
module Private_ = struct
module Location = struct
type t = string
end
module Section = struct
type t =
| Lib
| Lib_root
| Libexec
| Libexec_root
| Bin
| Sbin
| Toplevel
| Share
| Share_root
| Etc
| Doc
| Stublibs
| Man
| Misc

let of_string = function
| "lib" -> Lib
| "lib_root" -> Lib_root
| "libexec" -> Libexec
| "libexec_root" -> Libexec_root
| "bin" -> Bin
| "sbin" -> Sbin
| "toplevel" -> Toplevel
| "share" -> Share
| "share_root" -> Share_root
| "etc" -> Etc
| "doc" -> Doc
| "stublibs" -> Stublibs
| "man" -> Man
| "misc" -> Misc
| _ -> assert false (* since produced by Section.to_string *)
end

module Private_ = struct

module Section = struct
type t =
| Lib
| Lib_root
| Libexec
| Libexec_root
| Bin
| Sbin
| Toplevel
| Share
| Share_root
| Etc
| Doc
| Stublibs
| Man
| Misc

let of_string = function
| "lib" -> Lib
| "lib_root" -> Lib_root
| "libexec" -> Libexec
| "libexec_root" -> Libexec_root
| "bin" -> Bin
| "sbin" -> Sbin
| "toplevel" -> Toplevel
| "share" -> Share
| "share_root" -> Share_root
| "etc" -> Etc
| "doc" -> Doc
| "stublibs" -> Stublibs
| "man" -> Man
| "misc" -> Misc
| _ -> assert false (* since produced by Section.to_string *)
end

let dirs : (string*Section.t,string) Hashtbl.t = Hashtbl.create 10
(* multi-bindings first is the one with least priority *)

let path_sep =
if Sys.win32 then
';'
else
':'

let () =
match Sys.getenv_opt "DUNE_DIR_LOCATIONS" with
| None -> ()
| Some s ->
let rec aux = function
| [] -> ()
| package::section::dir::l ->
let section = Section.of_string section in
Hashtbl.add dirs (package,section) dir;
aux l
| _ -> invalid_arg "Error parsing DUNE_DIR_LOCATIONS"
in
let l = String.split_on_char path_sep s in
aux l

(* Parse the replacement format described in [artifact_substitution.ml]. *)
let eval s =
let len = String.length s in
if s.[0] = '=' then
let colon_pos = String.index_from s 1 ':' in
let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
(* This [min] is because the value might have been truncated
if it was too large *)
let vlen = min vlen (len - colon_pos - 1) in
Some (String.sub s (colon_pos + 1) vlen)
else
None
[@@inline never]

let eval_without_empty encoded =
match eval encoded with
| None | Some "" -> None
| Some _ as x -> x

let get_dir ~package ~section =
Hashtbl.find_all dirs (package,section)

let site ~package ~section ~suffix ~encoded =
let dirs = get_dir ~package ~section in
let dirs = match eval encoded with None -> dirs | Some d -> d::dirs in
List.rev_map (fun dir -> Filename.concat dir suffix) dirs
[@@inline never]

let sourceroot local =
match Sys.getenv_opt "DUNE_SOURCEROOT" with
| None -> eval_without_empty local
| Some _ as x -> x

let path_sep = if Sys.win32 then ";" else ":"
let ocamlpath local =
let env = match Sys.getenv_opt "OCAMLPATH" with
| None -> []
| Some x -> [x]
in
let env = match eval_without_empty local with
| None -> env
| Some x -> x::env
let dirs : (string*Section.t,string) Hashtbl.t = Hashtbl.create 10
(* multi-bindings first is the one with least priority *)

let path_sep =
if Sys.win32 then
';'
else
':'

let () =
match Sys.getenv_opt "DUNE_DIR_LOCATIONS" with
| None -> ()
| Some s ->
let rec aux = function
| [] -> ()
| package::section::dir::l ->
let section = Section.of_string section in
Hashtbl.add dirs (package,section) dir;
aux l
| _ -> invalid_arg "Error parsing DUNE_DIR_LOCATIONS"
in
String.concat path_sep env

module Plugin = struct
module type S = sig
val paths: string list
val list: unit -> string list
val load_all: unit -> unit
val load: string -> unit
end

let concat_paths paths ocamlpath =
String.concat path_sep ((List.flatten paths)@[ocamlpath])

let list dirs =
List.concat
(List.map (fun dir -> (Array.to_list (Sys.readdir dir)))
(List.filter Sys.file_exists dirs))

let exists dirs plugin =
List.exists (fun d -> Sys.file_exists (Filename.concat d plugin)) dirs

end


end
let l = String.split_on_char path_sep s in
aux l

(* Parse the replacement format described in [artifact_substitution.ml]. *)
let eval s =
let len = String.length s in
if s.[0] = '=' then
let colon_pos = String.index_from s 1 ':' in
let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
(* This [min] is because the value might have been truncated
if it was too large *)
let vlen = min vlen (len - colon_pos - 1) in
Some (String.sub s (colon_pos + 1) vlen)
else
None
[@@inline never]

let eval_without_empty encoded =
match eval encoded with
| None | Some "" -> None
| Some _ as x -> x

let get_dir ~package ~section =
Hashtbl.find_all dirs (package,section)

let site ~package ~section ~suffix ~encoded =
let dirs = get_dir ~package ~section in
let dirs = match eval encoded with None -> dirs | Some d -> d::dirs in
List.rev_map (fun dir -> Filename.concat dir suffix) dirs
[@@inline never]

let sourceroot local =
match Sys.getenv_opt "DUNE_SOURCEROOT" with
| None -> eval_without_empty local
| Some _ as x -> x

let path_sep = if Sys.win32 then ";" else ":"
let ocamlpath local =
let env = match Sys.getenv_opt "OCAMLPATH" with
| None -> []
| Some x -> [x]
in
let env = match eval_without_empty local with
| None -> env
| Some x -> x::env
in
String.concat path_sep env

end
62 changes: 23 additions & 39 deletions otherlibs/sites_locations/src/sites_locations.mli
View file
Original file line number Diff line number Diff line change
@@ -1,52 +1,36 @@
(** Provide locations information *)

module V1 : sig
module Private_ : sig

module Location : sig
type t = string
end

module Private_ : sig

module Section : sig
type t =
| Lib
| Lib_root
| Libexec
| Libexec_root
| Bin
| Sbin
| Toplevel
| Share
| Share_root
| Etc
| Doc
| Stublibs
| Man
| Misc
end

val site : package:string -> section:Section.t ->
suffix:string -> encoded:string -> Location.t list

val ocamlpath: string -> string
val sourceroot: string -> string option

module Plugin : sig
module type S = sig
val paths: string list
val list: unit -> string list
val load_all: unit -> unit
val load: string -> unit
end

val list: string list -> string list
module Section : sig
type t =
| Lib
| Lib_root
| Libexec
| Libexec_root
| Bin
| Sbin
| Toplevel
| Share
| Share_root
| Etc
| Doc
| Stublibs
| Man
| Misc
end

val exists: string list -> string -> bool
val site : package:string -> section:Section.t ->
suffix:string -> encoded:string -> Location.t list

val concat_paths: string list list -> string -> string
val ocamlpath: string -> string
val sourceroot: string -> string option

end
val path_sep: string

end
end
3 changes: 1 addition & 2 deletions otherlibs/sites_locations/test/run.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ Test embedding of sites locations information
> (public_name c)
> (promote (until-clean))
> (modules c sites)
> (libraries a c.register findlib.dynload dune-sites-locations))
> (libraries a c.register dune-sites-locations dune-sites-locations.plugins))
> (library
> (public_name c.register)
> (name c_register)
Expand All @@ -80,7 +80,6 @@ Test embedding of sites locations information
> | Some d -> Printf.printf "sourceroot is %S\n%!" d
> | None -> Printf.printf "no sourceroot\n%!"
> let () = List.iter (Printf.printf "c: %s\n%!") Sites.Sites.data
> let () = Sites.Plugins.init [Sites.Plugins.Plugins.paths] ()
> let () = Sites.Plugins.Plugins.load_all ()
> let () = Printf.printf "run c: b_registered:%b\n%!" !C_register.b_registered
> EOF
Expand Down
Loading

0 comments on commit ed18fa3

Please sign in to comment.