Parcourir la source

Merge branch 'dev' of gitlab.com:WzukW/oclaunch into dev

Leo il y a 8 ans
Parent
commit
fe1c79021f
37 fichiers modifiés avec 1096 ajouts et 478 suppressions
  1. 11 11
      .gitlab-ci.yml
  2. 6 1
      CHANGELOG.md
  3. 2 2
      INSTALL.md
  4. 6 3
      _oasis
  5. 10 0
      dev.scm
  6. 11 5
      opam
  7. 41 11
      setup.ml
  8. 1 1
      src/.merlin
  9. 8 7
      src/add_command.ml
  10. 2 2
      src/clean_command.ml
  11. 29 7
      src/command_def.ml
  12. 11 1
      src/const.ml
  13. 2 1
      src/const.mli
  14. 5 3
      src/default.ml
  15. 15 8
      src/edit_command.ml
  16. 1 1
      src/file_com.ml
  17. 344 344
      src/licencing.ml
  18. 4 7
      src/list_rc.ml
  19. 1 1
      src/oclaunch.ml
  20. 317 0
      src/rc.ml
  21. 98 0
      src/rc.mli
  22. 7 7
      src/remove_command.ml
  23. 2 2
      src/settings_j.ml
  24. 3 3
      src/state.ml
  25. 14 5
      src/test/ec_t.ml
  26. 8 3
      src/test/edit_t.ml
  27. 57 0
      src/test/rc_t.ml
  28. 8 2
      src/test/test.ml
  29. 9 3
      src/test/unify_t.ml
  30. 6 6
      src/tmp_biniou_b.ml
  31. 31 16
      src/tmp_file.ml
  32. 10 3
      src/tmp_file.mli
  33. 4 0
      src/tools.ml
  34. 1 0
      src/tools.mli
  35. 7 8
      src/unify.ml
  36. 3 3
      src/unify.mli
  37. 1 1
      test.sh

+ 11 - 11
.gitlab-ci.yml

@@ -6,21 +6,21 @@ stages:
   # Real distrubutions
   - real
 
-# OCaml version 4.00
-ocaml_400:
+# OCaml version 4.04
+ocaml_404:
   before_script:
     - sudo apk update && sudo apk add m4
   stage: other_version
-  image: ocaml/opam:alpine_ocaml-4.00.1
+  image: ocaml/opam:alpine_ocaml-4.04.0
   script: "./gitlab-ci.sh"
   allow_failure: true
 
-# OCaml version 4.01
-ocaml_401:
+# OCaml version 4.04
+ocaml_404_flambda:
   before_script:
     - sudo apk update && sudo apk add m4
   stage: other_version
-  image: ocaml/opam:alpine_ocaml-4.01.0
+  image: ocaml/opam:alpine_ocaml-4.04.0_flambda
   script: "./gitlab-ci.sh"
   allow_failure: true
 
@@ -28,19 +28,19 @@ ocaml_401:
 ocaml_402:
   before_script:
     - sudo apk update && sudo apk add m4
-  stage: test
+  stage: other_version
   image: ocaml/opam:alpine_ocaml-4.02.3
   script: "./gitlab-ci.sh"
-  allow_failure: false
+  allow_failure: true
 
 # OCaml version 4.03
 ocaml_403:
   before_script:
     - sudo apk update && sudo apk add m4
-  stage: other_version
+  stage: test
   image: ocaml/opam:alpine_ocaml-4.03.0
   script: "./gitlab-ci.sh"
-  allow_failure: true
+  allow_failure: false
 
 # OCaml version 4.03, with flambda optimisation
 ocaml_403_flambda:
@@ -58,7 +58,7 @@ ubuntu:
   stage: real
   image: ocaml/opam:ubuntu
   script: "export OC_NOTEST=true; ./gitlab-ci.sh system"
-  allow_failure: false
+  allow_failure: true
 
 
 debian:

+ 6 - 1
CHANGELOG.md

@@ -11,13 +11,16 @@ This version introduce major changes in the tmp and rc file.
 
 #### Major
 
- + Changed tmp file format, the new one would allow to do more things: (See #6)
+ + Changed tmp file structure, the new one would allow to do more things: (See #6)
     + Restart edited command (reset number of launch).
     + Support multiple configuration file.
     + More natural behavior when starting from an empty file. (Don't increment
      number of launch when nothing is actually launched).
     + Change name to improve multi-user compatibility.
     + For the future : Running infinite, daemon mode...
+ + New format and structure for the rc file, using **serial expression**: (see #5)
+    + Allows to add tags to command
+    + Allow to contain setting
  + Beautified rc file:
     + Remove doubled entries before each write of the rc file. Trailing spaces
       are remove too. Empty entries are dropped.
@@ -70,6 +73,8 @@ This version introduce major changes in the tmp and rc file.
  + Adapt code a bit for OCaml 4.03.
  + TODO XXX Add basic signal handling (`--signals`), to relaunch when doing
    ctrl-C. See issue #14 for known problems.
+ + Adapt to OCaml compiler version 4.03 (only supported)
+ + Improve opam, installs less dependencies, with ability to run tests
 
 #### Community
 

+ 2 - 2
INSTALL.md

@@ -1,5 +1,5 @@
 <!--- OASIS_START --->
-<!--- DO NOT EDIT (digest: 82837b65c0730b7a1c78065ed839afd8) --->
+<!--- DO NOT EDIT (digest: 66ae045c13d05b88691d4262e6b6e66e) --->
 
 This is the INSTALL file for the OcLaunch distribution.
 
@@ -11,7 +11,7 @@ Dependencies
 
 In order to compile this package, you will need:
 
-* ocaml for all, test tests
+* ocaml for all, test alcotests
 * findlib
 * core
 * textutils

Fichier diff supprimé car celui-ci est trop grand
+ 6 - 3
_oasis


+ 10 - 0
dev.scm

@@ -0,0 +1,10 @@
+;; You probably do NOT need to edit this file manualy.
+;; Anyway, you may find help at https://s.oclaunch.eu.org/rc
+
+
+((entries
+  (((command "ydump dev.json") (tags ())) ((command task) (tags ()))
+   ((command "du -sh ./_build/src/oclaunch.native") (tags ()))
+   ((command "free -h") (tags ())) ((command "echo \"Finish\"") (tags ()))
+   ((command "bdump -w daemon,rc,commands /tmp/v033") (tags ()))))
+ (common_tags ()) (settings ()))

+ 11 - 5
opam

@@ -7,19 +7,25 @@ homepage: "http://www.oclaunch.eu.org"
 bug-reports: "http://s.oclaunch.eu.org/bug"
 license: "CeCILL"
 dev-repo: "git@gitlab.com:WzukW/oclaunch.git"
+build-test: [
+  ["./configure" "--enable-tests" "--prefix=%{prefix}%"]
+  [make "test"]
+]
 build: [
-  ["./configure" "--prefix=%{prefix}%"]
+  ["./configure" "--disable-tests" "--prefix=%{prefix}%"]
   [make]
 ]
 install: [make "install"]
-remove: ["ocamlfind" "remove" "ocl"]
+remove: ["ocamlfind" "remove" "oclaunch"]
 depends: [
   "ocamlbuild"
-  "atdgen"
+  "atdgen" {>= "1.9.1"} { build }
   "base-threads"
   "core" {>= "112.35.00"}
   "textutils"
   "re2"
-  "ocamlfind" {build}
+  "ocamlfind" { build }
+  "ounit" {test}
+  "alcotest" {test}
 ]
-available: [ocaml-version >= "4.02.0"]
+available: [ocaml-version >= "4.03.0"]

+ 41 - 11
setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 58b23be3a408bab815d86a088b6439a4) *)
+(* DO NOT EDIT (digest: a8502e94ba054daf78bdc42e8717ca4f) *)
 (*
    Regenerated by OASIS v0.4.6
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6825,10 +6825,30 @@ open OASISTypes;;
 let setup_t =
   {
      BaseSetup.configure = InternalConfigurePlugin.configure;
-     build = OCamlbuildPlugin.build [];
+     build =
+       OCamlbuildPlugin.build
+         [
+            "-use-ocamlfind";
+            "-tag";
+            "\"ppx(ppx-jane";
+            "-as-ppx)\"";
+            "-tag";
+            "thread";
+            "-tag";
+            "debug";
+            "-tag";
+            "bin_annot";
+            "-tag";
+            "short_paths";
+            "-cflags";
+            "\"-w";
+            "A-4-33-40-41-42-43-34-44\"";
+            "-cflags";
+            "-strict-sequence"
+         ];
      test =
        [
-          ("tests",
+          ("alcotests",
             CustomPlugin.Test.main
               {
                  CustomPlugin.cmd_main =
@@ -6843,7 +6863,7 @@ let setup_t =
      clean = [OCamlbuildPlugin.clean];
      clean_test =
        [
-          ("tests",
+          ("alcotests",
             CustomPlugin.Test.clean
               {
                  CustomPlugin.cmd_main =
@@ -6856,7 +6876,7 @@ let setup_t =
      distclean = [];
      distclean_test =
        [
-          ("tests",
+          ("alcotests",
             CustomPlugin.Test.distclean
               {
                  CustomPlugin.cmd_main =
@@ -6871,7 +6891,9 @@ let setup_t =
           oasis_version = "0.4";
           ocaml_version = None;
           findlib_version = None;
-          alpha_features = ["stdfiles_markdown"; "compiled_setup_ml"];
+          alpha_features =
+            ["stdfiles_markdown"; "compiled_setup_ml"; "ocamlbuild_more_args"
+            ];
           beta_features = [];
           name = "OcLaunch";
           version = "0.3.0";
@@ -6974,7 +6996,11 @@ let setup_t =
                      cs_plugin_data = []
                   },
                    {
-                      bs_build = [(OASISExpr.EBool true, true)];
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "tests", true)
+                        ];
                       bs_install = [(OASISExpr.EBool true, false)];
                       bs_path = "src";
                       bs_compiled_object = Best;
@@ -7002,7 +7028,7 @@ let setup_t =
                    {exec_custom = false; exec_main_is = "test/test.ml"});
                Test
                  ({
-                     cs_name = "tests";
+                     cs_name = "alcotests";
                      cs_data = PropList.Data.create ();
                      cs_plugin_data = []
                   },
@@ -7019,7 +7045,11 @@ let setup_t =
                       test_run =
                         [
                            (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
-                           (OASISExpr.EFlag "tests", true)
+                           (OASISExpr.EFlag "tests", false);
+                           (OASISExpr.EAnd
+                              (OASISExpr.EFlag "tests",
+                                OASISExpr.EFlag "tests"),
+                             true)
                         ];
                       test_tools =
                         [ExternalTool "ocamlbuild"; ExternalTool "camlp4o"]
@@ -7036,7 +7066,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.6";
-     oasis_digest = Some "\162\178a\024\199\b\b`5\243~\148\252\191\166K";
+     oasis_digest = Some "\253\178\n\133\134y\176\209\139\026\026zP\021f0";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7044,6 +7074,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7048 "setup.ml"
+# 7078 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

+ 1 - 1
src/.merlin

@@ -1,4 +1,4 @@
-PKG core yojson atdgen core_extended
+PKG core yojson atdgen
 
 S *
 

+ 8 - 7
src/add_command.ml

@@ -54,18 +54,19 @@ let new_list current_list position new_items =
 
 (* Function which add the commands (one per line) ridden on stdin to the rc
  * file, and then display th new configuration *)
-let run ~(rc:File_com.t) position =
+let run ~(rc:Rc.t) position =
   (* Read command from stdin, as a list. fix_win_eol removes \r\n *)
-  let cmd_list = In_channel.input_lines ~fix_win_eol:true In_channel.stdin in
+  let cmd_list =
+    In_channel.input_lines ~fix_win_eol:true In_channel.stdin
+    |> List.map ~f:(fun command -> new Rc.entry command)
+  in
   (* Create an updated rc file *)
   let updated_rc =
-    { rc with
-      Settings_t.progs = (new_list rc.Settings_t.progs position cmd_list)
-    }
+    rc#change_entries (new_list rc#entries position cmd_list)
   in
-  File_com.write updated_rc;
+  updated_rc#write;
   (* Display the result *)
-  let reread_rc = File_com.init_rc () in
+  let reread_rc = Rc.init () in
   List_rc.run ~rc:reread_rc ()
 ;;
 

+ 2 - 2
src/clean_command.ml

@@ -37,7 +37,7 @@
 open Core.Std;;
 
 let run ~rc () =
-  (* Everything is done in background by File_com.write *)
-  File_com.write rc;
+  let rc = Unify.prettify rc in
   Messages.debug "Configuration file cleaned up";
+  rc
 ;;

+ 29 - 7
src/command_def.ml

@@ -42,7 +42,7 @@ open Command;;
 
 (* Type to return result of the work with common arguments *)
 type return_arg = {
-  rc : Settings_t.rc_file Lazy.t;
+  rc : Rc.t Lazy.t;
 }
 
 (* Shorthand *)
@@ -92,7 +92,7 @@ let shared_params =
 
          (* Obtain data from rc_file *)
          d "Reading rc_file...";
-         let rc_content = lazy (File_com.init_rc ()) in
+         let rc_content = lazy (Rc.init ()) in
          d "Read rc_file";
          { rc = rc_content } (* We use type for futur use *)
        )
@@ -154,7 +154,7 @@ let reset =
         * num: number to reset *)
        let rc = Lazy.force rc in
        match ( num, cmd ) with
-       | ( num, None ) | ( num, Some [] ) -> Tmp_file.reset2num ~rc num
+       | ( num, None ) | ( num, Some [] ) -> Tmp_file.reset2num num
        | ( num, Some cmd_list ) ->
          List.iter ~f:(fun cmd -> Tmp_file.reset_cmd ~rc num cmd) cmd_list
     )
@@ -199,7 +199,7 @@ let clean =
     )
     (fun { rc } () ->
        let rc = Lazy.force rc in
-       Clean_command.run ~rc ()
+       Clean_command.run ~rc () |> ignore;
     )
 ;;
 
@@ -273,12 +273,33 @@ let edit =
        iter_seq cmd_seq ~f:(fun n ->
               let position =
                 Option.value n
-                  ~default:(List.length (rc.Settings_t.progs) - 1)
+                  ~default:(List.length (rc#entries) - 1)
               in
               Edit_command.run ~rc position)
     )
 ;;
 
+(* Import from older version *)
+let import =
+  basic
+    ~summary:"Import an rc file of version <= 0.2.x"
+
+    Spec.(
+      empty
+      +> shared_params
+      +> flag "--from" (optional file) ~aliases:["-from"; "-f"]
+           ~doc:"file Import from given [FILE], json format (default: default-rc-file.json)"
+      +> flag "--to" (optional file) ~aliases:["-t"; "-to"]
+           ~doc:"file Write imported file to [FILE], sexp format (default: default-rc-file.scm)"
+    )
+    (fun _ from to_file () ->
+      let open Option in
+      let from = value ~default:Const.rc_file_old (from >>| Lazy.return) in
+      let to_file = value ~default:!Const.rc_file (to_file >>| Lazy.return) in
+      Rc.import ~from ~to_file
+    )
+;;
+
 (* To display informations about the licence *)
 let licence =
   basic
@@ -339,11 +360,12 @@ let run ~version ~build_info () =
                 http://cecill.info/licences/Licence_CeCILL_V2.1-en.html \
                 (https://s.oclaunch.eu.org/cecill) for details. More here: \
                 https://oclaunch.eu.org/floss-under-cecill (https://s.oclaunch.eu.org/l)."
-      ~readme:(fun () -> File_com.welcome_msg)
+      ~readme:(fun () -> Rc.welcome_msg)
       ~preserve_subcommand_order:()
       [ ("run", default) ; ("licence", licence) ; ("add", add) ; ("edit", edit)
       ; ("list", list) ; ("cleanup", clean) ; ("delete", delete)
-      ; ("state", state) ; ( "reset", reset) ; ( "reset-all", reset_all) ]
+      ; ("state", state) ; ( "reset", reset) ; ( "reset-all", reset_all)
+      ; ( "import", import ) ]
     |> run ~version ~build_info
   in
 

+ 11 - 1
src/const.ml

@@ -102,12 +102,22 @@ let no_color =
       )
 ;;
 
+(* Default place to read settings, before version 0.3.x *)
+let rc_file_old =
+  let internal_default : string lazy_t =
+    (* Default value, if no value is given (for instance as
+       command line argument), or no environnement variable is set *)
+    Lazy.(home >>| fun home -> home ^ "/" ^ ".oclaunch_rc.json")
+  in
+  get_var ~default:internal_default (lazy "OC_RC_OLD")
+;;
+
 (* Default place to read settings *)
 let rc_file_default =
   let internal_default : string lazy_t =
     (* Default value, if no value is given (for instance as
        command line argument), or no environnement variable is set *)
-    Lazy.(home >>| fun home -> home ^ "/" ^ ".oclaunch_rc.json")
+    Lazy.(home >>| fun home -> home ^ "/" ^ ".oclaunch_rc.scm")
   in
   get_var ~default:internal_default (lazy "OC_RC")
 ;;

+ 2 - 1
src/const.mli

@@ -44,7 +44,8 @@ val ask : bool option ref
 val no_color : bool ref
 
 (* Files *)
-val rc_file : string Core.Std.Lazy.t ref
+val rc_file_old : string Lazy.t
+val rc_file : string Lazy.t ref
 val tmp_file : string
 (* Conf *)
 val default_launch : int

+ 5 - 3
src/default.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 
 (* cmd_number is the number of the command the user wants
  * to execute *)
-let run ~rc cmd_number =
+let run ~(rc:Rc.t) cmd_number =
 
   (* Wait for another oclaunch instance which could launch the same program at
    * the same time and then lock *)
@@ -68,9 +68,11 @@ let run ~rc cmd_number =
     end
   | Some num -> begin
       (* Run given (num) item *)
-      File_com.num_cmd2cmd ~rc num
+      rc#entry ~n:num
       |> function
       | None -> Messages.warning "Your number is out of bound"
-      | Some cmd_to_exec -> Exec_cmd.execute cmd_to_exec;
+      | Some entry ->
+          let cmd_to_exec = entry#command in
+          Exec_cmd.execute cmd_to_exec;
     end
 ;;

+ 15 - 8
src/edit_command.ml

@@ -62,6 +62,7 @@ let new_list current_list position new_items =
 let gen_modification items =
   let r = "\n" in
   epur items
+  |> List.map ~f:(fun entry -> entry#command)
   |> (function
        | [] -> ""
        (* Only one element *)
@@ -74,9 +75,9 @@ let gen_modification items =
 
 (* Function which get the nth element, put it in a file, let the user edit it,
  * and then replace with the result *)
-let rec run ~(rc:File_com.t) position =
+let rec run ~(rc:Rc.t) position =
   (* Current list of commands *)
-  let current_list = rc.Settings_t.progs in
+  let current_list = rc#entries in
 
   (* Creating tmp file, for editing *)
   let tmp_filename = [
@@ -90,7 +91,7 @@ let rec run ~(rc:File_com.t) position =
   let original_command,shorter_list =
     Remove_command.remove current_list position
   in
-  Out_channel.write_all tmp_filename original_command;
+  Out_channel.write_all tmp_filename ~data:original_command;
 
 
   (* Edit file *)
@@ -104,10 +105,16 @@ let rec run ~(rc:File_com.t) position =
          |> Messages.warning);
 
   (* Reading and applying the result *)
-  let new_commands = In_channel.read_lines tmp_filename |> epur in
-  let cmd_list = new_list shorter_list position new_commands in
-  let updated_rc = { rc with Settings_t.progs = cmd_list} in
-  File_com.write updated_rc;
+  let new_commands =
+    In_channel.read_lines tmp_filename
+    |> List.map ~f:(fun command -> new Rc.entry command)
+    |> epur
+  in
+  let cmd_list =
+    new_list shorter_list position new_commands
+  in
+  let updated_rc = rc#change_entries cmd_list in
+  updated_rc#write;
   (* Display the result, only if modified *)
   let new_cmd_mod = gen_modification new_commands in
   (* We are doing things in this order to avoid multiple listing of rc file
@@ -127,7 +134,7 @@ let rec run ~(rc:File_com.t) position =
     begin
       sprintf "'%s' -> '%s'\n" original_command new_cmd_mod |> Messages.ok;
       (* Display new rc file *)
-      let reread_rc = File_com.init_rc () in
+      let reread_rc = Rc.init () in
       List_rc.run ~rc:reread_rc ()
     end;
 ;;

+ 1 - 1
src/file_com.ml

@@ -65,7 +65,7 @@ let write (rc_file:t) =
   let name = !Const.rc_file in
   (* Create string to be written, after removing duplicated commands (and
    * newlines) *)
-  let data = (Unify.prettify rc_file |> Settings_j.string_of_rc_file
+  let data = (rc_file |> Settings_j.string_of_rc_file
               |> Yojson.Basic.prettify ~std:true) in
   Out_channel.write_all (Lazy.force name) ~data
 ;;

Fichier diff supprimé car celui-ci est trop grand
+ 344 - 344
src/licencing.ml


+ 4 - 7
src/list_rc.ml

@@ -72,12 +72,9 @@ let truncate ?elength str =
 
 (* Generate list to feed the table, returning list of tuples
  * (number of a command in rc file, command, number of launch). *)
-(* FIXME Remove ?rc or use it *)
-let generate_list ?rc ?elength log =
+let generate_list ~rc ?elength log =
   let rc_numbered =
-    File_com.init_rc ()
-    |> fun rc -> rc.Settings_t.progs
-                 |> List.mapi ~f:(fun i item -> ( item, i ))
+    rc#entries |> List.mapi ~f:(fun i entry -> ( entry#command, i ))
   in
   List.map log ~f:(function ( cmd, number ) ->
          (* We are using list instead of tuple since it is what Text_utils want
@@ -106,10 +103,10 @@ let generate_list ?rc ?elength log =
  * - Test it, esp. ordering
  * - Allow to set form of the table, multiple rc file, display next to be
  * launched… *)
-let run ?rc ?elength () =
+let run ~rc ?elength () =
   let tmp : Tmp_file.t = Tmp_file.init () in
   Tmp_file.get_accurate_log ~tmp ()
-  |> generate_list ?rc ?elength
+  |> generate_list ~rc ?elength
   |> Textutils.Ascii_table.simple_list_table
        ~display:Textutils.Ascii_table.Display.column_titles
        [ "Id" ; "Command" ; "Number of launch" ]

+ 1 - 1
src/oclaunch.ml

@@ -43,7 +43,7 @@ let version_number = "0.3.0";;
 (* Variable store building information *)
 (* XXX This is fake value, it corresponds to the running
  * information *)
-let build_info = ( "Build with OCaml version " ^ (Sys.ocaml_version) ^ " on " ^ (Sys.os_type) );;
+let build_info = ( "Built with OCaml version " ^ (Sys.ocaml_version) ^ " on " ^ (Sys.os_type) );;
 
 let () =
   Command_def.run ~version:version_number ~build_info:build_info ()

+ 317 - 0
src/rc.ml

@@ -0,0 +1,317 @@
+(******************************************************************************)
+(* Copyright © Joly Clément, 2016                                             *)
+(*                                                                            *)
+(*  leowzukw@oclaunch.eu.org                                                  *)
+(*                                                                            *)
+(*  Ce logiciel est un programme informatique servant à exécuter              *)
+(*  automatiquement des programmes à l'ouverture du terminal.                 *)
+(*                                                                            *)
+(*  Ce logiciel est régi par la licence CeCILL soumise au droit français et   *)
+(*  respectant les principes de diffusion des logiciels libres. Vous pouvez   *)
+(*  utiliser, modifier et/ou redistribuer ce programme sous les conditions    *)
+(*  de la licence CeCILL telle que diffusée par le CEA, le CNRS et l'INRIA    *)
+(*  sur le site "http://www.cecill.info".                                     *)
+(*                                                                            *)
+(*  En contrepartie de l'accessibilité au code source et des droits de copie, *)
+(*  de modification et de redistribution accordés par cette licence, il n'est *)
+(*  offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons, *)
+(*  seule une responsabilité restreinte pèse sur l'auteur du programme,  le   *)
+(*  titulaire des droits patrimoniaux et les concédants successifs.           *)
+(*                                                                            *)
+(*  A cet égard  l'attention de l'utilisateur est attirée sur les risques     *)
+(*  associés au chargement,  à l'utilisation,  à la modification et/ou au     *)
+(*  développement et à la reproduction du logiciel par l'utilisateur étant    *)
+(*  donné sa spécificité de logiciel libre, qui peut le rendre complexe à     *)
+(*  manipuler et qui le réserve donc à des développeurs et des professionnels *)
+(*  avertis possédant  des  connaissances  informatiques approfondies.  Les   *)
+(*  utilisateurs sont donc invités à charger  et  tester  l'adéquation  du    *)
+(*  logiciel à leurs besoins dans des conditions permettant d'assurer la      *)
+(*  sécurité de leurs systèmes et ou de leurs données et, plus généralement,  *)
+(*  à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.        *)
+(*                                                                            *)
+(*  Le fait que vous puissiez accéder à cet en-tête signifie que vous avez    *)
+(*  pris connaissance de la licence CeCILL, et que vous en avez accepté les   *)
+(*  termes.                                                                   *)
+(******************************************************************************)
+
+open Core.Std;;
+
+(* Rc files means configuration file. It consist in a list of **entries**, with
+ * settings and common tags. Each entry has a command to be run (used to
+ * identify the entry in tmp file), an id (based on the position in rc file, may
+ * change), a description (the command plus things that tags may add), a number
+ * of launch (stored in tmp file) and tags, which change default behavior *)
+
+(* A “basic” rc file is used to interface with the content actualy written to
+ * the drive, and it’s then transforme to create the rc file used almost
+ * everywhere.
+ * “Basic” may used qualify anything referring to a low-level object *)
+type basic_tag = {
+  name : string;
+  arguments : string sexp_list
+} [@@deriving sexp]
+;;
+type basic_entry = {
+  command : string;
+  tags : basic_tag list
+} [@@deriving sexp]
+;;
+type basic_rc = {
+  entries : basic_entry list;
+  common_tags : basic_tag list;
+  settings : string list;
+} [@@deriving sexp]
+;;
+
+(* Template for the rc_file *)
+let basic_template =
+  "((entries())(common_tags())(settings()))"
+;;
+
+(* Header added once wrtten to disk *)
+let rc_header =
+  "\
+  ;; You probably do NOT need to edit this file manualy.\n\
+  ;; Anyway, you may find help at https://s.oclaunch.eu.org/rc\
+  "
+;;
+
+(* XXX Module exposing functions hidden by the mli file for tests *)
+module Test : sig
+  type basic_rc_t
+  val basic_rc_of_sexp : Sexp.t -> basic_rc_t
+  val basic_template : string
+end
+= struct
+  type basic_rc_t = basic_rc
+  let basic_rc_of_sexp = basic_rc_of_sexp
+  let basic_template = basic_template
+end;;
+
+(* Message to display on first use, i.e. on initialisation of rc file *)
+let welcome_msg =
+  sprintf
+    "Nice to meet you! Here is some tips to get started with OcLaunch.\n\
+     Use 'help' subcommand to get help (it works both after the name of the \
+     software and with another subcommand). For instance run\n\
+     `oclaunch help add`\n\
+     For further help, see https://oclaunch.eu.org. Report any bug at %s\
+     \n\
+     \n\
+     Feedback is welcome at feedback@oclaunch.eu.org.\n\
+     To get remind for new stable versions, subscribe to our low-traffic mailing \
+     list: announce@oclaunch.eu.org. \
+     More here: https://s.oclaunch.eu.org/ml\n\
+     See you soon! To keep in touch: https://s.oclaunch.eu.org/kt\n"
+    Bug.url
+;;
+
+let create_basic name =
+  sprintf "Initializing empty configuration file in %s.\n\
+           You may import your rc file from an older version with\n\
+           `oclaunch import`\
+  " name
+  |> Messages.warning;
+  Messages.tips welcome_msg;
+  Licencing.print ~cecill:false;
+  Out_channel.write_all name basic_template
+;;
+
+let rec get_basic rc_name =
+  match Sys.file_exists rc_name with
+  | `No -> create_basic rc_name; get_basic rc_name
+  | `Unknown -> failwith "Error reading configuration file";
+  | `Yes -> try Sexp.load_sexp rc_name |> basic_rc_of_sexp
+    with exn ->
+      Messages.warning "Problem reading rc file";
+      sprintf
+        "Remove file '%s' to get a fresh rc file next time you call oclaunch"
+        rc_name
+      |> Messages.tips;
+      raise exn
+;;
+
+(* From objects to types *)
+let tag_of_object tag  = failwith "Not implemented";;
+let setting_of_object setting = failwith "Not implemented";;
+let entry_of_object entry =
+  {
+    command = entry#command;
+    tags = List.map ~f:tag_of_object entry#tags
+  }
+;;
+
+(* Now transformed objects *)
+
+(* Tags may be extend by plugins *)
+class tag name arg = object (self:'self)
+  val name : string = name
+  val arguments : string list = arg
+
+  method name = name
+  method arguments = arg
+
+  method equal (other:'self) =
+    (String.equal self#name other#name)
+    && (List.equal ~equal:String.equal self#arguments other#arguments)
+end;;
+
+class entry ?(tags=[]) command = object (self:'self)
+  val command : string = command
+  val tags : tag list = tags
+
+  method command = command
+  method tags = tags
+
+  method change_command new_command = {< command = new_command >}
+  method change_tags new_tags = {< tags = new_tags >}
+
+  (* Two entries are equal iff they have the same command and tags *)
+  method equal (other:'self) =
+    (String.equal self#command other#command)
+    && (List.equal self#tags other#tags
+      ~equal:(fun atag btag -> atag#equal btag))
+end;;
+
+(* XXX Pseudo comparator *)
+let equal one another =
+  one#equal another
+;;
+
+(* Types of objects, exposed *)
+type setting = < key : string; value : string >;;
+type t = <
+  add_common_tags : tag list -> t;
+  add_entries : entry list -> t;
+  add_settings : setting list -> t;
+  change_entries : entry list -> t;
+  change_entry : int -> f:(entry -> entry) -> t;
+  change_name : string -> t;
+  common_tags : tag list;
+  entries : entry list;
+  entry : n:int -> entry option;
+  filter_map_common_tags : f:(tag -> tag option) -> t;
+  filter_map_entries : f:(int -> entry -> entry option) -> t;
+  filter_map_settings : f:(setting -> setting option) -> t;
+  get_name : string;
+  map_common_tags : f:(tag -> tag) -> t;
+  map_entries : f:(int -> entry -> entry) -> t;
+  map_settings : f:(setting -> setting) -> t;
+  read_common_tags : f:(tag -> unit) -> unit;
+  read_settings : f:(setting -> unit) -> unit;
+  remove_entry : int -> t;
+  settings : setting list;
+  write : unit
+>;;
+
+let object_of_tag tag = failwith "Not implemented"
+(* object
+   val name = tag.name;
+   val argument
+   end *)
+;;
+let object_of_tag_list =
+  List.map ~f:object_of_tag
+;;
+let object_of_entry object_common_tags entry =
+  new entry ~tags:((object_of_tag_list entry.tags) @ object_common_tags) entry.command
+;;
+let object_of_setting setting = failwith "Not implemented";;
+
+let init ?(rc=(!Const.rc_file)) () =
+  let basic_rc = get_basic (Lazy.force rc) in
+  let common_tags = object_of_tag_list basic_rc.common_tags in
+  object (self)
+    val entries = List.map ~f:(object_of_entry common_tags) basic_rc.entries
+    val common_tags = common_tags
+    val settings = List.map ~f:object_of_setting basic_rc.settings
+
+    method entries = entries
+    method common_tags = common_tags
+    method settings = settings
+
+    (* Change entry list *)
+    method change_entries new_entries = {< entries = new_entries >}
+
+    (* Get entry number n *)
+    method entry ~n = List.nth entries n
+
+    method add_entries new_entries =
+      {< entries = new_entries @ entries >}
+    method add_common_tags tags =
+      {< common_tags = tags @ common_tags >}
+    method add_settings new_settings =
+      {< settings = new_settings @ settings >}
+
+    method filter_map_entries ~f =
+      {< entries = List.filter_mapi entries ~f >}
+    method filter_map_common_tags ~f =
+      {< common_tags = List.filter_map common_tags ~f >}
+    method filter_map_settings ~f =
+      {< settings = List.filter_map settings ~f >}
+
+    method map_entries ~f =
+      {< entries = List.mapi entries ~f >}
+    method map_common_tags ~f =
+      {< common_tags = List.map common_tags ~f >}
+    method map_settings ~f =
+      {< settings = List.map settings ~f >}
+
+    method read_common_tags ~f =
+      List.iter common_tags ~f
+    method read_settings ~f =
+      List.iter settings ~f
+
+    (* Shorthand *)
+    method change_entry n ~f =
+      self#map_entries ~f:(fun i e -> if i=n then f e else e)
+    method remove_entry n =
+      self#filter_map_entries ~f:(fun i e -> if i=n then None else Some e)
+
+    (* Name of rc file when written to disk *)
+    val name = Lazy.force rc
+    method get_name = name
+    method change_name new_name = {< name = new_name >}
+    method write =
+      let body =
+        {
+          entries = List.map entries ~f:entry_of_object;
+          common_tags = List.map common_tags ~f:tag_of_object;
+          settings = List.map settings ~f:setting_of_object
+        } |> sexp_of_basic_rc
+        |> Sexp.to_string_hum
+      in
+      let data = String.concat [ rc_header ; "\n\n\n" ; body ; "\n" ] in
+      Out_channel.write_all name ~data
+    (** Write rc file at instantiation. Entries should be changed in group, to
+     * avoid multiple writing. Although, there is some cache done by out_channels,
+     * this is not very dangerous *)
+    initializer self#write
+  end;;
+
+let create_setting () = failwith "Not implemented"
+(*
+   (* Tools to create new tag *)
+   class enpty_tag = object
+   val
+*)
+
+let change_setting () = failwith "Not implemented"
+
+(* Empty entry *)
+let empty_entry () =
+  new entry ~tags:[] ""
+;;
+
+(* Import from older version *)
+let import ~from ~to_file =
+  let imported_rc : t = init ~rc:to_file () in
+  let to_import : File_com.t = File_com.init_rc ~rc:from () in
+  to_import.progs |> List.map ~f:(new entry)
+  |> imported_rc#change_entries
+  |> fun rc -> rc#write;
+  Messages.ok "Import successful!";
+  sprintf "from: %s; to: %s" (Lazy.force from) (Lazy.force to_file)
+  |> Messages.tips
+;;
+

+ 98 - 0
src/rc.mli

@@ -0,0 +1,98 @@
+(******************************************************************************)
+(* Copyright © Joly Clément, 2016                                             *)
+(*                                                                            *)
+(*  leowzukw@oclaunch.eu.org                                                  *)
+(*                                                                            *)
+(*  Ce logiciel est un programme informatique servant à exécuter              *)
+(*  automatiquement des programmes à l'ouverture du terminal.                 *)
+(*                                                                            *)
+(*  Ce logiciel est régi par la licence CeCILL soumise au droit français et   *)
+(*  respectant les principes de diffusion des logiciels libres. Vous pouvez   *)
+(*  utiliser, modifier et/ou redistribuer ce programme sous les conditions    *)
+(*  de la licence CeCILL telle que diffusée par le CEA, le CNRS et l'INRIA    *)
+(*  sur le site "http://www.cecill.info".                                     *)
+(*                                                                            *)
+(*  En contrepartie de l'accessibilité au code source et des droits de copie, *)
+(*  de modification et de redistribution accordés par cette licence, il n'est *)
+(*  offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons, *)
+(*  seule une responsabilité restreinte pèse sur l'auteur du programme,  le   *)
+(*  titulaire des droits patrimoniaux et les concédants successifs.           *)
+(*                                                                            *)
+(*  A cet égard  l'attention de l'utilisateur est attirée sur les risques     *)
+(*  associés au chargement,  à l'utilisation,  à la modification et/ou au     *)
+(*  développement et à la reproduction du logiciel par l'utilisateur étant    *)
+(*  donné sa spécificité de logiciel libre, qui peut le rendre complexe à     *)
+(*  manipuler et qui le réserve donc à des développeurs et des professionnels *)
+(*  avertis possédant  des  connaissances  informatiques approfondies.  Les   *)
+(*  utilisateurs sont donc invités à charger  et  tester  l'adéquation  du    *)
+(*  logiciel à leurs besoins dans des conditions permettant d'assurer la      *)
+(*  sécurité de leurs systèmes et ou de leurs données et, plus généralement,  *)
+(*  à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.        *)
+(*                                                                            *)
+(*  Le fait que vous puissiez accéder à cet en-tête signifie que vous avez    *)
+(*  pris connaissance de la licence CeCILL, et que vous en avez accepté les   *)
+(*  termes.                                                                   *)
+(******************************************************************************)
+
+open Core.Std;;
+
+module Test :
+  sig
+    type basic_rc_t
+    val basic_rc_of_sexp : Sexp.t -> basic_rc_t
+    val basic_template : string
+  end
+
+val welcome_msg : string
+
+val equal : < equal : 'a -> bool; .. > -> 'a -> bool
+
+(* TODO Improve documentation *)
+class tag : string -> string list ->
+  object ('self)
+    val arguments : string list
+    val name : string
+    method arguments : string list
+    method name : string
+    method equal : 'self -> bool
+end
+class entry : ?tags:tag list -> string ->
+object ('self)
+  val command : string
+  val tags : tag list
+  method command : string
+  method tags : tag list
+  method change_command : string -> 'self
+  method change_tags : tag list -> 'self
+  method equal : 'self -> bool
+end
+type setting = < key : string; value : string >;;
+type t = <
+  entries : entry list;
+  common_tags : tag list;
+  settings : setting list;
+  change_entries : entry list -> t;
+  add_common_tags : tag list -> t;
+  add_entries : entry list -> t;
+  add_settings : setting list -> t;
+  change_entry : int -> f:(entry -> entry) -> t;
+  change_name : string -> t;
+  entry : n:int -> entry option;
+  filter_map_common_tags : f:(tag -> tag option) -> t;
+  filter_map_entries : f:(int -> entry -> entry option) -> t;
+  filter_map_settings : f:(setting -> setting option) -> t;
+  map_common_tags : f:(tag -> tag) -> t;
+  map_entries : f:(int -> entry -> entry) -> t;
+  map_settings : f:(setting -> setting) -> t;
+  get_name : string;
+  read_common_tags : f:(tag -> unit) -> unit;
+  read_settings : f:(setting -> unit) -> unit;
+  remove_entry : int -> t;
+  write : unit
+>;;
+
+val init : ?rc:string lazy_t -> unit -> t
+
+val empty_entry : unit -> entry
+
+val import : from:(string Lazy.t) -> to_file:(string Lazy.t) -> unit

+ 7 - 7
src/remove_command.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 (* Function remove nth command in the rc_file, returning the removed one and the
  * new list *)
 let remove current_list n =
-  let removed = ref "" in
+  let removed = ref (Rc.empty_entry ()) in
   (* The list without the nth item *)
   let new_list = List.filteri current_list ~f:(fun i _ ->
          if i <> n then
@@ -55,22 +55,22 @@ let remove current_list n =
              false
            end
        ) in
-  ( !removed, new_list )
+  ( !removed#command, new_list )
 ;;
 
 (* Perform removal *)
 let perform ~rc new_list =
-  let updated_rc = { rc with Settings_t.progs = new_list } in
-  File_com.write updated_rc;
+  let updated_rc = rc#change_entries new_list in
+  updated_rc#write;
   (* Display the result, after rereading rc *)
-  let reread_rc = File_com.init_rc () in
+  let reread_rc = Rc.init () in
   List_rc.run ~rc:reread_rc ()
 ;;
 
 (* Function which removes a command, after getting confirmation, and then
  * display the new configuration *)
-let run ~(rc:File_com.t) n_to_remove =
-  let actual_list = rc.Settings_t.progs in
+let run ~(rc:Rc.t) n_to_remove =
+  let actual_list = rc#entries in
   (* Get nth command, default last *)
   let nth =
     Messages.debug "Will remove command number:";

+ 2 - 2
src/settings_j.ml

@@ -54,8 +54,8 @@ let read_rc_file = (
   fun p lb ->
     Yojson.Safe.read_space p lb;
     Yojson.Safe.read_lcurl p lb;
-    let field_progs = ref (Obj.magic 0.0) in
-    let field_settings = ref (Obj.magic 0.0) in
+    let field_progs = ref (Obj.magic (Sys.opaque_identity 0.0)) in
+    let field_settings = ref (Obj.magic (Sys.opaque_identity 0.0)) in
     let bits0 = ref 0 in
     try
       Yojson.Safe.read_space p lb;

+ 3 - 3
src/state.ml

@@ -39,7 +39,7 @@ open Core.Std;;
 (* Module to display the current state of the program *)
 
 (* Display current number *)
-let print_current ~rc () =
+let print_current ~(rc:Rc.t) () =
   Tmp_file.(init ()
             |> (fun tmp -> get_accurate_log ~tmp ())
             |> Exec_cmd.less_launched_num
@@ -51,9 +51,9 @@ let print_current ~rc () =
             (* XXX Debug *)
             sprintf "Num: %i" num |> Messages.debug;
 
-            File_com.num_cmd2cmd ~rc num
+            rc#entry ~n:num
             |> (function
-                 | Some cmd -> cmd
+                 | Some entry -> entry#command
                  | None -> Messages.warning "Error, should not append, this is a bug";
                    assert false)
             |> (fun ( cmd : string ) ->

+ 14 - 5
src/test/ec_t.ml

@@ -40,20 +40,29 @@ open Core.Std;;
 
 (* Function epur *)
 let epur () =
-  let current = Edit_command.epur [ "qw" ; "" ; "erty" ; "a" ; "" ; "zerty"] in
-  let expected = [ "qw" ; "erty" ; "a" ; "zerty" ] in
-  OUnit.assert_equal current expected
+  let current =
+    List.map ~f:Tools.to_entry [ "qw" ; "" ; "erty" ; "a" ; "" ; "zerty"]
+    |> Edit_command.epur
+  in
+  let expected = List.map ~f:Tools.to_entry [ "qw" ; "erty" ; "a" ; "zerty" ] in
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) current expected
 ;;
 
 (* Function gen_modification *)
 let gm1 () =
-  let current = Edit_command.gen_modification [ "qw" ] in
+  let current =
+    List.map ~f:Tools.to_entry  [ "qw" ]
+    |> Edit_command.gen_modification
+  in
   let expected = "qw" in
   OUnit.assert_equal current expected
 ;;
 
 let gm2 () =
-  let current = Edit_command.gen_modification [ "qw" ; "erty" ; "a" ; "zerty"] in
+  let current =
+    List.map ~f:Tools.to_entry [ "qw" ; "erty" ; "a" ; "zerty"]
+    |> Edit_command.gen_modification
+  in
   let expected = "\nqw\nerty\na\nzerty\n" in
   OUnit.assert_equal current expected
 ;;

+ 8 - 3
src/test/edit_t.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 (* Function epur ============================= *)
 let epur test solution () =
   let actual = Edit_command.epur test in
-  OUnit.assert_equal actual solution
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) actual solution
 ;;
 
 (* Data for above test *)
@@ -56,7 +56,10 @@ let ll_data = [
 ]
 
 let llt_l =
-  List.map ll_data ~f:(fun (t, s, name) -> ( (epur t s), name))
+  List.map ll_data ~f:(fun (t, s, name) -> (
+    let t = List.map ~f:Tools.to_entry t in
+    let s = List.map ~f:Tools.to_entry s in
+    (epur t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Quick, f))
 ;;
 (* =========================================== *)
@@ -124,7 +127,9 @@ let gm_data = [
 ]
 
 let gmt_l =
-  List.map gm_data ~f:(fun (t, s, name) -> ( (gen_mod t s), name))
+  List.map gm_data ~f:(fun (t, s, name) ->
+    let t = List.map ~f:Tools.to_entry t in
+    ( (gen_mod t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Quick, f))
 ;;
 (* =========================================== *)

+ 57 - 0
src/test/rc_t.ml

@@ -0,0 +1,57 @@
+(******************************************************************************)
+(* Copyright © Joly Clément, 2016                                             *)
+(*                                                                            *)
+(*  leowzukw@oclaunch.eu.org                                                  *)
+(*                                                                            *)
+(*  Ce logiciel est un programme informatique servant à exécuter              *)
+(*  automatiquement des programmes à l'ouverture du terminal.                 *)
+(*                                                                            *)
+(*  Ce logiciel est régi par la licence CeCILL soumise au droit français et   *)
+(*  respectant les principes de diffusion des logiciels libres. Vous pouvez   *)
+(*  utiliser, modifier et/ou redistribuer ce programme sous les conditions    *)
+(*  de la licence CeCILL telle que diffusée par le CEA, le CNRS et l'INRIA    *)
+(*  sur le site "http://www.cecill.info".                                     *)
+(*                                                                            *)
+(*  En contrepartie de l'accessibilité au code source et des droits de copie, *)
+(*  de modification et de redistribution accordés par cette licence, il n'est *)
+(*  offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons, *)
+(*  seule une responsabilité restreinte pèse sur l'auteur du programme,  le   *)
+(*  titulaire des droits patrimoniaux et les concédants successifs.           *)
+(*                                                                            *)
+(*  A cet égard  l'attention de l'utilisateur est attirée sur les risques     *)
+(*  associés au chargement,  à l'utilisation,  à la modification et/ou au     *)
+(*  développement et à la reproduction du logiciel par l'utilisateur étant    *)
+(*  donné sa spécificité de logiciel libre, qui peut le rendre complexe à     *)
+(*  manipuler et qui le réserve donc à des développeurs et des professionnels *)
+(*  avertis possédant  des  connaissances  informatiques approfondies.  Les   *)
+(*  utilisateurs sont donc invités à charger  et  tester  l'adéquation  du    *)
+(*  logiciel à leurs besoins dans des conditions permettant d'assurer la      *)
+(*  sécurité de leurs systèmes et ou de leurs données et, plus généralement,  *)
+(*  à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.        *)
+(*                                                                            *)
+(*  Le fait que vous puissiez accéder à cet en-tête signifie que vous avez    *)
+(*  pris connaissance de la licence CeCILL, et que vous en avez accepté les   *)
+(*  termes.                                                                   *)
+(******************************************************************************)
+
+open Core.Std;;
+
+(* Tests for src/rc.ml *)
+
+(* Rc template =================================== *)
+let rc_template =
+  let test () =
+    let r = Rc.Test.(basic_rc_of_sexp (Sexp.of_string basic_template)) in
+    (* XXX Actualy, we want to test this runs without exception *)
+    OUnit.assert_equal r r;
+  in
+  [(
+    "Test rc template correctness",
+    `Quick,
+    test
+  )]
+(* =========================================== *)
+
+(* To be used in test.ml *)
+let alco = [( "Rc.ml", rc_template )];;
+

+ 8 - 2
src/test/test.ml

@@ -38,8 +38,14 @@ open Core.Std;;
 
 (* A module launching all tests *)
 
+let tests =
+  [
+    Ec_t.alco ; Exec_t.alco ; Edit_t.alco ; Unify_t.alco ; Listrc_t.alco ;
+    Id_parsing_t.alco ; Rc_t.alco
+  ]
+;;
+
 let () =
   Alcotest.run "Test suite for the project"
-    (List.concat [ Ec_t.alco ; Exec_t.alco ; Edit_t.alco ; Unify_t.alco ;
-                   Listrc_t.alco ; Id_parsing_t.alco ])
+    (List.concat tests)
 ;;

+ 9 - 3
src/test/unify_t.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 (* Function make_uniq ============================= *)
 let make_uniq test solution () =
   let actual = Unify.make_uniq test in
-  OUnit.assert_equal actual solution
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) actual solution
 ;;
 
 (* Big and sometimes strange list, to be used in test data set.
@@ -109,7 +109,10 @@ let make_uniq_data = [
 ;;
 
 let t_set_fast =
-  List.map make_uniq_data ~f:(fun (t, s, name) -> ( (make_uniq t s), name))
+  List.map make_uniq_data ~f:(fun (t, s, name) -> (
+    let t = List.map ~f:Tools.to_entry t in
+    let s = List.map ~f:Tools.to_entry s in
+    (make_uniq t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Quick, f))
 ;;
 
@@ -117,7 +120,10 @@ let t_set_long =
   List.map
     ((big_pack ~message:"Much longer than real use case list of " 1_000)
      @ (big_pack ~message:"Crazy long list of " 9_999))
-    ~f:(fun (t, s, name) -> ( (make_uniq t s), name))
+    ~f:(fun (t, s, name) ->
+    let t = List.map ~f:Tools.to_entry t in
+    let s = List.map ~f:Tools.to_entry s in
+      ( (make_uniq t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Slow, f))
 ;;
 

+ 6 - 6
src/tmp_biniou_b.ml

@@ -61,7 +61,7 @@ let get_rc_entry_reader = (
   fun tag ->
     if tag <> 21 then Ag_ob_run.read_error () else
       fun ib ->
-        let field_commands = ref (Obj.magic 0.0) in
+        let field_commands = ref (Obj.magic (Sys.opaque_identity 0.0)) in
         let bits0 = ref 0 in
         let len = Bi_vint.read_uvint ib in
         for i = 1 to len do
@@ -100,7 +100,7 @@ let get_rc_entry_reader = (
 let read_rc_entry = (
   fun ib ->
     if Bi_io.read_tag ib <> 21 then Ag_ob_run.read_error_at ib;
-    let field_commands = ref (Obj.magic 0.0) in
+    let field_commands = ref (Obj.magic (Sys.opaque_identity 0.0)) in
     let bits0 = ref 0 in
     let len = Bi_vint.read_uvint ib in
     for i = 1 to len do
@@ -286,8 +286,8 @@ let get_tmp_file_reader = (
   fun tag ->
     if tag <> 21 then Ag_ob_run.read_error () else
       fun ib ->
-        let field_rc = ref (Obj.magic 0.0) in
-        let field_daemon = ref (Obj.magic 0.0) in
+        let field_rc = ref (Obj.magic (Sys.opaque_identity 0.0)) in
+        let field_daemon = ref (Obj.magic (Sys.opaque_identity 0.0)) in
         let bits0 = ref 0 in
         let len = Bi_vint.read_uvint ib in
         for i = 1 to len do
@@ -319,8 +319,8 @@ let get_tmp_file_reader = (
 let read_tmp_file = (
   fun ib ->
     if Bi_io.read_tag ib <> 21 then Ag_ob_run.read_error_at ib;
-    let field_rc = ref (Obj.magic 0.0) in
-    let field_daemon = ref (Obj.magic 0.0) in
+    let field_rc = ref (Obj.magic (Sys.opaque_identity 0.0)) in
+    let field_daemon = ref (Obj.magic (Sys.opaque_identity 0.0)) in
     let bits0 = ref 0 in
     let len = Bi_vint.read_uvint ib in
     for i = 1 to len do

+ 31 - 16
src/tmp_file.ml

@@ -144,30 +144,45 @@ let get_current () =
   failwith "Deprecated"
 ;;
 
+(* Types used to return accurate logs *)
+type accurate_log =
+  (Rc.entry * int) list
+;;
+type accurate_log_simple =
+  (string * int) list
+;;
+
 (* Get number of launch for each command in rc file, as follow:
- * (command:string, number of the command:int) list *)
-let get_accurate_log ?rc_name ~tmp () =
+ * (Rc.entry, number of launch for the command:int) list *)
+let get_accurate_log_complete ?rc_name ~tmp () =
   let open List in
-
-  (* Read rc *)
-  (* XXX Forcing evaluation of lazy value Const.rc_file before it is
-   *   necessary *)
-  let name : string = Option.value ~default:(Lazy.force !Const.rc_file) rc_name
-  in
-  let rc =  File_com.init_rc ~rc:(Lazy.return name) () in
-
-  let rc_in_tmp = get_log ~rc_tmp:(Assoc.find tmp.Tmp_biniou_t.rc name
+  let rc = Rc.init ?rc:rc_name () in
+  let rc_in_tmp = get_log ~rc_tmp:(Assoc.find tmp.Tmp_biniou_t.rc rc#get_name
                                    |> Option.value ~default:[])
   in
-  map rc.Settings_t.progs ~f:(fun key ->
+  map rc#entries ~f:(fun entry ->
+         let key = entry#command in
          Assoc.find rc_in_tmp key
          |> Option.value ~default:0
-         |> (function number -> (key,number)))
+         |> (function number -> (entry, number)))
+;;
+
+(* Get (may transform an existing log) number of launch for each command in rc file, as follow:
+ * (command:string, number of launch for the command:int) list *)
+let get_accurate_log ?entry_log ~tmp () =
+  let entry_log =
+    match entry_log with
+    | None -> get_accurate_log_complete ~tmp ()
+    | Some log -> log
+  in
+  entry_log |>
+  List.map ~f:(fun (entry, nb_of_launch) -> (entry#command, nb_of_launch))
 ;;
 
 (* Reset number of launch for a given command
  * cmd: number of the command to be reseted
  * num: number to reset *)
+(* FIXME cmd is not very clear for a command number *)
 let reset_cmd ~rc num cmd =
   (* Debugging *)
   [(num,"num") ; (cmd,"cmd")]
@@ -177,9 +192,9 @@ let reset_cmd ~rc num cmd =
   let ac_log = get_accurate_log ~tmp:(init ()) () in
   (* The command (string) corresponding to the number *)
   let cmd_str =
-    File_com.num_cmd2cmd ~rc cmd
+    rc#entry ~n:cmd
     |> function
-      Some s -> s
+      Some s -> s#command
     | None -> failwith "Out of bound"
   in
 
@@ -199,7 +214,7 @@ let reset_cmd ~rc num cmd =
 
 (* Reset all commands to a number
  * num: number to reset *)
-let reset2num ~rc num =
+let reset2num num =
   (* Debugging *)
   "Num: " ^ (Int.to_string num)
   |> Messages.debug;

+ 10 - 3
src/tmp_file.mli

@@ -43,10 +43,17 @@ val init : unit -> t
 val verify_key_exist : key:'a -> 'a -> bool
 val is_prog_in_rc : 'a list -> 'a -> bool
 val log : cmd:string -> ?func:(int -> int) -> unit -> unit
+
 (** Return current state *)
 val get_current : unit -> int
-val get_accurate_log : ?rc_name:string -> tmp:t -> unit -> (string * int) list
+
+(* Accurate logs *)
+type accurate_log = (Rc.entry * int) list
+type accurate_log_simple = (string * int) list
+val get_accurate_log_complete : ?rc_name:string lazy_t -> tmp:t -> unit -> accurate_log
+val get_accurate_log : ?entry_log:accurate_log -> tmp:t -> unit -> accurate_log_simple
+
 (* Resetting command *)
-val reset_cmd : rc:Settings_t.rc_file -> int -> int -> unit
-val reset2num : rc:Settings_t.rc_file -> int -> unit
+val reset_cmd : rc:Rc.t -> int -> int -> unit
+val reset2num : int -> unit
 val reset_all : unit -> unit

+ 4 - 0
src/tools.ml

@@ -86,3 +86,7 @@ let spy1_log (log : (string * int) list) =
 let spy1_rc rc =
   failwith "Not implemented"
 ;;
+
+(* It's simpler to define strings (for instance in the test) and convert it to
+ * entry then *)
+let to_entry command = new Rc.entry command;;

+ 1 - 0
src/tools.mli

@@ -44,3 +44,4 @@ val spy1_float : float -> float
 val spy1_list : f:('a -> string)-> 'a list -> 'a list
 val spy1_log : (string * int) list -> (string * int) list
 val spy1_rc : 'a -> 'a
+val to_entry : string -> Rc.entry

+ 7 - 8
src/unify.ml

@@ -48,7 +48,7 @@ open Core.Std;;
 let make_uniq dubbled_entries =
   let seen = ref [] in (* Entries already added *)
   List.(filter dubbled_entries ~f:(fun entry ->
-         (exists !seen ~f:(fun in_seen -> in_seen = entry)) |> function
+         (exists !seen ~f:(fun in_seen -> in_seen#equal entry)) |> function
          | false -> (* Entry not already seen, keep it *)
            seen := (entry :: !seen); true
          (* Already kept, discard *)
@@ -62,12 +62,12 @@ let prettify_cmd cmds =
   let without_lr =
     (* Removing line return, and trailing spaces, at the end or
        at the start of a command *)
-    List.filter_map cmds ~f:(fun str ->
-           trim str |> function
+    List.filter_map cmds ~f:(fun entry ->
+           trim entry#command |> function
            | "" ->
              Messages.debug "Trimmed command";
              None
-           | s -> Some s)
+           | s -> Some ((entry#change_command s)))
   in
 
   (* Remove doubled entries *)
@@ -85,10 +85,9 @@ let prettify_cmd cmds =
 (* Removing doubled entries (cmds). We need to remove carriage return before
  * deduplicating, since they don't need to be in rc file, and the first one
  * would be kept during deduplication. *)
-let prettify rc_file =
-  let cmds = rc_file.Settings_v.progs in
+let prettify (rc:Rc.t) =
+  let cmds = rc#entries in
   let unique = prettify_cmd cmds in
-  (* Store the deduplicated list in new rc_file *)
-  {rc_file with Settings_v.progs = unique}
+  rc#change_entries unique
 ;;
 

+ 3 - 3
src/unify.mli

@@ -36,6 +36,6 @@
 
 open Core.Std;;
 
-val make_uniq : 'a list -> 'a list
-val prettify_cmd : string list -> string list
-val prettify : Settings_t.rc_file -> Settings_t.rc_file
+val make_uniq : (< equal : 'a -> bool; .. > as 'a) list -> 'a list
+val prettify_cmd : Rc.entry list -> Rc.entry list
+val prettify : Rc.t -> Rc.t

+ 1 - 1
test.sh

@@ -1,4 +1,4 @@
 #!/bin/bash
 
 # Some script to test the behavior of the program with custom rc file
-OC_TMP=/tmp/v033 OC_RC="./dev.json" OC_VERB=5 ./oclaunch.native $*
+OC_TMP=/tmp/v033 OC_RC="./dev.scm" OC_VERB=5 ./oclaunch.native $*