Permalink
Browse files

[config] opam config -var VAR works

  • Loading branch information...
1 parent 1d35082 commit a97b6ffbd0dd24c1d9d0b80cc3ad70a3225aef19 @samoht samoht committed May 11, 2012
Showing with 350 additions and 163 deletions.
  1. +32 −28 src/client.ml
  2. +37 −38 src/file.ml
  3. +15 −9 src/file.mli
  4. +12 −5 src/file_format.ml
  5. +2 −0 src/globals.ml
  6. +7 −2 src/opam.ml
  7. +181 −58 src/types.ml
  8. +64 −23 src/types.mli
View
@@ -183,8 +183,8 @@ let indent_right s nb =
else
String.make nb ' ' ^ s
-let find_from_name name l =
- List.find_all (fun (n,_) -> n = name) l
+let find_package_from_name name set =
+ List.find(fun nv -> NV.name nv = name) (NV.Set.elements set)
let s_not_installed = "--"
@@ -585,40 +585,44 @@ let config request =
NV.Set.fold (fun nv l ->
let file = Path.C.config t.compiler (NV.name nv) in
(nv, FC.safe_read file) :: l
- ) t.available [] in
+ ) t.installed [] in
let variables =
List.fold_left (fun accu (nv, c) ->
let name = NV.name nv in
+ (* add all the global variables *)
let globals =
List.fold_left (fun accu v ->
- (name, None, v, FC.variable c v) :: accu
+ (Full_variable.create_global name v, FC.variable c v) :: accu
) accu (FC.variables c) in
- let local accu available vars var =
- List.fold_left
- (fun accu n ->
- let variables = vars c n in
- List.fold_left (fun accu v ->
- (name, Some n, v, var c n v) :: accu
- ) accu variables
- ) accu (available c) in
- local
- (local globals
- FC.Library.available
- FC.Library.variables
- FC.Library.variable)
- FC.Syntax.available
- FC.Syntax.variables
- FC.Syntax.variable
+ (* then add the local variables *)
+ List.fold_left
+ (fun accu n ->
+ let variables = FC.Sections.variables c n in
+ List.fold_left (fun accu v ->
+ (Full_variable.create_local name n v, FC.Sections.variable c n v) :: accu
+ ) accu variables
+ ) globals (FC.Sections.available c)
) [] configs in
- List.iter (fun (name, lib, v, x) ->
- let lib = match lib with
- | None -> ""
- | Some l -> "." ^ l in
- Globals.msg "{%s%s}%s = %s\n"
- (N.to_string name) lib
- (Variable.to_string v)
- (string_of_variable_contents x)
+ List.iter (fun (fv, contents) ->
+ Globals.msg "%-20s : %s\n"
+ (Full_variable.to_string fv)
+ (string_of_variable_contents contents)
) (List.rev variables)
+ | Variable v ->
+ let name = Full_variable.package v in
+ let var = Full_variable.variable v in
+ let _nv =
+ try find_package_from_name name t.installed
+ with Not_found ->
+ Globals.error_and_exit "Package %s is not installed" (N.to_string name) in
+ let c = FC.safe_read (Path.C.config t.compiler name) in
+ let contents =
+ try match Full_variable.section v with
+ | None -> FC.variable c var
+ | Some s -> FC.Sections.variable c s var
+ with Not_found ->
+ Globals.error_and_exit "%s is not defined" (Full_variable.to_string v) in
+ Globals.msg "%s\n" (string_of_variable_contents contents)
| _ -> failwith "TODO"
(*
View
@@ -469,9 +469,11 @@ module Dot_config = struct
let s str = S str
let b bool = B bool
+ type section = Types.section
- type section = {
- name : string ;
+ type s = {
+ name : section;
+ kind : string ;
includes : string list ;
bytecomp : string list ;
asmcomp : string list ;
@@ -481,14 +483,12 @@ module Dot_config = struct
}
type t = {
- libraries: section list;
- syntax : section list;
+ sections : s list;
variables: (variable * variable_contents) list;
}
let empty = {
- libraries = [];
- syntax = [];
+ sections = [];
variables = [];
}
@@ -513,36 +513,34 @@ module Dot_config = struct
(parse_string |> s);
(parse_bool |> b);
] in
- let parse_section s =
- let name = s.File_format.name in
+ let parse_variables items =
+ let l = List.filter (fun (x,_) -> not (List.mem x valid_fields)) (variables items) in
+ List.map (fun (k,v) -> Variable.of_string k, parse_value v) l in
+ let parse_section kind s =
+ let name = Section.of_string s.File_format.name in
let includes = assoc_string_list s.items s_includes in
let bytecomp = assoc_string_list s.items s_bytecomp in
let asmcomp = assoc_string_list s.items s_asmcomp in
let bytelink = assoc_string_list s.items s_bytecomp in
let asmlink = assoc_string_list s.items s_asmlink in
- let lvariables =
- List.filter (fun (x,_) -> not (List.mem x valid_fields)) (variables s.items) in
- let lvariables =
- List.map (fun (k,v) -> Variable.of_string k, parse_value v) lvariables in
- { name; includes; bytecomp; asmcomp; bytelink; asmlink; lvariables } in
- let libraries = assoc_sections file.contents "library" parse_section in
- let syntax = assoc_sections file.contents "syntax" parse_section in
- let variables =
- List.map
- (fun (k,v) -> Variable.of_string k, parse_value v)
- (variables file.contents) in
- { libraries; syntax; variables }
+ let lvariables = parse_variables s.items in
+ { name; kind; includes; bytecomp; asmcomp; bytelink; asmlink; lvariables } in
+ let libraries = assoc_sections file.contents "library" (parse_section "library") in
+ let syntax = assoc_sections file.contents "syntax" (parse_section "syntax") in
+ let sections = libraries @ syntax in
+ let variables = parse_variables file.contents in
+ { sections; variables }
let rec to_string filename t =
let of_value = function
| B b -> Bool b
| S s -> String s in
let of_variables l =
List.map (fun (k,v) -> Variable (Variable.to_string k, of_value v)) l in
- let of_section kind s =
+ let of_section s =
Section
- { File_format.kind;
- name = s.name;
+ { File_format.name = Section.to_string s.name;
+ kind = s.kind;
items = [
Variable (s_includes, make_list make_string s.includes);
Variable (s_bytecomp, make_list make_string s.bytecomp);
@@ -551,37 +549,36 @@ module Dot_config = struct
Variable (s_asmlink , make_list make_string s.asmlink);
] @ of_variables s.lvariables
} in
- let of_library l = of_section "library" l in
- let of_syntax s = of_section "syntax" s in
Syntax.to_string filename {
filename = Filename.to_string filename;
contents =
of_variables t.variables
- @ List.map of_library t.libraries
- @ List.map of_syntax t.syntax
+ @ List.map of_section t.sections
}
let variables t = List.map fst t.variables
let variable t s = List.assoc s t.variables
module type SECTION = sig
- val available: t -> string list
- val includes : t -> string -> string list
- val asmcomp : t -> string -> string list
- val bytecomp : t -> string -> string list
- val asmlink : t -> string -> string list
- val bytelink : t -> string -> string list
- val variable : t -> string -> variable -> variable_contents
- val variables: t -> string -> variable list
+ val available: t -> section list
+ val kind : t -> section -> string
+ val includes : t -> section -> string list
+ val asmcomp : t -> section -> string list
+ val bytecomp : t -> section -> string list
+ val asmlink : t -> section -> string list
+ val bytelink : t -> section -> string list
+ val variable : t -> section -> variable -> variable_contents
+ val variables: t -> section -> variable list
end
- module Section (M : sig val get : t -> section list end) : SECTION = struct
+ module MK (M : sig val get : t -> s list end) : SECTION = struct
let find t name =
List.find (fun s -> s.name = name) (M.get t)
let available t = List.map (fun s -> s.name) (M.get t)
+ let kind t s = (find t s).kind
let includes t s = (find t s).includes
let bytecomp t s = (find t s).bytecomp
let asmcomp t s = (find t s).asmcomp
@@ -591,8 +588,10 @@ module Dot_config = struct
let variables t n = List.map fst (find t n).lvariables
end
- module Library = Section (struct let get t = t.libraries end)
- module Syntax = Section (struct let get t = t.syntax end)
+ let filter t n = List.filter (fun s -> s.kind = n) t.sections
+ module Library = MK (struct let get t = filter t "library" end)
+ module Syntax = MK (struct let get t = filter t "syntax" end)
+ module Sections = MK (struct let get t = t.sections end)
end
end
View
@@ -123,31 +123,37 @@ module Dot_config: sig
module type SECTION = sig
(** List the available sections *)
- val available: t -> string list
-
+ val available: t -> section list
+
+ (** Return the section kind *)
+ val kind: t -> section -> string
+
(** Return the list of included directory for a given section *)
- val includes: t -> string -> string list
+ val includes: t -> section -> string list
(** Return the list of native-compiler options *)
- val asmcomp: t -> string -> string list
+ val asmcomp: t -> section -> string list
(** Return the list of bytecode-compiler options *)
- val bytecomp: t -> string -> string list
+ val bytecomp: t -> section -> string list
(** Return the list of native-code linking options *)
- val asmlink: t -> string -> string list
+ val asmlink: t -> section -> string list
(** Return the list of bytecode linking options *)
- val bytelink: t -> string -> string list
+ val bytelink: t -> section -> string list
(** Return the value of variables *)
- val variable: t -> string -> variable -> variable_contents
+ val variable: t -> section -> variable -> variable_contents
(** The list of local variables *)
- val variables: t -> string -> variable list
+ val variables: t -> section -> variable list
end
+ (** All library and syntax sections *)
+ module Sections: SECTION
+
(** Sections starting by [library] *)
module Library: SECTION
View
@@ -169,13 +169,20 @@ let rec string_of_value = function
and string_of_values l =
String.concat " " (List.map string_of_value l)
-let rec string_of_item = function
- | Variable (i, v) -> Printf.sprintf "%s: %s" i (string_of_value v)
+let incr tab = " " ^ tab
+
+let rec string_of_item_aux tab = function
+ | Variable (i, v) -> Printf.sprintf "%s%s: %s" tab i (string_of_value v)
| Section s ->
- Printf.sprintf "%s %S {\n%s\n}" s.kind s.name (string_of_items s.items)
+ Printf.sprintf "%s%s %S {\n%s\n}"
+ tab s.kind s.name
+ (string_of_items_aux (incr tab) s.items)
+
+and string_of_items_aux tab is =
+ String.concat "\n" (List.map (string_of_item_aux tab) is)
-and string_of_items is =
- String.concat "\n" (List.map string_of_item is)
+let string_of_item = string_of_item_aux ""
+let string_of_items = string_of_items_aux ""
let string_of_file f = string_of_items f.contents
View
@@ -26,6 +26,8 @@ let default_repository_kind = "rsync"
let default_build_command = [ [ "./build.sh" ] ]
+let default_package = "conf-ocaml"
+
let opam_version = "1"
let home = Unix.getenv "HOME"
View
@@ -110,7 +110,8 @@ let specs = [
("-asmcomp" , Arg.Unit (set `Asmcomp) , " Display native link options");
("-bytelink" , Arg.Unit (set `Bytelink), " Display bytecode link options");
("-asmlink" , Arg.Unit (set `Asmlink) , " Display native link options");
- ("-list-vars", Arg.Unit (set `ListVars), " Display the list of variables");
+ ("-list-vars", Arg.Unit (set `ListVars), " Display the contents of all available variables");
+ ("-var" , Arg.Unit (set `Var) , " Display the content of a variable");
]
let args n =
(* XXX: big hack *)
@@ -137,7 +138,11 @@ let config = {
| Some `Bytelink -> mk (Bytelink (List.map args names))
| Some `Asmcomp -> mk (Asmcomp (List.map args names))
| Some `Asmlink -> mk (Asmlink (List.map args names))
- | Some `ListVars -> List_vars in
+ | Some `ListVars -> List_vars
+ | Some `Var when List.length names = 1
+ -> Variable (Full_variable.of_string (List.hd names))
+ | Some `Var ->
+ bad_argument "config" "-var takes exactly one parameter" in
Client.config config
}
Oops, something went wrong.

0 comments on commit a97b6ff

Please sign in to comment.