From 2f9d821acd376c964ead0c6f0a2730ac2c8719b0 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 26 Aug 2014 18:30:48 +0100 Subject: [PATCH 1/3] `opam search` now look in configurable locations. The list of search files can be set by changing OpamSearch.search_files (the default is to look for "findlib" files). $ cat ~/.opam/repo/platform/packages/opamfu/opamfu.42/findlib supercool $ opam search supercool -s opamfu --- src/client/opamClient.ml | 19 ++- src/core/opamFile.ml | 335 ++++++++++++++++++++------------------- src/core/opamFile.mli | 3 + src/core/opamGlobals.ml | 2 + src/core/opamGlobals.mli | 5 +- 5 files changed, 197 insertions(+), 167 deletions(-) diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 455cb544270..0b3eacb13ae 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -19,6 +19,7 @@ open OpamTypesBase open OpamState.Types open OpamMisc.OP open OpamPackage.Set.Op +open OpamFilename.OP let log fmt = OpamGlobals.log "CLIENT" fmt let slog = OpamGlobals.slog @@ -34,6 +35,7 @@ type package_details = { tags: string list; syntax: string list Lazy.t; libraries: string list Lazy.t; + others: string list Lazy.t; (* words in lines in files *) } let details_of_package t name versions = @@ -69,9 +71,19 @@ let details_of_package t name versions = if OpamState.eval_filter t ~opam OpamVariable.Map.empty filter then Some s else None) (OpamFile.OPAM.libraries opam)) in + let others = lazy ( + match OpamState.repository_and_prefix_of_package t nv with + | None -> [] + | Some (repo, prefix) -> + List.fold_left (fun acc filename -> + let file = OpamPath.Repository.packages repo prefix nv // filename in + let file = OpamFile.Lines.safe_read file in + List.flatten file @ acc + ) [] !OpamGlobals.search_files + ) in { name; current_version; installed_version; synopsis; descr; tags; - syntax; libraries } + syntax; libraries; others; } let details_of_package_regexps t packages ~exact_name ~case_sensitive regexps = log "names_of_regexp regexps=%a" @@ -118,7 +130,7 @@ let details_of_package_regexps t packages ~exact_name ~case_sensitive regexps = (* Filter the list of packages, depending on user predicates *) let packages_map = OpamPackage.Name.Map.filter - (fun name { synopsis; descr; tags; syntax; libraries } -> + (fun name { synopsis; descr; tags; syntax; libraries; others } -> regexps = [] || exact_match (OpamPackage.Name.to_string name) || not exact_name && @@ -127,7 +139,8 @@ let details_of_package_regexps t packages ~exact_name ~case_sensitive regexps = || partial_match (Lazy.force descr) || partial_matchs tags || partial_matchs (Lazy.force libraries) - || partial_matchs (Lazy.force syntax)) + || partial_matchs (Lazy.force syntax) + || partial_matchs (Lazy.force others)) ) packages_map in if not (OpamPackage.Set.is_empty packages) diff --git a/src/core/opamFile.ml b/src/core/opamFile.ml index 5cd0d09a355..adcb85caf23 100644 --- a/src/core/opamFile.ml +++ b/src/core/opamFile.ml @@ -18,141 +18,145 @@ open OpamTypes open OpamTypesBase open OpamMisc.OP -module Lines = struct +module X = struct - (* Lines of space separated words *) - type t = string list list - - let find_escapes s len = - let rec aux acc i = - if i < 0 then acc else - let acc = - match s.[i] with - | '\\' | ' ' | '\t' | '\n' -> - let esc,count = acc in - i::esc, count + 1 - | _ -> acc in - aux acc (i-1) in - aux ([],0) (len - 1) - - let escape_spaces str = - let len = String.length str in - match find_escapes str len with - | [], _ -> str - | escapes, n -> - let buf = String.create (len + n) in - let rec aux i = function - | ofs1::(ofs2::_ as r) -> - String.blit str ofs1 buf (ofs1+i) (ofs2-ofs1); - buf.[ofs2+i] <- '\\'; - aux (i+1) r - | [ofs] -> - String.blit str ofs buf (ofs+i) (len-ofs); - buf - | [] -> assert false - in - aux 0 (0::escapes) - - let of_channel ic = - OpamLineLexer.main (Lexing.from_channel ic) - - let to_string (lines: t) = - let buf = Buffer.create 1024 in - List.iter (fun l -> - (match l with - | [] -> () - | w::r -> - Buffer.add_string buf (escape_spaces w); - List.iter (fun w -> - Buffer.add_char buf ' '; - Buffer.add_string buf (escape_spaces w)) - r); - Buffer.add_string buf "\n" - ) lines; - Buffer.contents buf + module Lines = struct -end + (* Lines of space separated words *) + type t = string list list -module Syntax = struct - - type t = file - - let of_channel (filename:filename) (ic:in_channel) = - let lexbuf = Lexing.from_channel ic in - let filename = OpamFilename.to_string filename in - lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with - Lexing.pos_fname = filename }; - OpamParser.main OpamLexer.token lexbuf filename - - let to_string ignore (t: t) = - OpamFormat.string_of_file ~simplify:true ~indent:true ~ignore t - - let s_opam_version = "opam-version" - - let check ?(versioned=true) = - let not_already_warned = ref true in - fun f fields -> - if List.mem s_opam_version fields then - begin match OpamFormat.assoc_option f.file_contents s_opam_version - (OpamFormat.parse_string @> OpamVersion.of_string) with - | Some opam_version -> - if not !OpamGlobals.skip_version_checks && - OpamVersion.compare opam_version OpamVersion.current > 0 then - OpamGlobals.error_and_exit - "Your version of OPAM (%s) is not recent enough to read %s.\n\ - Upgrade to version %s or later to read this file." - (OpamVersion.to_string OpamVersion.current) - (OpamMisc.prettify_path f.file_name) - (OpamVersion.to_string opam_version) - | None -> - if versioned then ( - OpamGlobals.error - "%s is missing the opam-version field: syntax check failed." - (OpamMisc.prettify_path f.file_name); - OpamFormat.bad_format "opam-version" - ) - end; - if not (OpamFormat.is_valid f.file_contents fields) then - let invalids = OpamFormat.invalid_fields f.file_contents fields in - let too_many, invalids = List.partition (fun x -> List.mem x fields) invalids in - if too_many <> [] then - OpamGlobals.warning "duplicate fields in %s: %s" - f.file_name - (OpamMisc.string_of_list (fun x -> x) too_many); - if !OpamGlobals.strict then ( - if invalids <> [] then - (let are,s = match invalids with [_] -> "is an","" | _ -> "are","s" in - OpamGlobals.error "%s %s invalid field name%s in %s. Valid fields: %s\n\ - Either there is an error in the package, or your \ - OPAM is not up-to-date." - (OpamMisc.string_of_list (fun x -> x) invalids) - are s f.file_name - (OpamMisc.string_of_list (fun x -> x) fields)); - OpamGlobals.exit 5 - ) else if !not_already_warned then ( - not_already_warned := false; - let is_, s_ = - if List.length invalids <= 1 then "is an", "" else "are", "s" in - if invalids <> [] then - OpamGlobals.warning "%s %s unknown field%s in %s: is your OPAM up-to-date ?" - (OpamMisc.pretty_list invalids) - is_ s_ - f.file_name - ) + let empty = [] - let to_1_0 file = - let file_contents = List.map (function - | Variable (pos, v, _) as c -> - if v = s_opam_version then - Variable (pos,s_opam_version, OpamFormat.make_string "1") - else c - | c -> c - ) file.file_contents in - { file with file_contents; file_format = OpamVersion.of_string "1" } + let internal = "lines" + + let find_escapes s len = + let rec aux acc i = + if i < 0 then acc else + let acc = + match s.[i] with + | '\\' | ' ' | '\t' | '\n' -> + let esc,count = acc in + i::esc, count + 1 + | _ -> acc in + aux acc (i-1) in + aux ([],0) (len - 1) + + let escape_spaces str = + let len = String.length str in + match find_escapes str len with + | [], _ -> str + | escapes, n -> + let buf = String.create (len + n) in + let rec aux i = function + | ofs1::(ofs2::_ as r) -> + String.blit str ofs1 buf (ofs1+i) (ofs2-ofs1); + buf.[ofs2+i] <- '\\'; + aux (i+1) r + | [ofs] -> + String.blit str ofs buf (ofs+i) (len-ofs); + buf + | [] -> assert false + in + aux 0 (0::escapes) -end + let of_channel (_:filename) ic = + OpamLineLexer.main (Lexing.from_channel ic) -module X = struct + let to_string (_:filename) (lines: t) = + let buf = Buffer.create 1024 in + List.iter (fun l -> + (match l with + | [] -> () + | w::r -> + Buffer.add_string buf (escape_spaces w); + List.iter (fun w -> + Buffer.add_char buf ' '; + Buffer.add_string buf (escape_spaces w)) + r); + Buffer.add_string buf "\n" + ) lines; + Buffer.contents buf + + end + + module Syntax = struct + + type t = file + + let of_channel (filename:filename) (ic:in_channel) = + let lexbuf = Lexing.from_channel ic in + let filename = OpamFilename.to_string filename in + lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with + Lexing.pos_fname = filename }; + OpamParser.main OpamLexer.token lexbuf filename + + let to_string ignore (t: t) = + OpamFormat.string_of_file ~simplify:true ~indent:true ~ignore t + + let s_opam_version = "opam-version" + + let check ?(versioned=true) = + let not_already_warned = ref true in + fun f fields -> + if List.mem s_opam_version fields then + begin match OpamFormat.assoc_option f.file_contents s_opam_version + (OpamFormat.parse_string @> OpamVersion.of_string) with + | Some opam_version -> + if not !OpamGlobals.skip_version_checks && + OpamVersion.compare opam_version OpamVersion.current > 0 then + OpamGlobals.error_and_exit + "Your version of OPAM (%s) is not recent enough to read %s.\n\ + Upgrade to version %s or later to read this file." + (OpamVersion.to_string OpamVersion.current) + (OpamMisc.prettify_path f.file_name) + (OpamVersion.to_string opam_version) + | None -> + if versioned then ( + OpamGlobals.error + "%s is missing the opam-version field: syntax check failed." + (OpamMisc.prettify_path f.file_name); + OpamFormat.bad_format "opam-version" + ) + end; + if not (OpamFormat.is_valid f.file_contents fields) then + let invalids = OpamFormat.invalid_fields f.file_contents fields in + let too_many, invalids = List.partition (fun x -> List.mem x fields) invalids in + if too_many <> [] then + OpamGlobals.warning "duplicate fields in %s: %s" + f.file_name + (OpamMisc.string_of_list (fun x -> x) too_many); + if !OpamGlobals.strict then ( + if invalids <> [] then + (let are,s = match invalids with [_] -> "is an","" | _ -> "are","s" in + OpamGlobals.error "%s %s invalid field name%s in %s. Valid fields: %s\n\ + Either there is an error in the package, or your \ + OPAM is not up-to-date." + (OpamMisc.string_of_list (fun x -> x) invalids) + are s f.file_name + (OpamMisc.string_of_list (fun x -> x) fields)); + OpamGlobals.exit 5 + ) else if !not_already_warned then ( + not_already_warned := false; + let is_, s_ = + if List.length invalids <= 1 then "is an", "" else "are", "s" in + if invalids <> [] then + OpamGlobals.warning "%s %s unknown field%s in %s: is your OPAM up-to-date ?" + (OpamMisc.pretty_list invalids) + is_ s_ + f.file_name + ) + + let to_1_0 file = + let file_contents = List.map (function + | Variable (pos, v, _) as c -> + if v = s_opam_version then + Variable (pos,s_opam_version, OpamFormat.make_string "1") + else c + | c -> c + ) file.file_contents in + { file with file_contents; file_format = OpamVersion.of_string "1" } + + end module Prefix = struct @@ -162,8 +166,8 @@ module X = struct let empty = OpamPackage.Name.Map.empty - let of_channel _ ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in List.fold_left (fun map -> function | [] -> map | [nv;prefix] -> OpamPackage.Name.Map.add (OpamPackage.Name.of_string nv) @@ -174,12 +178,12 @@ module X = struct (String.concat " " s) ) OpamPackage.Name.Map.empty lines - let to_string _ s = + let to_string filename s = let lines = OpamPackage.Name.Map.fold (fun nv prefix l -> [OpamPackage.Name.to_string nv; prefix] :: l ) s [] in - Lines.to_string lines + Lines.to_string filename lines end @@ -191,8 +195,8 @@ module X = struct let empty = OpamFilename.Set.empty - let of_channel _ ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in let lines = OpamMisc.filter_map (function | [] -> None | [f] -> Some (OpamFilename.of_string f) @@ -201,12 +205,12 @@ module X = struct ) lines in OpamFilename.Set.of_list lines - let to_string _ s = + let to_string filename s = let lines = List.rev_map (fun f -> [OpamFilename.to_string f]) (OpamFilename.Set.elements s) in - Lines.to_string lines + Lines.to_string filename lines end @@ -218,8 +222,8 @@ module X = struct let empty = OpamFilename.Attribute.Set.empty - let of_channel _ ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in let rs = OpamMisc.filter_map (function | [] -> None | [s] -> (* backwards-compat *) @@ -229,12 +233,12 @@ module X = struct ) lines in OpamFilename.Attribute.Set.of_list rs - let to_string _ t = + let to_string filename t = let lines = List.rev_map (fun r -> OpamFilename.Attribute.to_string_list r) (OpamFilename.Attribute.Set.elements t) in - Lines.to_string lines + Lines.to_string filename lines end @@ -364,15 +368,15 @@ module X = struct let empty = (OpamPackage.Set.empty, OpamPackage.Set.empty, OpamPackage.Name.Map.empty) - let of_channel f ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in let state = function | "root" -> `Root | "noroot" | "installed" -> `Installed | "uninstalled" -> `Uninstalled | s -> OpamGlobals.error_and_exit "Invalid installation status (col. 3) in %s: %S" - (OpamFilename.to_string f) s + (OpamFilename.to_string filename) s in let add (installed,roots,pinned) n v state p = let name = OpamPackage.Name.of_string n in @@ -398,7 +402,7 @@ module X = struct add acc n v (state r) (Some (pin_kind_of_string pk,p)) | l -> OpamGlobals.error_and_exit "Invalid line in %s: %S" - (OpamFilename.to_string f) + (OpamFilename.to_string filename) (String.concat " " l) ) (OpamPackage.Set.empty, OpamPackage.Set.empty, OpamPackage.Name.Map.empty) @@ -446,8 +450,8 @@ module X = struct (OpamPackage.Name.to_string n) (OpamPackage.Version.Set.to_string vs) ) map - let of_channel name ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in let map,_ = List.fold_left (fun (map,i) -> function | [] -> map, i+1 @@ -460,7 +464,7 @@ module X = struct i+1 | s -> OpamGlobals.error "At %s:%d: skipped invalid line %S" - (OpamFilename.prettify name) i (String.concat " " s); + (OpamFilename.prettify filename) i (String.concat " " s); map, i+1 ) (empty,1) lines in map @@ -502,8 +506,8 @@ module X = struct let empty = A.Map.empty - let of_channel _ ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in List.fold_left (fun map -> function | [] | [_] -> map | a_s :: repos_s :: prefix -> @@ -519,7 +523,7 @@ module X = struct A.Map.add a (repo_name, prefix) map ) A.Map.empty lines - let to_string _ map = + let to_string filename map = let lines = A.Map.fold (fun nv (repo_name, prefix) lines -> let repo_s = OpamRepositoryName.to_string repo_name in let prefix_s = match prefix with @@ -527,7 +531,7 @@ module X = struct | Some p -> [p] in (A.to_string nv :: repo_s :: prefix_s) :: lines ) map [] in - Lines.to_string (List.rev lines) + Lines.to_string filename (List.rev lines) end @@ -543,8 +547,8 @@ module X = struct let empty = OpamPackage.Name.Map.empty - let of_channel _ ic = - let lines = Lines.of_channel ic in + let of_channel filename ic = + let lines = Lines.of_channel filename ic in let add name_s pin map = let name = OpamPackage.Name.of_string name_s in if OpamPackage.Name.Map.mem name map then @@ -560,7 +564,7 @@ module X = struct | _ -> OpamGlobals.error_and_exit "too many pinning options" ) OpamPackage.Name.Map.empty lines - let to_string _ map = + let to_string filename map = let lines = OpamPackage.Name.Map.fold (fun name pin lines -> let kind = kind_of_pin_option pin in let l = [ @@ -570,7 +574,7 @@ module X = struct ] in l :: lines ) map [] in - Lines.to_string (List.rev lines) + Lines.to_string filename (List.rev lines) end @@ -676,15 +680,15 @@ module X = struct let empty = OpamSwitch.Map.empty - let to_string _ t = + let to_string filename t = let l = OpamSwitch.Map.fold (fun switch compiler lines -> [OpamSwitch.to_string switch; OpamCompiler.to_string compiler] :: lines ) t [] in - Lines.to_string l + Lines.to_string filename l - let of_channel _ ic = - let l = Lines.of_channel ic in + let of_channel filename ic = + let l = Lines.of_channel filename ic in List.fold_left (fun map -> function | [] -> map | [switch; comp] -> OpamSwitch.Map.add (OpamSwitch.of_string switch) @@ -1952,9 +1956,9 @@ module Make (F : F) = struct let string_of_backtrace_list = function | [] | _ when not (Printexc.backtrace_status ()) -> "" | btl -> List.fold_left (fun s bts -> - let bt_lines = OpamMisc.split bts '\n' in - "\n Backtrace:\n "^(String.concat "\n " bt_lines)^s - ) "" btl + let bt_lines = OpamMisc.split bts '\n' in + "\n Backtrace:\n "^(String.concat "\n " bt_lines)^s + ) "" btl let read f = let filename = OpamFilename.prettify f in @@ -2022,6 +2026,11 @@ module type IO_FILE = sig val write_to_channel: out_channel -> t -> unit end +module Lines = struct + include Lines + include Make (Lines) +end + module Config = struct include Config include Make (Config) diff --git a/src/core/opamFile.mli b/src/core/opamFile.mli index 1ac507a2572..f7b417475e4 100644 --- a/src/core/opamFile.mli +++ b/src/core/opamFile.mli @@ -44,6 +44,9 @@ module type IO_FILE = sig end +(** Lines of space-separated words. *) +module Lines: IO_FILE with type t = string list list + (** Configuration file: [$opam/config] *) module Config: sig diff --git a/src/core/opamGlobals.ml b/src/core/opamGlobals.ml index 0137368cdcc..703d96a16a1 100644 --- a/src/core/opamGlobals.ml +++ b/src/core/opamGlobals.ml @@ -141,6 +141,8 @@ let get_external_solver () = let default_repository_name = "default" let default_repository_address = "https://opam.ocaml.org" +let search_files = ref ["findlib"] + let default_build_command = [ [ "./build.sh" ] ] let global_config = "global-config" diff --git a/src/core/opamGlobals.mli b/src/core/opamGlobals.mli index f23de348c99..6487caaabd6 100644 --- a/src/core/opamGlobals.mli +++ b/src/core/opamGlobals.mli @@ -56,7 +56,7 @@ val cudf_file : string option ref val solver_timeout : float type solver_criteria = [ `Default | `Upgrade | `Fixup ] -val default_preferences : solver_criteria -> string +val default_preferences : solver_criteria -> string val compat_preferences : solver_criteria -> string (** Solver preference bindings. Used with List.assoc: first one wins *) @@ -71,6 +71,9 @@ val get_external_solver : unit -> string val default_repository_name : string val default_repository_address : string + +val search_files: string list ref + (* val default_build_command : string list list *) val global_config : string val system : string From 07b4c7b15046715e47b67c34d8eb53f54a52cc0b Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 26 Aug 2014 23:42:48 +0100 Subject: [PATCH 2/3] Update `opam-admin` to infer the findlib file. Read the arguments of `ocamlfind remove` to populate the PKG/findlib file. We need a more robust function (which install the package) but that's already a good start. opam-repository$ opam-admin findlib --infer ocamlnet Processing (package) ocamlnet.3.2.1 Processing (package) ocamlnet.3.5.1 Processing (package) ocamlnet.3.6.0 Processing (package) ocamlnet.3.6.3 Processing (package) ocamlnet.3.6.5 Processing (package) ocamlnet.3.7.3 Processing (package) ocamlnet.3.7.4 Processing (package) ocamlnet.3.7.4-1 opam-repository$ $ cat packages/ocamlnet/ocamlnet.3.7.4-1/findlib equeue equeue-gtk2 equeue-ssl netcamlbox netcgi2 netcgi2-plex netclient netgssapi nethttpd nethttpd-for-netcgi2 netmech-scram netmulticore netplex netshm netstring netstring-pcre netsys netzip pop rpc rpc-auth-local rpc-generator rpc-ssl shell smtp --- src/Makefile | 2 +- src/scripts/opam_admin.ml | 10 ++-- src/scripts/opam_findlib.ml | 94 +++++++++++++++++++++++++++++ src/scripts/opam_libraries.ml | 108 ---------------------------------- 4 files changed, 100 insertions(+), 114 deletions(-) create mode 100644 src/scripts/opam_findlib.ml delete mode 100644 src/scripts/opam_libraries.ml diff --git a/src/Makefile b/src/Makefile index a87413c1566..cfffc1b4694 100644 --- a/src/Makefile +++ b/src/Makefile @@ -215,7 +215,7 @@ SRC_opam-admin = \ opam_repo_check.ml \ opam_stats.ml \ opam_depexts_change.ml \ - opam_libraries.ml \ + opam_findlib.ml \ opam_admin.ml define PROJ_opam-admin diff --git a/src/scripts/opam_admin.ml b/src/scripts/opam_admin.ml index 325451c4ae5..c77c71d0259 100644 --- a/src/scripts/opam_admin.ml +++ b/src/scripts/opam_admin.ml @@ -41,10 +41,10 @@ let depexts_cmd = Term.(Opam_depexts_change.(pure process $ args)), Term.info "depexts" ~doc -let library_cmd = - let doc = "Add library/syntax information." in - Term.(Opam_libraries.(pure process $ args)), - Term.info "libs" ~doc +let findlib_cmd = + let doc = "Add findlib information." in + Term.(Opam_findlib.(pure process $ args)), + Term.info "findlib" ~doc let () = try @@ -52,7 +52,7 @@ let () = Term.eval_choice ~catch:false default_cmd [ make_repo_cmd; check_repo_cmd; stats_cmd; - depexts_cmd; library_cmd + depexts_cmd; findlib_cmd ] with | `Error _ -> exit 2 diff --git a/src/scripts/opam_findlib.ml b/src/scripts/opam_findlib.ml new file mode 100644 index 00000000000..a73fcb89c42 --- /dev/null +++ b/src/scripts/opam_findlib.ml @@ -0,0 +1,94 @@ +(**************************************************************************) +(* *) +(* Copyright 2012-2013 OCamlPro *) +(* Copyright 2012 INRIA *) +(* *) +(* All rights reserved.This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 3.0 with linking *) +(* exception. *) +(* *) +(* OPAM is distributed in the hope that it will be useful, but WITHOUT *) +(* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *) +(* or FITNESS FOR A PARTICULAR PURPOSE.See the GNU General Public *) +(* License for more details. *) +(* *) +(**************************************************************************) + +(* Script to add findlib info *) +open OpamTypes +open OpamFilename.OP +open OpamMisc.OP + +module StringSet = OpamMisc.StringSet + +type args = { + opam_pkg: name; + findlib_pkgs: string list; + infer: bool; +} + +let package_name = + let parse str = + try `Ok (OpamPackage.Name.of_string str) + with Failure msg -> `Error msg + in + let print ppf pkg = + Format.pp_print_string ppf (OpamPackage.Name.to_string pkg) in + parse, print + +let args = + let open Cmdliner in + let infer = + let doc = "Infer the `findlib' file by looking at the contents of the \ + `remove` field." in + Arg.(value & flag & info ~doc ["infer"]) in + let findlib_pkgs = + let doc = "Findlib package name" in + Arg.(value & opt (list string) [] & info ["pkg"] ~doc + ~docv:"FINDLIB-PKGS") + in + let opam_pkg = + let doc = "OPAM package name" in + Arg.(required & pos 0 (some package_name) None & info [] ~doc + ~docv:"OPAM-PKG") + in + Term.(pure (fun infer findlib_pkgs opam_pkg -> + { infer; findlib_pkgs; opam_pkg } + ) $ infer $ findlib_pkgs $ opam_pkg) + +let process args = + let repo = OpamRepository.local (OpamFilename.cwd ()) in + + let packages = OpamRepository.packages_with_prefixes repo in + + OpamPackage.Map.iter (fun package prefix -> + let opam_f = OpamPath.Repository.opam repo prefix package in + let opam = OpamFile.OPAM.read opam_f in + let pkgname = OpamFile.OPAM.name opam in + if pkgname = args.opam_pkg then ( + OpamGlobals.msg "Processing (package) %s\n" (OpamPackage.to_string package); + let filename = OpamFilename.dirname opam_f // "findlib" in + let pkgs0 = + OpamFile.Lines.safe_read filename + |> List.flatten + |> StringSet.of_list + in + let pkgs1 = + if args.infer then ( + let cmds = OpamFile.OPAM.remove opam in + List.fold_left (fun acc (cmd: OpamTypes.command) -> + match fst cmd with + | (CString "ocamlfind",_) :: l -> + let pkgs = OpamMisc.filter_map (function + | CString s, _ -> Some s + | _ -> None + ) (List.tl l) in + StringSet.union acc (StringSet.of_list pkgs); + | _ -> acc + ) StringSet.empty cmds + ) else StringSet.of_list args.findlib_pkgs + in + let pkgs = StringSet.union pkgs0 pkgs1 in + let contents = List.map (fun x -> [x]) (StringSet.elements pkgs) in + OpamFile.Lines.write filename contents) + ) packages diff --git a/src/scripts/opam_libraries.ml b/src/scripts/opam_libraries.ml deleted file mode 100644 index a1aa47930db..00000000000 --- a/src/scripts/opam_libraries.ml +++ /dev/null @@ -1,108 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright 2012-2013 OCamlPro *) -(* Copyright 2012 INRIA *) -(* *) -(* All rights reserved.This file is distributed under the terms of the *) -(* GNU Lesser General Public License version 3.0 with linking *) -(* exception. *) -(* *) -(* OPAM is distributed in the hope that it will be useful, but WITHOUT *) -(* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *) -(* or FITNESS FOR A PARTICULAR PURPOSE.See the GNU General Public *) -(* License for more details. *) -(* *) -(**************************************************************************) - -(* Script to add library/syntax info *) -open OpamTypes - -module StringMap = OpamMisc.StringMap - -type args = { - pkg: name; - lib: filter option StringMap.t; - syntax: filter option StringMap.t; - infer: bool; -} - -let package_name = - let parse str = - try `Ok (OpamPackage.Name.of_string str) - with Failure msg -> `Error msg - in - let print ppf pkg = Format.pp_print_string ppf (OpamPackage.Name.to_string pkg) in - parse, print - -let args = - let open Cmdliner in - let infer = - let doc = "Infer the library list by looking at the contents of the \ - `remove` field." in - Arg.(value & flag & info ~doc ["infer"]) in - let lib = - let doc = "Library name" in - Arg.(value & opt_all string [] & info ["lib"] ~doc) - in - let syntax = - let doc = "Syntax extension name" in - Arg.(value & opt_all string [] & info ["syntax"] ~doc) - in - let pkg = - let doc = "OPAM package name" in - Arg.(required & pos 0 (some package_name) None & info [] ~doc) - in - Term.(pure (fun infer lib syntax pkg -> - let mk x = StringMap.of_list (List.map (fun l -> l, None) x) in - let lib = mk lib in - let syntax = mk syntax in - { infer; lib; syntax; pkg } - ) $ infer $ lib $ syntax $ pkg) - -let process args = - let repo = OpamRepository.local (OpamFilename.cwd ()) in - - let packages = OpamRepository.packages_with_prefixes repo in - - (** packages *) - OpamPackage.Map.iter (fun package prefix -> - let opam_f = OpamPath.Repository.opam repo prefix package in - let opam = OpamFile.OPAM.read opam_f in - let pkgname = OpamFile.OPAM.name opam in - if pkgname = args.pkg then begin - OpamGlobals.msg "Processing (package) %s\n" (OpamPackage.to_string package); - let merge x y = match x,y with - | None , None -> None - | Some x, None - | None , Some x -> Some x - | Some x, Some _ -> Some x in - let libs = StringMap.of_list (OpamFile.OPAM.libraries opam) in - let libs = StringMap.union merge args.lib libs in - let syntax = StringMap.of_list (OpamFile.OPAM.syntax opam) in - let syntax = StringMap.union merge args.syntax syntax in - - let libs = ref libs in - let syntax = ref syntax in - if args.infer then ( - let cmds = OpamFile.OPAM.remove opam in - List.iter (fun (cmd: OpamTypes.command) -> - match fst cmd with - | (CString "ocamlfind",_) :: l -> - let l = OpamMisc.filter_map (function - | CString s, _ -> Some s - | _ -> None - ) (List.tl l) in - let ss, ls = List.partition (OpamMisc.ends_with ~suffix:".syntax") l in - List.iter (fun l -> libs := StringMap.add l None !libs) ls; - List.iter (fun s -> syntax := StringMap.add s None !syntax) ss; - | _ -> () - ) cmds; - ); - - let libs = StringMap.bindings !libs in - let syntax = StringMap.bindings !syntax in - let opam = OpamFile.OPAM.with_libraries opam libs in - let opam = OpamFile.OPAM.with_syntax opam syntax in - OpamFile.OPAM.write opam_f opam; - end; - ) packages From 3d92f6ae7f3faf9a5436baf4063c3cd8fad05fd4 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Wed, 27 Aug 2014 00:32:58 +0100 Subject: [PATCH 3/3] Support arbitrary patterns in `opam-admin findlib [PATTERN]*` --- src/scripts/opam_findlib.ml | 53 ++++++++++++++++++++----------------- 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/src/scripts/opam_findlib.ml b/src/scripts/opam_findlib.ml index a73fcb89c42..f492a2d813c 100644 --- a/src/scripts/opam_findlib.ml +++ b/src/scripts/opam_findlib.ml @@ -22,20 +22,11 @@ open OpamMisc.OP module StringSet = OpamMisc.StringSet type args = { - opam_pkg: name; + opam_pkgs: string list; findlib_pkgs: string list; infer: bool; } -let package_name = - let parse str = - try `Ok (OpamPackage.Name.of_string str) - with Failure msg -> `Error msg - in - let print ppf pkg = - Format.pp_print_string ppf (OpamPackage.Name.to_string pkg) in - parse, print - let args = let open Cmdliner in let infer = @@ -47,26 +38,40 @@ let args = Arg.(value & opt (list string) [] & info ["pkg"] ~doc ~docv:"FINDLIB-PKGS") in - let opam_pkg = - let doc = "OPAM package name" in - Arg.(required & pos 0 (some package_name) None & info [] ~doc + let opam_pkgs = + let doc = "OPAM package pattern" in + Arg.(value & pos_all string [] & info [] ~doc ~docv:"OPAM-PKG") in - Term.(pure (fun infer findlib_pkgs opam_pkg -> - { infer; findlib_pkgs; opam_pkg } - ) $ infer $ findlib_pkgs $ opam_pkg) + Term.(pure (fun infer findlib_pkgs opam_pkgs -> + { infer; findlib_pkgs; opam_pkgs } + ) $ infer $ findlib_pkgs $ opam_pkgs) let process args = let repo = OpamRepository.local (OpamFilename.cwd ()) in - let packages = OpamRepository.packages_with_prefixes repo in - + let regexps = + List.map (fun pattern -> + if OpamPackage.Map.exists (fun pkg _ -> + OpamPackage.Name.to_string (OpamPackage.name pkg) = pattern + ) packages + then pattern ^ ".*" + else pattern + ) args.opam_pkgs + |> List.map (fun pattern -> Re.compile (Re_glob.globx pattern)) + in + let should_process package = match regexps with + | [] -> true + | _ -> + let str = OpamPackage.to_string package in + List.exists (fun re -> OpamMisc.exact_match re str) regexps + in OpamPackage.Map.iter (fun package prefix -> - let opam_f = OpamPath.Repository.opam repo prefix package in - let opam = OpamFile.OPAM.read opam_f in - let pkgname = OpamFile.OPAM.name opam in - if pkgname = args.opam_pkg then ( - OpamGlobals.msg "Processing (package) %s\n" (OpamPackage.to_string package); + if should_process package then ( + OpamGlobals.msg "Processing (package) %s\n" + (OpamPackage.to_string package); + let opam_f = OpamPath.Repository.opam repo prefix package in + let opam = OpamFile.OPAM.read opam_f in let filename = OpamFilename.dirname opam_f // "findlib" in let pkgs0 = OpamFile.Lines.safe_read filename @@ -90,5 +95,5 @@ let process args = in let pkgs = StringSet.union pkgs0 pkgs1 in let contents = List.map (fun x -> [x]) (StringSet.elements pkgs) in - OpamFile.Lines.write filename contents) + if contents <> [] then OpamFile.Lines.write filename contents) ) packages