Add add_install_prefix function

To control installation prefix
This commit is contained in:
Jeremie Dimino 2017-12-21 19:39:24 +08:00 committed by Rudi Grinberg
parent 86dc606fef
commit afb602d7ef
2 changed files with 43 additions and 29 deletions

View File

@ -47,6 +47,35 @@ module Section = struct
; "man" , Man
; "misc" , Misc
]
module Paths = struct
let lib = Path.(relative root) "lib"
let libexec = Path.(relative root) "lib"
let bin = Path.(relative root) "bin"
let sbin = Path.(relative root) "sbin"
let toplevel = Path.(relative root) "lib/toplevel"
let share = Path.(relative root) "share"
let share_root = Path.(relative root) "share_root"
let etc = Path.(relative root) "etc"
let doc = Path.(relative root) "doc"
let stublibs = Path.(relative root) "lib/stublibs"
let man = Path.(relative root) "man"
end
let install_dir t ~package =
match t with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
| Toplevel -> Paths.toplevel
| Share_root -> Paths.share_root
| Stublibs -> Paths.stublibs
| Man -> Paths.man
| Lib -> Path.relative Paths.lib package
| Libexec -> Path.relative Paths.libexec package
| Share -> Path.relative Paths.share package
| Etc -> Path.relative Paths.etc package
| Doc -> Path.relative Paths.doc package
| Misc -> invalid_arg "Install.Section.install_dir"
end
module Entry = struct
@ -82,36 +111,8 @@ module Entry = struct
let set_src t src = { t with src }
module Paths = struct
let lib = Path.(relative root) "lib"
let libexec = Path.(relative root) "lib"
let bin = Path.(relative root) "bin"
let sbin = Path.(relative root) "sbin"
let toplevel = Path.(relative root) "lib/toplevel"
let share = Path.(relative root) "share"
let share_root = Path.(relative root) "share_root"
let etc = Path.(relative root) "etc"
let doc = Path.(relative root) "doc"
let stublibs = Path.(relative root) "lib/stublibs"
let man = Path.(relative root) "man"
end
let relative_installed_path t ~package =
let main_dir =
match t.section with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
| Toplevel -> Paths.toplevel
| Share_root -> Paths.share_root
| Stublibs -> Paths.stublibs
| Man -> Paths.man
| Lib -> Path.relative Paths.lib package
| Libexec -> Path.relative Paths.libexec package
| Share -> Path.relative Paths.share package
| Etc -> Path.relative Paths.etc package
| Doc -> Path.relative Paths.doc package
| Misc -> invalid_arg "Install.Entry.relative_installed_path"
in
let main_dir = Section.install_dir t.section ~package in
let dst =
match t.dst with
| Some x -> x
@ -126,6 +127,18 @@ module Entry = struct
| _ -> dst
in
Path.relative main_dir dst
let add_install_prefix t ~package ~prefix =
let opam_will_install_in_this_dir =
Section.install_dir t.section ~package
in
let i_want_to_install_the_file_as =
Path.append prefix (relative_installed_path t ~package)
in
let dst =
Path.reach i_want_to_install_the_file_as ~from:opam_will_install_in_this_dir
in
{ t with dst = Some dst }
end
module SMap = Map.Make(Section)

View File

@ -29,6 +29,7 @@ module Entry : sig
val set_src : t -> Path.t -> t
val relative_installed_path : t -> package:string -> Path.t
val add_install_prefix : t -> package:string -> prefix:Path.t -> t
end
val files : Entry.t list -> Path.Set.t