Merge pull request #200 from lefessan/z-2023-03-14-fixes

Multiple fixes after testing on autofonce

src/drom_lib/commandToml.ml

@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright 2020 OCamlPro & Origin Labs                               *)
+(*                                                                        *)
+(*  All rights reserved. This file is distributed under the terms of the  *)
+(*  GNU Lesser General Public License version 2.1, with the special       *)
+(*  exception on linking described in the file LICENSE.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Ezcmd.V2
+open EZCMD.TYPES
+
+let cmd_name = "toml"
+
+let parse_and_print file =
+  match Drom_toml.Parser.from_filename file with
+  | `Ok toml ->
+      let s = Drom_toml.Printer.string_of_table toml in
+      Printf.printf "%s%!" s
+  | `Error (s, loc) ->
+      Error.raise "Could not parse file: %s at %s" s
+        (EzToml.string_of_location loc)
+
+let cmd =
+  EZCMD.sub cmd_name
+    (fun () -> ())
+    ~args:[
+      [], Arg.Anons (fun files ->
+          List.iter parse_and_print files
+        ),
+      EZCMD.info ~docv:"FILE"
+        "Parse FILE and write it back on stdout"
+    ]
+    ~doc:"Read TOML files and print them back on stdout"
+    ~man:
+      [ `S "DESCRIPTION";
+        `Blocks
+          [ `P "Test the TOML parser/printer:" ]
+      ]

src/drom_lib/commandUpdate.ml

@@ -9,6 +9,8 @@
 (**************************************************************************)
 
 open Ezcmd.V2
+open Ez_file.V1
+open EzFile.OP
 
 let cmd_name = "update"
 
@@ -24,6 +26,11 @@ let action ~args () =
   Opam.run ~y [ "install" ] [ deps_package ];
   let error = ref None in
   Opam.run ~y ~error [ "upgrade" ] [];
+
+  (* Generate lock file *)
+  let drom_project_deps_opam =
+    (Globals.drom_dir // p.package.name) ^ "-deps.opam" in
+  Opam.run ~y [ "lock" ] [ "." // drom_project_deps_opam ];
   Opam.run ~error [ "unpin" ] [ "-y"; deps_package ];
   match !error with
   | None -> Printf.eprintf "Switch Update OK\n%!"

src/drom_lib/main.ml

@@ -13,7 +13,9 @@ open EZCMD.TYPES
 
 let main () =
   let commands =
-    [ CommandNew.cmd;
+    [
+      CommandToml.cmd;
+      CommandNew.cmd;
       CommandProject.cmd;
       CommandPackage.cmd;
       CommandBuild.cmd;

src/drom_lib/update.ml

@@ -139,26 +139,32 @@ let update_files share ?args ?(git = false) ?(create = false) p =
     | Some min_edition -> ({ p with min_edition }, true)
   in
   let p, changed =
-    match args.arg_share_version with
-    | None -> (p, changed)
-    | project_share_version ->
-        if args.arg_share_version <> p.project_share_version then
-          let project_share_repo = match p.project_share_repo with
-            | None -> Some ( Share.share_repo_default () )
-            | Some project_share_repo -> Some project_share_repo
-          in
-          ({ p with project_share_version ; project_share_repo }, true)
-        else
-          (p, changed)
-  in
-  let p, changed =
-    match args.arg_share_repo with
-    | None -> (p, changed)
-    | project_share_repo ->
-        if args.arg_share_repo <> p.project_share_repo then
-          ({ p with project_share_repo }, true)
-        else
-          (p, changed)
+    match args, p with
+      { arg_share_version = Some "0.8.0" ; arg_share_repo = None ; _ },
+      { project_share_version = (None | Some "0.8.0"); project_share_repo = None ; _ } ->
+        p, changed     (* do nothing for compatibility with version = 0.8.0 *)
+    | _ ->
+        let p, changed =
+          match args.arg_share_version with
+          | None -> (p, changed)
+          | Some arg_share_version ->
+              if args.arg_share_version <> p.project_share_version then
+                let project_share_repo = match p.project_share_repo with
+                  | None -> Some ( Share.share_repo_default () )
+                  | Some project_share_repo -> Some project_share_repo
+                in
+                let project_share_version = Some arg_share_version in
+                ({ p with project_share_version ; project_share_repo }, true)
+              else
+                (p, changed)
+        in
+        match args.arg_share_repo with
+        | None -> (p, changed)
+        | project_share_repo ->
+            if args.arg_share_repo <> p.project_share_repo then
+              ({ p with project_share_repo }, true)
+            else
+              (p, changed)
   in
 
   let can_skip = ref [] in

src/toml.7.1.0/printer.ml

@@ -1,6 +1,6 @@
 open Types
 
-let maybe_escape_char formatter ch =
+let simple_escape_char formatter ch =
   match ch with
   | '"' -> Format.pp_print_string formatter "\\\""
   | '\\' -> Format.pp_print_string formatter "\\\\"
@@ -26,33 +26,39 @@ let print_float formatter value =
     Format.pp_print_float formatter value
 
 let print_string formatter value =
-  let has_newline = ref false in
-  let has_quote = ref false in
-  let has_doublequote = ref false in
-  String.iter
-    (function
-      | '\n' -> has_newline := true
-      | '\'' -> has_quote := true
-      | '"' -> has_doublequote := true
-      | _ -> () )
-    value;
-  match (!has_newline, !has_doublequote, !has_quote) with
-  | true, false, _ ->
+  let has_newline = String.contains value '"' in
+  if has_newline then begin
     Format.pp_print_string formatter {|"""|};
-    String.iter
-      (function
-        | '\n' -> Format.pp_print_newline formatter ()
-        | c -> maybe_escape_char formatter c )
-      value;
+    Format.pp_print_newline formatter ();
+    let rec iter nquotes value pos len =
+      if pos < len then
+        let c = value.[pos] in
+        match c with
+        | '"' ->
+            let nquotes =
+              if nquotes = 2 then begin
+                simple_escape_char formatter c;
+                0
+              end else begin
+                Format.pp_print_char formatter '"';
+                nquotes+1
+              end
+            in
+            iter nquotes value (pos+1) len
+        | '\n' ->
+            Format.pp_print_newline formatter ();
+            iter 0 value (pos+1) len
+        | c ->
+            simple_escape_char formatter c;
+            iter 0 value (pos+1) len
+    in
+    iter 0 value 0 (String.length value);
     Format.pp_print_string formatter {|"""|}
-  | true, true, false ->
-    Format.pp_print_string formatter "'''\n";
-    Format.pp_print_string formatter value;
-    Format.pp_print_string formatter "'''"
-  | _ ->
+  end else begin
     Format.pp_print_char formatter '"';
-    String.iter (maybe_escape_char formatter) value;
+    String.iter (simple_escape_char formatter) value;
     Format.pp_print_char formatter '"'
+  end
 
 let print_date fmt d = ISO8601.Permissive.pp_datetimezone fmt (d, 0.)