Skip to content
Browse files

New format for user provided files

Tests work
  • Loading branch information...
1 parent b1c2162 commit 1bcaf572ede9ca4aa4ec731a5b524528163718fc @samoht samoht committed
View
18 Makefile
@@ -22,11 +22,21 @@ opt: ./_obuild/unixrun
link: ocp-get ocp-get-server
@
-ocp-get:
- ln -s _obuild/ocp-get/ocp-get.asm ocp-get
+ocp-get: _obuild/ocp-get/ocp-get.asm
+ if [ ! -e $^]; then \
+ ln -s $^ ocp-get; \
+ fi
-ocp-get-server:
- ln -s _obuild/ocp-get-server/ocp-get-server.asm ocp-get-server
+_obuild/ocp-get-server/ocp-get-server.asm:
+ ocp-build ocp-get-server
+
+_obuild/ocp-get/ocp-get.asm:
+ ocp-build ocp-get
+
+ocp-get-server: _obuild/ocp-get-server/ocp-get-server.asm
+ if [ ! -f $^]; then \
+ ln -s $^ ocp-get-server; \
+ fi
compile: ./_obuild/unixrun clone
$(OCPBUILD) -init -scan -sanitize $(TARGET)
View
3 ocp-get.ocp
@@ -169,6 +169,9 @@ begin library "ocp-get-lib"
comp += [ "-annot" ]
files = [
"globals.ml"
+ "file_format.ml"
+ "lexer.mll"
+ "parser.mly"
"namespace.ml"
"path.ml"
"file.ml"
View
165 src/client.ml
@@ -17,7 +17,7 @@ sig
(** Displays the installed package. [None] : a general summary is given. *)
val info : Namespace.name option -> unit
- type config_request = Dir | Bytelink | Asmlink
+ type config_request = Include | Bytelink | Asmlink
(** Depending on request, returns options or directories where the package is installed. *)
val config : bool (* true : recursive search *) -> config_request -> Namespace.name -> unit
@@ -58,7 +58,7 @@ module Client : CLIENT = struct
let packages = RemoteServer.getList t.server in
List.iter
(fun (n, v) ->
- let opam_file = Path.index_opam t.home (Some (n, v)) in
+ let opam_file = Path.index t.home (Some (n, v)) in
if not (Path.file_exists opam_file) then
let opam = RemoteServer.getOpam t.server (n, v) in
Path.add opam_file (Path.File opam);
@@ -73,7 +73,7 @@ module Client : CLIENT = struct
let home = Path.init !Globals.root_path in
let config =
File.Config.create
- (Version Globals.opam_version)
+ Globals.api_version
url
(Version Globals.ocaml_version) in
File.Config.add (Path.config home) config;
@@ -106,16 +106,19 @@ module Client : CLIENT = struct
List.fold_left
(fun (map, max_n, max_v) n_v ->
let b = NV_set.mem n_v install_set in
- let opam = File.Opam.find_err (Path.index_opam t.home (Some n_v)) in
- let new_map = NV_map.add n_v (b, File.Opam.description opam) map in
+ let opam = File.Spec.find_err (Path.index t.home (Some n_v)) in
+ let new_map = NV_map.add n_v (b, File.Spec.description opam) map in
let new_max_n = max max_n (String.length (Namespace.string_user_of_name (fst n_v))) in
let new_max_v =
if b then max max_v (String.length (Namespace.string_user_of_version (snd n_v))) else max_v in
new_map, new_max_n, new_max_v)
(NV_map.empty, min_int, String.length s_not_installed)
- (Path.index_opam_list t.home) in
+ (Path.index_list t.home) in
- NV_map.iter (fun n_v (b, description) ->
+ NV_map.iter (fun n_v (b, description) ->
+ let description = match description with
+ | [] -> ""
+ | h::_ -> h in
Globals.msg "%s %s %s\n"
(indent_left (Namespace.string_user_of_name (fst n_v)) max_n)
(indent_right (if b then Namespace.string_user_of_version (snd n_v) else s_not_installed) max_v)
@@ -132,7 +135,7 @@ module Client : CLIENT = struct
let v_set =
let v_set =
- match find_from_name (Path.index_opam_list t.home) with
+ match find_from_name (Path.index_list t.home) with
| None -> V_set.empty
| Some v -> v in
match o_v with
@@ -154,8 +157,8 @@ module Client : CLIENT = struct
match o_v with None -> ""
| Some v ->
let opam =
- File.Opam.find_err (Path.index_opam t.home (Some (name, v))) in
- File.Opam.description opam
+ File.Spec.find_err (Path.index t.home (Some (name, v))) in
+ (String.concat "." (File.Spec.description opam))
]
let confirm msg =
@@ -182,7 +185,7 @@ module Client : CLIENT = struct
List.iter (add_rec Path.lib t) (File.To_install.lib to_install);
(* bin *)
- BatOption.iter (add_rec (fun t _ -> Path.bin t) t) (File.To_install.bin to_install);
+ List.iter (add_rec (fun t _ -> Path.bin t) t) (File.To_install.bin to_install);
(* misc *)
List.iter
@@ -217,7 +220,8 @@ module Client : CLIENT = struct
if Path.exec_buildsh t.home nv = 0 then
iter_toinstall Path.add_rec t nv
else
- Globals.error_and_exit "./build.sh failed. We stop here because otherwise the installation would fail to copy not created files."
+ Globals.error_and_exit
+ "./build.sh failed. We stop here because otherwise the installation would fail to copy not created files."
let delete_or_update l =
let action = function
@@ -244,9 +248,9 @@ module Client : CLIENT = struct
let debpkg_of_nv t map_installed =
List.fold_left
(fun l n_v ->
- let opam = File.Opam.find_err (Path.index_opam t.home (Some n_v)) in
+ let opam = File.Spec.find_err (Path.index t.home (Some n_v)) in
let pkg =
- File.Opam.package opam
+ File.Spec.to_package opam
(match N_map.Exceptionless.find (fst n_v) map_installed with
| Some v -> v = snd n_v
| _ -> false) in
@@ -308,7 +312,7 @@ module Client : CLIENT = struct
let install name =
log "install %s" (Namespace.string_of_name name);
let t = load_state () in
- let l_index = Path.index_opam_list t.home in
+ let l_index = Path.index_list t.home in
match find_from_name name l_index with
| None -> unknown_package name
| Some v ->
@@ -330,7 +334,7 @@ module Client : CLIENT = struct
| None -> unknown_package name
| Some v -> ("=", v.Namespace.deb) in
resolve t
- (Path.index_opam_list t.home)
+ (Path.index_list t.home)
installed
{ Solver.wish_install = []
; wish_remove = [ Namespace.string_of_name name, Some v ]
@@ -339,7 +343,7 @@ module Client : CLIENT = struct
let upgrade () =
log "upgrade";
let t = load_state () in
- let l_index = Path.index_opam_list t.home in
+ let l_index = Path.index_list t.home in
let installed = File.Installed.find_map (Path.installed t.home) in
resolve t
l_index
@@ -362,10 +366,10 @@ module Client : CLIENT = struct
let t = load_state () in
(* Get the current package version *)
- let opam_filename = name ^ ".opam" in
+ let opam_filename = name ^ ".spec" in
let opam_binary = U.read_content opam_filename in
- let opam = File.Opam.parse opam_binary in
- let version = File.Opam.version opam in
+ let opam = File.Spec.parse opam_binary in
+ let version = File.Spec.version opam in
let opam = binary opam_binary in
(* look for the archive *)
@@ -399,88 +403,59 @@ module Client : CLIENT = struct
| None -> Globals.msg "The key given to upload was not accepted.\n"
| _ -> ignore "The server has returned the same key than currently stored.\n"
- type config_request = Dir | Bytelink | Asmlink
+ type config_request = Include | Bytelink | Asmlink
let config is_rec req name =
log "config %s" (Namespace.string_of_name name);
let t = load_state () in
- let l_index = Path.index_opam_list t.home in
+ let l_index = Path.index_list t.home in
- let f_is_rec f_true f_false =
- let installed = File.Installed.find_map (Path.installed t.home) in
+ let installed = File.Installed.find_map (Path.installed t.home) in
+ let version =
match N_map.Exceptionless.find name installed with
- | None -> unknown_package name
- | Some version ->
-
- if is_rec then
- let l_deb = debpkg_of_nv t installed l_index in
- f_true
- (Solver.filter_dependencies
- (List.find
- (fun pkg ->
- Namespace.Name pkg.Debian.Packages.name = name
- &&
- pkg.Debian.Packages.version = version.Namespace.deb)
- l_deb)
+ | None -> unknown_package name
+ | Some v -> v in
+
+ let one name =
+ let path = match Path.ocaml_options_of_library t.home name with I s -> s in
+ match req with
+ | Include ->Globals.msg "-I %s " path
+ | link ->
+ let config = File.PConfig.find_err (Path.descr t.home (name, version)) in
+ let libraries = File.PConfig.library_names config in
+ let link_options = File.PConfig.link_options config in
+ let asmlink_options = File.PConfig.link_options config in
+ let bytelink_options = File.PConfig.link_options config in
+ let options o = String.concat " " o in
+ let files ext = String.concat " " (List.map (fun f -> f ^ ext) libraries) in
+ match link with
+ | Asmlink ->
+ Globals.msg "-I %s %s %s "
+ path
+ (options (link_options@asmlink_options))
+ (files ".cmxa")
+ | Bytelink ->
+ Globals.msg "-I %s %s %s "
+ path
+ (options (link_options@bytelink_options))
+ (files ".cma")
+ | _ -> assert false in
+
+ if not is_rec then
+ one name
+ else
+ let l_deb = debpkg_of_nv t installed l_index in
+ let dependencies =
+ Solver.filter_dependencies
+ (List.find
+ (fun pkg ->
+ Namespace.Name pkg.Debian.Packages.name = name
+ && pkg.Debian.Packages.version = version.Namespace.deb)
l_deb)
- else
- f_false version in
-
- match find_from_name name l_index, req with
-
- | None, _ ->
- Globals.msg
- "Package \"%s\" not found. An update of package will be performed.\n"
- (Namespace.string_user_of_name name);
- if confirm "Confirm ?" then
- update_t t
-
- | Some _, Dir ->
- f_is_rec
- (fun l ->
- Globals.msg "%s"
- (BatIO.to_string
- (let i = "-I " in
- BatList.print ~first:i ~last:"" ~sep:(" " ^ i) BatString.print)
- (List.map
- (fun pkg -> match Path.ocaml_options_of_library t.home (Namespace.Name pkg.Debian.Packages.name) with I s -> s)
- l)))
- (fun _ ->
- Globals.msg "%s"
- (match Path.ocaml_options_of_library t.home name with I s -> s))
-
- | _ ->
- let display name version =
- let l_f, s_cma =
- match req with
- | Bytelink -> [ File.Descr.link ], ".cma"
- | Asmlink -> [ File.Descr.link ; File.Descr.asmlink ], ".cmxa"
- | Dir -> assert false in
- let descr = File.Descr.find_err (Path.descr t.home (name, version)) in
-
- List.flatten (List.map (fun f -> f descr) l_f),
- File.Descr.library descr ^ s_cma in
-
- f_is_rec
- (fun l ->
- let l_opt, l_cma =
- List.split (List.map (fun pkg -> display (Namespace.Name pkg.Debian.Packages.name) { Namespace.deb = pkg.Debian.Packages.version }) l) in
- Globals.msg "%s %s"
- (String.concat " " (List.flatten l_opt))
- (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:" " BatString.print) l_cma))
- (fun version ->
- let l, s_cma = display name version in
- Globals.msg "%s %s" (String.concat " " l) s_cma)
+ l_deb in
+ let dependencies =
+ List.map (fun pkg -> Namespace.Name pkg.Debian.Packages.name) dependencies in
+ List.iter one dependencies
end
-
-
-
-
-
-
-
-
-
-
View
359 src/file.ml
@@ -2,6 +2,7 @@ open ExtString
open ExtList
open Namespace
open Path
+open File_format
type ('a, 'b) text =
| Parsed of 'a
@@ -37,8 +38,9 @@ struct
aux
let assoc_parsed = assoc (fun v _ -> v)
+(*
let assoc_all = assoc (fun v xs -> v :: BatList.takewhile_map (function Raw x -> Some x | Parsed _ -> None) xs)
-
+*)
let map_parsed f =
List.map
(function
@@ -48,7 +50,7 @@ struct
module Exceptionless =
struct
let assoc_parsed k l = try Some (assoc_parsed k l) with Not_found -> None
- let assoc_all k l = try Some (assoc_all k l) with Not_found -> None
+(* let assoc_all k l = try Some (assoc_all k l) with Not_found -> None *)
let assoc_def def k l =
match assoc_parsed k l with
@@ -99,12 +101,12 @@ struct
val version_of_string : string -> internal_version
(** destruct *)
- val opam_version : t -> internal_version
+ val opam_version : t -> int
val sources : t -> url
val ocaml_version : t -> internal_version
(** construct *)
- val create : internal_version (* opam *) -> url -> internal_version (* ocaml *) -> t
+ val create : int (* opam *) -> url -> internal_version (* ocaml *) -> t
end
module Config : CONFIG =
@@ -112,7 +114,7 @@ struct
let internal_name = "config"
type t =
- { version : internal_version (* opam version *)
+ { version : int (* opam version *)
; sources : url
; ocaml_version : internal_version }
@@ -125,20 +127,30 @@ struct
let create version sources ocaml_version = { version ; sources ; ocaml_version }
let empty = {
- version = Version Globals.version;
+ version = Globals.api_version;
sources = url Globals.default_hostname Globals.default_port ;
ocaml_version = Version Sys.ocaml_version
}
- let to_string t =
- Printf.sprintf "version: %s\nsources: %s\nocaml-version: %s\n"
- (match t.version with Version s -> s)
+ let to_string t =
+ Printf.sprintf "version: %d\nsources: %s\nocaml-version: %s\n"
+ t.version
(string_of_url t.sources)
(match t.ocaml_version with Version s -> s)
let parse contents =
let file = Parse.colon contents in
- let version = Parse.Exceptionless.assoc_def Globals.opam_version "version" file in
+ let version = match Parse.Exceptionless.assoc_parsed "version" file with
+ | None ->
+ Globals.error_and_exit
+ "Fatal error: Missing field 'version' in %s/config. Exit."
+ !Globals.root_path
+ | Some v ->
+ try int_of_string v
+ with _ ->
+ Globals.error_and_exit
+ "Fatal error: invalid value for 'version' field in %s/config. Exit"
+ !Globals.root_path in
let sources =
try
let sources = Parse.assoc_parsed "sources" file in
@@ -147,7 +159,7 @@ struct
with _ ->
url Globals.default_hostname Globals.default_port in
let ocaml_version = try Parse.assoc_parsed "ocaml-version" file with Not_found -> Sys.ocaml_version in
- { version = Version version
+ { version = version
; sources
; ocaml_version = Version ocaml_version }
end
@@ -163,21 +175,25 @@ struct
val packages: t -> Cudf.package list
end
- module type OPAM = sig
+ module type SPEC = sig
include IO_FILE
(** destruct *)
- val opam_version : t -> internal_version
- val version : t -> Namespace.version
- val package : t -> bool (* true : installed *) -> Debian.Packages.package
- val description : t -> string
+ val name : t -> string
+ val version : t -> Namespace.version
+
+ (** Returns the list of sentences *)
+ val description : t -> string list
+
+ (** Convert to Debian packages to feed the solver *)
+ val to_package : t -> bool (* true : installed *) -> Debian.Packages.package
- (** construct *)
end
- module Opam : OPAM = struct
+ module Spec : SPEC = struct
- let internal_name = "opam"
+ let internal_name = "spec"
+ let log = Globals.log internal_name
module D = struct
module D = Debian.Packages
@@ -195,66 +211,86 @@ struct
open BatMap
type t = {
- opam_version : internal_version ;
- version : Namespace.version ;
- list_stanza : (string * string, string) text list ;
+ name : string;
+ version : string;
+ description: string list;
+ fields : (string * string) list;
}
- let empty = { opam_version = Version "" ; version = { deb = "" } ; list_stanza = [] }
+ let empty = {
+ name = "<none>";
+ version = "<none>";
+ description = ["empty package"];
+ fields = [];
+ }
- let opam_version t = t.opam_version
- let version t = t.version
-
let s_description = "description"
- let s_user_version = "version"
- let s_opam_version = "opam-version"
- let s_package = "package"
- let s_installed = "status" (* see [Debcudf.add_inst] for more details about the format *)
- let s_installed_true = " installed" (* see [Debcudf.add_inst] for more details about the format *)
- let s_depends = "depends"
- let s_conflicts = "conflicts"
-
- let description t =
- BatIO.to_string
- (BatList.print ~first:"" ~last:"" ~sep:"\n" BatString.print)
- (match Parse.Exceptionless.assoc_all s_description t.list_stanza with
- | None -> []
- | Some l -> l)
-
- let default_package t =
- let assoc f s =
- match Parse.Exceptionless.assoc_parsed s t.list_stanza with
- | None -> []
- | Some l -> f l in
+ let s_version = "version"
+ let s_status = "status" (* see [Debcudf.add_inst] for more details about the format *)
+ let s_installed = " installed" (* see [Debcudf.add_inst] for more details about the format *)
+ let s_depends = "depends"
+ let s_conflicts = "conflicts"
+
+ let description t = t.description
+ let name t = t.name
+ let version t = {deb = t.version}
+
+ let default_package (t:t) =
+ let assoc f s =
+ try f (List.assoc s t.fields)
+ with Not_found -> [] in
{ D.default_package with
- D.name = Parse.assoc_parsed s_package t.list_stanza ;
- D.version = t.version.deb ;
- D.extras = [ s_description, description t ] ;
- D.depends = assoc D.parse_vpkgformula s_depends ;
+ D.name = t.name ;
+ D.version = t.version ;
+ D.extras = [] ;
+ D.depends = assoc D.parse_vpkgformula s_depends ;
D.conflicts = assoc D.parse_vpkglist s_conflicts }
- let package t installed =
+ let to_package t installed =
let p = default_package t in
if installed then
- { p with D.extras = (s_installed, s_installed_true) :: p.D.extras }
+ { p with D.extras = (s_status, s_installed) :: p.D.extras }
else
p
+ let to_string t =
+ let pf (k, v) = Printf.sprintf " %s = %S\n" k v in
+ Printf.sprintf "@%d\n\npackage %S {\n%s}\n"
+ Globals.api_version t.name
+ (String.concat "" (List.map pf t.fields))
+
let parse str =
- let list_stanza = Parse.colon str in
- { opam_version = Version (Parse.Exceptionless.assoc_def Globals.version s_opam_version list_stanza)
- ; version = Namespace.version_of_string (Parse.assoc_parsed s_user_version list_stanza)
- ; list_stanza }
+ let lexbuf = Lexing.from_string str in
+ let file = Parser.main Lexer.token lexbuf in
+ if file.File_format.version <> Globals.api_version then
+ Globals.error_and_exit "Incompatible software versions";
+ let statement = match file.statements with
+ | [s] -> s
+ | [] -> Globals.error_and_exit "No package defined"
+ | _ -> Globals.error_and_exit "Too many packages defined" in
+ if statement.kind <> "package" then
+ Globals.error_and_exit "%s: bad format (was waiting for 'package')" statement.kind;
+ let version =
+ try match List.assoc s_version statement.contents with
+ | String v -> v
+ | _ -> Globals.error_and_exit "Field 'version': bad format"
+ with Not_found ->
+ Globals.error_and_exit "field 'version' is missing" in
+ let description =
+ try match List.assoc s_description statement.contents with
+ | String s -> String.nsplit s "."
+ | _ -> Globals.error_and_exit "Fied 'description': bad format"
+ with Not_found -> [] in
+ let fields =
+ let unstring (k,v) = match v with
+ | String s -> k, s
+ | _ -> Globals.error_and_exit "Field %s: bad format" k in
+ List.map unstring statement.contents in
+ let r = { version; description; fields;
+ name = statement.File_format.name } in
+ r
- let to_string t =
- BatIO.to_string
- (BatList.print ~first:"" ~last:"" ~sep:"\n"
- (fun oc txt ->
- BatString.print oc
- (match txt with
- | Raw s -> s
- | Parsed (k, v) -> k ^ " : " ^ v))) t.list_stanza
end
@@ -310,7 +346,7 @@ struct
(** destruct *)
val lib : t -> path list
- val bin : t -> path option
+ val bin : t -> path list
val misc : t -> misc list
val path_from : misc -> path
@@ -330,7 +366,7 @@ struct
type t =
{ lib : path list
- ; bin : path option
+ ; bin : path list
; misc : misc list }
let lib t = t.lib
@@ -361,8 +397,8 @@ struct
| Absolute, l_b, suff -> filename_of_path t Path.root l_b suff
| _ -> assert false
- let empty = { lib = []
- ; bin = None
+ let empty = { lib = []
+ ; bin = []
; misc = [] }
let b_of_string abs s =
@@ -379,107 +415,124 @@ struct
let relative_path_of_string = b_of_string Relative
let parse s =
- let l_lib_bin, l_misc =
- let l, f_while =
- String.nsplit s "\n",
- fun s ->
- match try Some (BatString.split "misc" (BatString.trim s)) with _ -> None with
- | Some ("", _) -> false
- | _ -> true in
- List.takewhile f_while l, List.dropwhile f_while l in
-
- let l_lib_bin = Parse.parse ":" l_lib_bin in
-
-
- { lib =
- (match Parse.Exceptionless.assoc_parsed "lib" l_lib_bin with
- | Some lib -> List.map relative_path_of_string (String.nsplit lib ",")
- | None -> [])
- ; bin = Option.map relative_path_of_string (Parse.Exceptionless.assoc_parsed "bin" l_lib_bin)
- ; misc =
- List.map
- (fun (s_path, s_fname) ->
- { p_from = relative_path_of_string s_path ; p_to = b_of_string Absolute s_fname })
- (Parse.filter_parsed (Parse.parse " " l_misc)) }
+ let file = Parser.main Lexer.token (Lexing.from_string s) in
+ let one accu s =
+ if s.kind <> "install" then
+ Globals.error_and_exit "Bad format: expecting 'install', got %s" s.kind;
+ let aux1 = List.map relative_path_of_string in
+ let aux2 = List.map
+ (fun (k,v) -> { p_from = relative_path_of_string k;
+ p_to = relative_path_of_string v }) in
+ { lib = aux1 (string_list "lib" s) @ accu.lib;
+ bin = aux1 (string_list "bin" s) @ accu.bin;
+ misc = aux2 (pair_list "misc" s) @ accu.misc } in
+ List.fold_left one empty file.statements
let to_string t =
- let path_print oc (pref, l_base, base) =
- begin
- BatString.print oc (match pref with Absolute -> "/" | Relative -> "");
- BatList.print ~first:"" ~last:"/" ~sep:"/" (fun oc (B base) -> BatString.print oc base) oc l_base;
- BatString.print oc (match base with Suffix s -> Printf.sprintf "*.%s" s | Exact s -> s);
- end in
-
- Printf.sprintf "
-lib: %s
-bin: %s
-misc:
-%s"
- (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:", " path_print) t.lib)
- (BatIO.to_string (BatOption.print path_print) t.bin)
- (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:"\n"
- (fun oc misc ->
- begin
- path_print oc (misc.p_from);
- BatString.print oc " ";
- path_print oc (misc.p_to);
- end)) t.misc)
+ let print (pref, l_base, base) =
+ let prefix = match pref with Absolute -> "/" | Relative -> "" in
+ let path = match l_base with
+ | [] -> ""
+ | _ -> String.concat "/" (List.map (fun (B base) -> base) l_base) in
+ let suffix = match base with Suffix s -> Printf.sprintf "*.%s" s | Exact s -> s in
+ Printf.sprintf "%s%s%s" prefix path suffix in
+
+ let print_list = List.map print in
+ Printf.sprintf "\
+ lib: %s\n\
+ bin: %s\n\
+ misc:\n\
+ %s"
+ (String.concat ", " (print_list t.lib))
+ (String.concat ", " (print_list t.bin))
+ (String.concat "\n"
+ (List.map (fun m ->
+ Printf.sprintf "%s %s"
+ (print m.p_from)
+ (print m.p_to))
+ t.misc))
end
- module type DESCR =
+ (* Package config X.config *)
+ module type PCONFIG =
sig
include IO_FILE
- val library : t -> string
- val requires : t -> string list
- val link : t -> string list
- val asmlink : t -> string list
+ val library_names : t -> string list
+ val link_options : t -> string list
+ val asmlink_options : t -> string list
+ val bytelink_options: t -> string list
end
- module Descr : DESCR =
+ module PConfig : PCONFIG =
struct
- let internal_name = "descr"
+ let internal_name = "pconfig"
- type t =
- { library : string
- ; requires : string list
- ; link : string list
+ type library =
+ { name : string
+ ; link : string list
+ ; bytelink: string list
; asmlink : string list }
+ type elt = Library of library
+
+ type t = elt list
+
open ExtString
- let library t = t.library
- let requires t = t.requires
- let link t = t.link
- let asmlink t = t.asmlink
-
- let parse s =
- let library, s =
- let s_beg, s = BatString.split s "{" in
- (match List.filter (function "" -> false | _ -> true) (String.nsplit s_beg " ") with
- | "library" :: name :: _ -> name
- | _ -> failwith "The name of the library is not found"), s in
- let l = Parse.colon s in
- let f_dash dash key = List.map (String.strip ~chars:" ") (String.nsplit dash (Parse.assoc_parsed key l)) in
- { library
- ; requires = f_dash "," "requires"
- ; link = f_dash "-" "link"
- ; asmlink = f_dash "-" "asmlink" }
-
- let to_string t =
- let f_s print_beg motif l =
- BatIO.to_string (BatList.print ~first:(if print_beg then motif else "") ~last:"" ~sep:motif BatString.print) l in
- Printf.sprintf "
-library %s {
- %s
- %s
- %s
-}" t.library (f_s false ", " t.requires) (f_s true " -" t.link) (f_s true " -" t.asmlink)
-
- let empty = { library = "" ; requires = [] ; link = [] ; asmlink = [] }
+ let libraries t =
+ List.fold_left (fun accu -> function Library l -> l :: accu) [] t
+
+ let library_names t = List.map (fun l -> l.name) (libraries t)
+
+ let options f t = List.flatten (List.map (fun l -> f l) (libraries t))
+
+ let link_options = options (fun l -> l.link)
+
+ let asmlink_options = options (fun l -> l.asmlink)
+
+ let bytelink_options = options (fun l -> l.bytelink)
+
+ let parse_library s =
+ { name = s.File_format.name;
+ link = string_list "link" s;
+ bytelink = string_list "bytelink" s;
+ asmlink = string_list "bytelink" s }
+
+ let parse s =
+ let file = Parser.main Lexer.token (Lexing.from_string s) in
+ let parse_statement s = match s.kind with
+ | "library" -> Library (parse_library s)
+ | _ -> Globals.error_and_exit "Bad format: unknown kind '%s'" s.kind in
+ List.map parse_statement file.statements
+
+ let string_of_string_list l =
+ let p = Printf.sprintf "%S" in
+ match l with
+ | [] -> "[]"
+ | _ ->
+ let elts = List.map p l in
+ Printf.sprintf "[ %s ]" (String.concat "; " elts)
+
+ let string_of_library t =
+ let p (k,v) = match v with
+ | [] -> ""
+ | _ -> Printf.sprintf " %s = %s;\n" k (string_of_string_list v) in
+ let fields = List.map p [
+ ("link" , t.link);
+ ("bytelink", t.bytelink);
+ ("asmlink", t.asmlink);
+ ] in
+ Printf.sprintf "library %s {\n%s}\n" t.name (String.concat "" fields)
+
+ let to_string l =
+ let aux (Library l) = string_of_library l in
+ String.concat "\n\n" (List.map aux l)
+
+ let empty = []
end
module type SECURITY_KEY =
@@ -545,9 +598,9 @@ struct
open Base
module Config = struct include Config include Make (Config) end
- module Opam = struct include Opam include Make (Opam) end
+ module Spec = struct include Spec include Make (Spec) end
module To_install = struct include To_install include Make (To_install) end
- module Descr = struct include Descr include Make (Descr) end
+ module PConfig = struct include PConfig include Make (PConfig) end
module Security_key = struct include Security_key include Make (Security_key) end
module Installed =
View
38 src/file_format.ml
@@ -0,0 +1,38 @@
+type content =
+ | String of string
+ | List of content list
+
+type statement = {
+ kind: string;
+ name: string;
+ contents: (string * content) list
+}
+
+type file = {
+ version: int;
+ statements: statement list;
+}
+
+let parse_string = function
+ | String s -> s
+ | _ -> Globals.error_and_exit "Bad format: expecting a string, got a list"
+
+let parse_string_list = function
+ | List l -> List.map parse_string l
+ | _ -> Globals.error_and_exit "Bad format: expecting a list, got s string"
+
+let parse_pair = function
+ | List[String k; String v] -> (k, v)
+ | _ -> Globals.error_and_exit "Bad format: expecting a pair"
+
+let parse_pair_list = function
+ | List l -> List.map parse_pair l
+ | _ -> Globals.error_and_exit "Bad format: expecting a list, got a string"
+
+let string_list n s =
+ try parse_string_list (List.assoc n s.contents)
+ with Not_found -> []
+
+let pair_list n s =
+ try parse_pair_list (List.assoc n s.contents)
+ with Not_found -> []
View
2 src/globals.ml
@@ -6,7 +6,7 @@ let default_hostname = "opam.ocamlpro.com"
let default_port = 9999
let ocaml_version = Sys.ocaml_version
-let opam_version = "1"
+let api_version = 1
let home = Unix.getenv "HOME"
let default_opam_server_path = Filename.concat home ".opam-server"
View
67 src/lexer.mll
@@ -0,0 +1,67 @@
+{
+ open Parser
+
+ let newline lexbuf = Lexing.new_line lexbuf
+}
+
+let space = [' ' '\t' '\r' '\n']
+let alpha = ['a'-'z' 'A'-'Z' '_']
+let digit = ['0'-'9']
+let ident = alpha (alpha | digit)*
+let number = '-'? ('.'['0'-'9']+ | ['0'-'9']+('.'['0'-'9']*)? )
+
+rule token = parse
+| space { token lexbuf }
+| "\n" { newline lexbuf; token lexbuf }
+| "@" { AT }
+| "=" { EQUAL }
+| "{" { LBRACE }
+| "}" { RBRACE }
+| "[" { LBRACKET }
+| "]" { RBRACKET }
+| ";" { SEMI }
+| '"' { let s = string "" lexbuf in
+ STRING s }
+| "(*" { comment 1 lexbuf; token lexbuf }
+| number { INT (int_of_string (Lexing.lexeme lexbuf)) }
+| ident { IDENT (Lexing.lexeme lexbuf) }
+| eof { EOF }
+| _ { let token = Lexing.lexeme lexbuf in
+ Globals.error_and_exit "lexer error: '%s' is not a valid tokenm" token }
+
+(* XXX: not optimal at all *)
+and string s = parse
+| '"' { s }
+| "\n" { newline lexbuf;
+ string (s ^ Lexing.lexeme lexbuf) lexbuf }
+| "\\" [^ '"' '\\']+
+ { string (s ^ Lexing.lexeme lexbuf) lexbuf }
+| eof { s }
+| _ { string (s ^ Lexing.lexeme lexbuf) lexbuf }
+
+and comment n = parse
+| "*)" { if n > 1 then comment (n-1) lexbuf }
+| "(*" { comment (n+1)lexbuf }
+| eof { }
+| "\n" { newline lexbuf; comment n lexbuf }
+| _ { comment n lexbuf }
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
View
27 src/ocp_get.ml
@@ -60,19 +60,19 @@ let () =
| ["info"] -> Client.info None
| ["info"; name] -> Client.info (Some (Name name))
- (* ocp-get config [-r] [-dir|-bytelink|-asmlink] PACKAGE *)
+ (* ocp-get config [R] [Include|Bytelink|Asmlink] PACKAGE *)
| "config" :: l_arg ->
- let is_rec, l_arg =
- match l_arg with
- | "r" :: l_arg -> true, l_arg
- | _ -> false, l_arg in
- let opt, name =
- match l_arg with
- | [ "dir" ; name ] -> Client.Dir, name
- | [ "bytelink" ; name ] -> Client.Bytelink, name
- | [ "asmlink" ; name ] -> Client.Asmlink, name
- | _ -> err l_arg in
- Client.config is_rec opt (Name name)
+ let is_rec, req, name = match l_arg with
+ | ["R"; r; name]
+ | [r; "R"; name] -> true , r, name
+ | [r; name] -> false, r, name
+ | _ -> err l_arg in
+ let req = match req with
+ | "Include" -> Client.Include
+ | "Bytelink" -> Client.Bytelink
+ | "Asmlink" -> Client.Asmlink
+ | _ -> err l_arg in
+ Client.config is_rec req (Name name)
(* ocp-get install PACKAGE *)
| ["install"; name] -> Client.install (Name name)
@@ -90,3 +90,6 @@ let () =
| ["remove"; name] -> Client.remove (Name name)
| l -> err l
+
+
+
View
70 src/parser.mly
@@ -0,0 +1,70 @@
+%{
+ open File_format
+%}
+
+%token <string> STRING IDENT
+%token <int> INT
+%token EOF
+%token AT
+%token SEMI
+%token LBRACKET
+%token RBRACKET
+%token LBRACE
+%token RBRACE
+%token EQUAL
+
+%start main
+%type <File_format.file> main
+
+%%
+
+main:
+| version statements EOF { {version = $1; statements = $2} }
+;
+
+version:
+| AT INT { $2 }
+| { Globals.api_version }
+;
+
+statements:
+| statement statements { $1 :: $2 }
+| { [] }
+;
+
+statement:
+| IDENT STRING LBRACE contents RBRACE { {kind=$1; name=$2; contents= $4} }
+;
+
+contents:
+| { [] }
+| IDENT EQUAL content contents { ($1, $3) :: $4 }
+| IDENT EQUAL content SEMI contents { ($1, $3) :: $5 }
+;
+
+content:
+| STRING { String $1 }
+| LBRACKET contentlist RBRACKET { List $2 }
+;
+
+contentlist:
+| { [] }
+| content { [$1] }
+| content SEMI contentlist { $1 :: $3 }
+;
+
+%%
+
+exception Error of int * int * string
+
+let lexer_error lexbuf =
+ let curr = lexbuf.Lexing.lex_curr_p in
+ let line = curr.Lexing.pos_lnum in
+ let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
+ let tok = Lexing.lexeme lexbuf in
+ raise (Error (line,cnum,tok))
+
+let main t l =
+ try main t l
+ with _ ->
+ lexer_error l
View
37 src/path.ml
@@ -186,11 +186,11 @@ sig
val installed : t -> filename (* $HOME_OPAM_OVERSION/installed *)
(** OPAM files considered for an arbitrary version and package *)
- val index_opam : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.opam *)
+ val index : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.spec *)
(* [None] : $HOME_OPAM/index *)
- (** list of OPAM files *)
- val index_opam_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.opam ] -> [ NAME, VERSION ] *)
+ (** list of spec files *)
+ val index_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.spec ] -> [ NAME, VERSION ] *)
(** source archives for all versions of all packages *)
val archives_targz : t -> name_version option -> filename (* $HOME_OPAM/archives/NAME-VERSION.tar.gz *)
@@ -327,7 +327,7 @@ module Path : PATH = struct
| None -> Raw (t_home // name)
| Some (n, v) -> mk_name_version t_home name ext n v
- let index_opam t = mk_name_version_o t.home "index" ".opam"
+ let index t = mk_name_version_o t.home "index" ".spec"
let archives_targz t = mk_name_version_o t.home "archives" ".tar.gz"
let build t = mk_name_version_o t.home_ocamlversion "build" ""
@@ -362,7 +362,7 @@ module Path : PATH = struct
let nv_of_extension version (B s) =
let s =
- match BatString.right_chop s ".opam" with
+ match BatString.right_chop s ".spec" with
| Some s -> s
| _ ->
let rec aux s =
@@ -384,9 +384,9 @@ module Path : PATH = struct
else
None
- let index_opam_list t =
+ let index_list t =
let files =
- match find (index_opam t None) with
+ match find (index t None) with
| Directory l -> l
| File _
| Not_found _ -> [] in
@@ -480,15 +480,22 @@ module Path : PATH = struct
let f_filename f f_basename =
List.map
- (fun fic ->
- f,
- f_basename fic,
- match (lstat fic).Unix.st_kind with
- | Unix.S_DIR -> R_directory (Enum.map (fun f ->
- let f = B f in
- f, R_filename [fic /// f]) (files_of fic))
+ (fun fic ->
+ if Sys.file_exists (s_of_filename fic) then begin
+ f,
+ f_basename fic,
+ match (lstat fic).Unix.st_kind with
+ | Unix.S_DIR ->
+ R_directory (Enum.map
+ (fun f ->
+ let f = B f in
+ f, R_filename [fic /// f])
+ (files_of fic))
| Unix.S_REG -> R_file (Filename (Raw_filename (s_of_filename fic)))
- | _ -> failwith "to complete !") in
+ | _ -> failwith "to complete !"
+ end else
+ Globals.error_and_exit "File %s does not exist." (s_of_filename fic))
+ in
let rec aux f (* <- filename dir *) name (* name of the value that will be destructed*) = function
| R_directory l ->
View
16 src/server.ml
@@ -33,7 +33,7 @@ end
type server_state =
{ home : Path.t (* ~/.opam-server *)
- ; opam_version : internal_version }
+ ; opam_version : int }
module Server = struct
@@ -43,23 +43,23 @@ module Server = struct
let read_index home =
List.fold_left
(fun map nv ->
- let file = File.Opam.find_err (Path.index_opam home (Some nv)) in
+ let file = File.Spec.find_err (Path.index home (Some nv)) in
NV_map.add nv file map)
NV_map.empty
- (Path.index_opam_list home)
+ (Path.index_list home)
let string_of_nv (n, v) = Namespace.string_of_nv n v
let init home =
{ home = Path.init home
- ; opam_version = Version Globals.opam_version }
+ ; opam_version = Globals.api_version }
let getList t =
- Path.index_opam_list t.home
+ Path.index_list t.home
let getOpam t n_v =
let index = read_index t.home in
- try binary (File.Opam.to_string (NV_map.find n_v index))
+ try binary (File.Spec.to_string (NV_map.find n_v index))
with Not_found -> failwith (string_of_nv n_v ^ " not found")
let getArchive t n_v =
@@ -72,10 +72,10 @@ module Server = struct
| _ -> failwith ("Cannot find " ^ string_of_nv n_v)
let f_archive t n_v opam archive =
- let opam_file = Path.index_opam t.home (Some n_v) in
+ let opam_file = Path.index t.home (Some n_v) in
let archive_file = Path.archives_targz t.home (Some n_v) in
begin match opam with
- | Binary (Raw_binary s) -> File.Opam.add opam_file (File.Opam.parse s)
+ | Binary (Raw_binary s) -> File.Spec.add opam_file (File.Spec.parse s)
| f -> Path.add opam_file (Path.File f)
end;
begin match archive with
View
13 tests/Makefile
@@ -14,16 +14,19 @@ ARCHIVES = $(PACKAGES:%=packages/%.tar.gz)
.PHONY: all upload
-all: init upload info install
+all: fresh init upload info install
@
-install-binaries:
- cp ../ocp-get ../ocp-get-server $(BIN)
+$(BIN)/ocp-get: ../ocp-get
+ cp ../ocp-get $(BIN)/ocp-get
-runserver: install-binaries
+$(BIN)/ocp-get-server: ../ocp-get-server
+ cp ../ocp-get-server $(BIN)/ocp-get-server
+
+runserver: fresh $(BIN)/ocp-get-server
$(OCPGET_SERVER)
-init: install-binaries fresh
+init: fresh $(BIN)/ocp-get
$(OCPGET) init $(LOCALHOST)
upload: $(ARCHIVES) init
View
8 tests/packages/P1-1/P1.install
@@ -1 +1,7 @@
-lib: _build/p1.cma, _build/p1.cmxa, _build/p1.cmi
+install "P1" {
+ lib = [
+ "_build/p1.cma";
+ "_build/p1.cmxa";
+ "_build/p1.cmi";
+ ]
+}
View
7 tests/packages/P1-2/P1.install
@@ -0,0 +1,7 @@
+install "P1" {
+ lib = [
+ "_build/p1.cma";
+ "_build/p1.cmxa";
+ "_build/p1.cmi";
+ ]
+}
View
5 tests/packages/P1.opam
@@ -1,5 +0,0 @@
-opam-version: 1.0
-
-package: P1
-version: 1
-description: A very useful package
View
5 tests/packages/P1.opam.2
@@ -1,5 +0,0 @@
-opam-version: 1.0
-
-package: P1
-version: 2
-description: A very useful package
View
12 tests/packages/P1.spec
@@ -0,0 +1,12 @@
+(* This is the way to express the API version *)
+@1
+
+(* This is the way to define a new package *)
+package "P1" {
+
+ (* Version are arbitrary strings *)
+ version = "1"
+
+ description =
+ "A very useful package"
+}
View
6 tests/packages/P1.spec.2
@@ -0,0 +1,6 @@
+@1
+
+package "P1" {
+ version = "2"
+ description = "A very useful package"
+}
View
8 tests/packages/P2-1/P2.install
@@ -1 +1,7 @@
-lib: p2.cmo, p2.cmx, p2.cmi
+install "P2" {
+ lib = [
+ "p2.cmo";
+ "p2.cmx";
+ "p2.cmi";
+ ]
+}
View
4 tests/packages/P2-1/build.sh
@@ -1,7 +1,9 @@
#!/bin/bash
OCPGET="ocp-get --root /tmp/OPAM.TEST"
-FLAGS="-I `${OCPGET} config dir P1`"
+FLAGS="`${OCPGET} config Include P1`"
+
+echo ${FLAGS}
echo "Bytecode Compilation"
ocamlopt -c ${FLAGS} p2.ml
View
8 tests/packages/P2.opam
@@ -1,8 +0,0 @@
-opam-version: 1.0
-
-package: P2
-version: 1
-description:
- An other very useful package.
- The description can go on multiple lines
-depends: P1
View
13 tests/packages/P2.spec
@@ -0,0 +1,13 @@
+@1
+
+package "P2" {
+ version = "1"
+ description =
+ "An other very useful package.\
+
+ The description can go on multiple lines but they\
+ need to be escaped correclty (see the '\\' character\
+ at the end of the lines."
+
+ depends = "P1"
+}
View
8 tests/packages/P3-1-weird.version/P3.install
@@ -1 +1,7 @@
-lib: _build/p3.cma, _build/p3.cmxa, _build/p3.cmi
+install "P3" {
+ lib = [
+ "_build/p3.cma";
+ "_build/p3.cmxa";
+ "_build/p3.cmi";
+ ]
+}
View
2 tests/packages/P3-1-weird.version/_tags
@@ -1,2 +0,0 @@
-<*.{byte,native}>: use_p1
-<*.ml>: use_p1
View
9 tests/packages/P3-1-weird.version/myocamlbuild.ml
@@ -1,12 +1,17 @@
+let deps = [ "P1" ]
+
open Ocamlbuild_plugin
let ocp_get pkg =
Ocamlbuild_pack.My_unix.run_and_open
- (Printf.sprintf "ocp-get --root %s config dir %s"
+ (Printf.sprintf "ocp-get --root %s config R Include %s"
(Unix.getenv "OPAM_ROOT")
(Filename.quote pkg))
input_line
+let add_dep p =
+ flag ["ocaml"; "compile"] & S[Sh (ocp_get p)]
+
let _ = dispatch & function
- | After_rules -> ocaml_lib ~extern:true ~dir:(ocp_get "P1") "p1"
+ | After_rules -> List.iter add_dep deps
| _ -> ()
View
6 tests/packages/P3.opam
@@ -1,6 +0,0 @@
-opam-version: 1.0
-
-package: P3
-version: 1-weird.version
-description: Testing version names
-depends: P1
View
7 tests/packages/P3.spec
@@ -0,0 +1,7 @@
+@1
+
+package "P3" {
+ version = "1-weird.version"
+ description = "Testing version names"
+ depends = "P1"
+}
View
8 tests/packages/P4-1/P4.install
@@ -1 +1,7 @@
-lib: _build/p4.cma, _build/p4.cmxa, _build/p4.cmi
+install "P4" {
+ lib = [
+ "_build/p4.cma";
+ "_build/p4.cmxa";
+ "_build/p4.cmi";
+ ]
+}
View
11 tests/packages/P4-1/myocamlbuild.ml
@@ -1,16 +1,17 @@
+let deps = [ "P2"; "P3" ]
+
open Ocamlbuild_plugin
-open Printf
let ocp_get pkg =
Ocamlbuild_pack.My_unix.run_and_open
- (Printf.sprintf "ocp-get --root %s config dir %s"
+ (Printf.sprintf "ocp-get --root %s config R Include %s"
(Unix.getenv "OPAM_ROOT")
(Filename.quote pkg))
input_line
-let p n =
- ocaml_lib ~extern:true ~dir:(ocp_get (sprintf "P%d" n)) (sprintf "p%d" n)
+let add_dep p =
+ flag ["ocaml"; "compile"] & S[Sh (ocp_get p)]
let _ = dispatch & function
- | After_rules -> List.iter p [ 2 ; 3 ]
+ | After_rules -> List.iter add_dep deps
| _ -> ()
View
6 tests/packages/P4.opam
@@ -1,6 +0,0 @@
-opam-version: 1.0
-
-package: P4
-version: 1
-description: Testing transitive closure
-depends: P2
View
7 tests/packages/P4.spec
@@ -0,0 +1,7 @@
+@1
+
+package "P4" {
+ version = "1"
+ description = "Testing transitive closure"
+ depends = "P2"
+}

0 comments on commit 1bcaf57

Please sign in to comment.
Something went wrong with that request. Please try again.