Changed tmp file format

 - Adapted some file
 - Used an exception for a function, will be removed later
 - Some warnings reminds

>  File "src/tmp_file.ml", line 131, characters 50-52:
>  Warning 40: rc was selected from type Tmp_biniou_b.tmp_file.t
>  is not visible in the current scope, and will not
>  be selected if the type becomes unknown.

>  File "src/tmp_file.ml", line 159, characters 12-43:
>  Warning 5: this function application is partial,
>  maybe some arguments are missing.

TODO.md

@@ -35,6 +35,7 @@
  + Documentation ;-)
  + Handle errors in reading rc file
  + Return error code when necessary
+ + Log duration of commands, ignore some return code
 
 ## Long term
  + Translate displayed messages.

src/default.ml

@@ -41,18 +41,21 @@ open Core.Std;;
 
 (* cmd_number is the number of the command the user wants
  * to execute *)
-let run ~rc:rc_content cmd_number =
+let run ~rc cmd_number =
   (* Wait for another oclaunch instance which could launch the same program at
    * the same time *)
   Lock.wait ();
+  let tmp = Tmp_file.init () in
   match cmd_number with
     | None -> begin
         (* Execute each item (one by one) in config file *)
-        let cmd_to_exec = Exec_cmd.what_next ~cmd_list:rc_content.Settings_t.progs in
+        let cmd_to_exec = Exec_cmd.what_next ~rc ~tmp in
         Exec_cmd.execute cmd_to_exec;
       end
     | Some num -> begin
-        let cmd_to_exec = Exec_cmd.num_cmd_to_cmd ~cmd_list:rc_content.Settings_t.progs num in
-          Exec_cmd.execute cmd_to_exec;
+        Exec_cmd.num_cmd_to_cmd ~rc num
+        |> function
+            | None -> Messages.warning "Your number is out of bound"
+            | Some cmd_to_exec -> Exec_cmd.execute cmd_to_exec;
       end
 ;;

src/exec_cmd.ml

@@ -45,26 +45,41 @@ let set_title new_title =
     |> Messages.warning
 ;;
 
-(* Function to return the corresponding command to a number *)
-let num_cmd_to_cmd ~cmd_list number =
-  (* List.nth return None if out of the list *)
-  List.nth cmd_list number
-  |> function
-      (* If in range of the list, return the corresponding command else return
-       * an empty string after displaying error. *)
-      | Some x -> set_title x; x
-      | None ->
-          Messages.ok "All has been launched!";
-          Messages.tips "You can reset with '-r'";
-          (* Return empty string *)
-          ""
+(* Function to return the less launched command, at least the first one *)
+(* TODO Test it *)
+(* Log is a list of entry (commands) asociated with numbers *)
+let less_launched (log : (string * int) list) =
+  let max = 1 in (* Number of maunch, maximum TODO set it in const & rc file *)
+  (* Return smallest, n is the smaller key *)
+  let entries_by_number = List.Assoc.inverse log  in
+    List.min_elt ~cmp:(fun (n,_) (n',_) -> Int.compare n n') entries_by_number
+    |> (function Some (min,cmd) ->
+        if min < max
+        then Some cmd
+        else None
+      | None -> assert false) (* XXX Use exception here? *)
+;;
+
+(* Get the command corresponding to a number *)
+let num_cmd_to_cmd ~rc n =
+  List.nth rc.Settings_t.progs n
 ;;
 
 (* Function to determinate what is the next command to
  * execute. It takes the current number from tmp file. *)
-let what_next ~cmd_list =
-  let tmp_file = Tmp_file.init () in
-  num_cmd_to_cmd ~cmd_list:cmd_list tmp_file.Tmp_biniou_t.number
+let what_next ~rc ~tmp =
+  Tmp_file.get_accurate_log ~rc ~tmp
+  (* Find the less launched, with order *)
+  |> less_launched
+  |> function
+    (* If in range of the list, return the corresponding command else return
+     * an empty string after displaying error. *)
+    | Some x -> set_title x; x
+    | None ->
+        Messages.ok "All has been launched!";
+        Messages.tips "You can reset with '-r'";
+        (* Return empty string *)
+        ""
 ;;
 
 (* Display an error message if command can't run
@@ -81,7 +96,7 @@ let display_result command status =
 
 (* Execute some command and log it *)
 let execute ?(display=true) cmd =
-    Tmp_file.log ~func:((+) 1) ();
+    Tmp_file.log ~cmd ~func:((+) 1) ();
     if display then
         Messages.ok cmd;
     (* We can remove lock file since number in tmp_file has been incremented *)

src/tmp_biniou.atd

@@ -39,7 +39,14 @@
  * place, get faster parsing and make harder manual, unwanted modification. A special command line is
  * available to change current number *)
 
+(* Store values from the configuration file *)
+type rc_entry = {
+    commands: (string * int); (* A list of command, with current number, i.e. number
+    of launches *)
+}
+
+(* Source of the file *)
 type tmp_file = {
-    command: string list; (* A list of command, for future use *)
-    number: int; (* The current number/state of the launches *)
+    rc: rc_entry list; (* A list of rc files *)
+    daemon: int; (* The current state of the daemon, maybe by pid *)
 }

src/tmp_biniou_b.ml

@@ -1,14 +1,125 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = Tmp_biniou_t.tmp_file = { command: string list; number: int }
+type rc_entry = Tmp_biniou_t.rc_entry = { commands: (string * int) }
 
+type tmp_file = Tmp_biniou_t.tmp_file = { rc: rc_entry list; daemon: int }
+
+let rc_entry_tag = Bi_io.record_tag
+let write_untagged_rc_entry : Bi_outbuf.t -> rc_entry -> unit = (
+  fun ob x ->
+    Bi_vint.write_uvint ob 1;
+    Bi_outbuf.add_char4 ob '\190' 'U' '\176' '\200';
+    (
+      fun ob x ->
+        Bi_io.write_tag ob Bi_io.tuple_tag;
+        Bi_vint.write_uvint ob 2;
+        (
+          let x, _ = x in (
+            Bi_io.write_string
+          ) ob x
+        );
+        (
+          let _, x = x in (
+            Bi_io.write_svint
+          ) ob x
+        );
+    ) ob x.commands;
+)
+let write_rc_entry ob x =
+  Bi_io.write_tag ob Bi_io.record_tag;
+  write_untagged_rc_entry ob x
+let string_of_rc_entry ?(len = 1024) x =
+  let ob = Bi_outbuf.create len in
+  write_rc_entry ob x;
+  Bi_outbuf.contents ob
+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 bits0 = ref 0 in
+        let len = Bi_vint.read_uvint ib in
+        for i = 1 to len do
+          match Bi_io.read_field_hashtag ib with
+            | 1045803208 ->
+              field_commands := (
+                (
+                  fun ib ->
+                    if Bi_io.read_tag ib <> 20 then Ag_ob_run.read_error_at ib;
+                    let len = Bi_vint.read_uvint ib in
+                    if len < 2 then Ag_ob_run.missing_tuple_fields len [ 0; 1 ];
+                    let x0 =
+                      (
+                        Ag_ob_run.read_string
+                      ) ib
+                    in
+                    let x1 =
+                      (
+                        Ag_ob_run.read_int
+                      ) ib
+                    in
+                    for i = 2 to len - 1 do Bi_io.skip ib done;
+                    (x0, x1)
+                ) ib
+              );
+              bits0 := !bits0 lor 0x1;
+            | _ -> Bi_io.skip ib
+        done;
+        if !bits0 <> 0x1 then Ag_ob_run.missing_fields [| !bits0 |] [| "commands" |];
+        (
+          {
+            commands = !field_commands;
+          }
+         : rc_entry)
+)
+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 bits0 = ref 0 in
+    let len = Bi_vint.read_uvint ib in
+    for i = 1 to len do
+      match Bi_io.read_field_hashtag ib with
+        | 1045803208 ->
+          field_commands := (
+            (
+              fun ib ->
+                if Bi_io.read_tag ib <> 20 then Ag_ob_run.read_error_at ib;
+                let len = Bi_vint.read_uvint ib in
+                if len < 2 then Ag_ob_run.missing_tuple_fields len [ 0; 1 ];
+                let x0 =
+                  (
+                    Ag_ob_run.read_string
+                  ) ib
+                in
+                let x1 =
+                  (
+                    Ag_ob_run.read_int
+                  ) ib
+                in
+                for i = 2 to len - 1 do Bi_io.skip ib done;
+                (x0, x1)
+            ) ib
+          );
+          bits0 := !bits0 lor 0x1;
+        | _ -> Bi_io.skip ib
+    done;
+    if !bits0 <> 0x1 then Ag_ob_run.missing_fields [| !bits0 |] [| "commands" |];
+    (
+      {
+        commands = !field_commands;
+      }
+     : rc_entry)
+)
+let rc_entry_of_string ?pos s =
+  read_rc_entry (Bi_inbuf.from_string ?pos s)
 let _1_tag = Bi_io.array_tag
 let write_untagged__1 = (
   Ag_ob_run.write_untagged_list
-    Bi_io.string_tag
+    rc_entry_tag
     (
-      Bi_io.write_untagged_string
+      write_untagged_rc_entry
     )
 )
 let write__1 ob x =
@@ -20,12 +131,12 @@ let string_of__1 ?(len = 1024) x =
   Bi_outbuf.contents ob
 let get__1_reader = (
   Ag_ob_run.get_list_reader (
-    Ag_ob_run.get_string_reader
+    get_rc_entry_reader
   )
 )
 let read__1 = (
   Ag_ob_run.read_list (
-    Ag_ob_run.get_string_reader
+    get_rc_entry_reader
   )
 )
 let _1_of_string ?pos s =
@@ -34,14 +145,14 @@ let tmp_file_tag = Bi_io.record_tag
 let write_untagged_tmp_file : Bi_outbuf.t -> tmp_file -> unit = (
   fun ob x ->
     Bi_vint.write_uvint ob 2;
-    Bi_outbuf.add_char4 ob '\129' 'm' 'q' 'K';
+    Bi_outbuf.add_char4 ob '\128' '\000' 'c' '\177';
     (
       write__1
-    ) ob x.command;
-    Bi_outbuf.add_char4 ob '\161' 'z' '\134' '\201';
+    ) ob x.rc;
+    Bi_outbuf.add_char4 ob '\152' '\163' '\253' '\132';
     (
       Bi_io.write_svint
-    ) ob x.number;
+    ) ob x.daemon;
 )
 let write_tmp_file ob x =
   Bi_io.write_tag ob Bi_io.record_tag;
@@ -54,21 +165,21 @@ let get_tmp_file_reader = (
   fun tag ->
     if tag <> 21 then Ag_ob_run.read_error () else
       fun ib ->
-        let field_command = ref (Obj.magic 0.0) in
-        let field_number = ref (Obj.magic 0.0) in
+        let field_rc = ref (Obj.magic 0.0) in
+        let field_daemon = ref (Obj.magic 0.0) in
         let bits0 = ref 0 in
         let len = Bi_vint.read_uvint ib in
         for i = 1 to len do
           match Bi_io.read_field_hashtag ib with
-            | 23949643 ->
-              field_command := (
+            | 25521 ->
+              field_rc := (
                 (
                   read__1
                 ) ib
               );
               bits0 := !bits0 lor 0x1;
-            | 561678025 ->
-              field_number := (
+            | 413400452 ->
+              field_daemon := (
                 (
                   Ag_ob_run.read_int
                 ) ib
@@ -76,32 +187,32 @@ let get_tmp_file_reader = (
               bits0 := !bits0 lor 0x2;
             | _ -> Bi_io.skip ib
         done;
-        if !bits0 <> 0x3 then Ag_ob_run.missing_fields [| !bits0 |] [| "command"; "number" |];
+        if !bits0 <> 0x3 then Ag_ob_run.missing_fields [| !bits0 |] [| "rc"; "daemon" |];
         (
           {
-            command = !field_command;
-            number = !field_number;
+            rc = !field_rc;
+            daemon = !field_daemon;
           }
          : tmp_file)
 )
 let read_tmp_file = (
   fun ib ->
     if Bi_io.read_tag ib <> 21 then Ag_ob_run.read_error_at ib;
-    let field_command = ref (Obj.magic 0.0) in
-    let field_number = ref (Obj.magic 0.0) in
+    let field_rc = ref (Obj.magic 0.0) in
+    let field_daemon = ref (Obj.magic 0.0) in
     let bits0 = ref 0 in
     let len = Bi_vint.read_uvint ib in
     for i = 1 to len do
       match Bi_io.read_field_hashtag ib with
-        | 23949643 ->
-          field_command := (
+        | 25521 ->
+          field_rc := (
             (
               read__1
             ) ib
           );
           bits0 := !bits0 lor 0x1;
-        | 561678025 ->
-          field_number := (
+        | 413400452 ->
+          field_daemon := (
             (
               Ag_ob_run.read_int
             ) ib
@@ -109,11 +220,11 @@ let read_tmp_file = (
           bits0 := !bits0 lor 0x2;
         | _ -> Bi_io.skip ib
     done;
-    if !bits0 <> 0x3 then Ag_ob_run.missing_fields [| !bits0 |] [| "command"; "number" |];
+    if !bits0 <> 0x3 then Ag_ob_run.missing_fields [| !bits0 |] [| "rc"; "daemon" |];
     (
       {
-        command = !field_command;
-        number = !field_number;
+        rc = !field_rc;
+        daemon = !field_daemon;
       }
      : tmp_file)
 )

src/tmp_biniou_b.mli

@@ -1,7 +1,45 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = Tmp_biniou_t.tmp_file = { command: string list; number: int }
+type rc_entry = Tmp_biniou_t.rc_entry = { commands: (string * int) }
+
+type tmp_file = Tmp_biniou_t.tmp_file = { rc: rc_entry list; daemon: int }
+
+(* Writers for type rc_entry *)
+
+val rc_entry_tag : Bi_io.node_tag
+  (** Tag used by the writers for type {!rc_entry}.
+      Readers may support more than just this tag. *)
+
+val write_untagged_rc_entry :
+  Bi_outbuf.t -> rc_entry -> unit
+  (** Output an untagged biniou value of type {!rc_entry}. *)
+
+val write_rc_entry :
+  Bi_outbuf.t -> rc_entry -> unit
+  (** Output a biniou value of type {!rc_entry}. *)
+
+val string_of_rc_entry :
+  ?len:int -> rc_entry -> string
+  (** Serialize a value of type {!rc_entry} into
+      a biniou string. *)
+
+(* Readers for type rc_entry *)
+
+val get_rc_entry_reader :
+  Bi_io.node_tag -> (Bi_inbuf.t -> rc_entry)
+  (** Return a function that reads an untagged
+      biniou value of type {!rc_entry}. *)
+
+val read_rc_entry :
+  Bi_inbuf.t -> rc_entry
+  (** Input a tagged biniou value of type {!rc_entry}. *)
+
+val rc_entry_of_string :
+  ?pos:int -> string -> rc_entry
+  (** Deserialize a biniou value of type {!rc_entry}.
+      @param pos specifies the position where
+                 reading starts. Default: 0. *)
 
 (* Writers for type tmp_file *)
 

src/tmp_biniou_t.ml

@@ -1,4 +1,6 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = { command: string list; number: int }
+type rc_entry = { commands: (string * int) }
+
+type tmp_file = { rc: rc_entry list; daemon: int }

src/tmp_biniou_t.mli

@@ -1,4 +1,6 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = { command: string list; number: int }
+type rc_entry = { commands: (string * int) }
+
+type tmp_file = { rc: rc_entry list; daemon: int }

src/tmp_biniou_v.ml

@@ -1,19 +1,30 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = Tmp_biniou_t.tmp_file = { command: string list; number: int }
+type rc_entry = Tmp_biniou_t.rc_entry = { commands: (string * int) }
 
+type tmp_file = Tmp_biniou_t.tmp_file = { rc: rc_entry list; daemon: int }
+
+let validate_rc_entry : _ -> rc_entry -> _ = (
+  fun _ _ -> None
+)
 let validate__1 = (
   fun _ _ -> None
 )
 let validate_tmp_file : _ -> tmp_file -> _ = (
   fun _ _ -> None
 )
+let create_rc_entry 
+  ~commands
+  () : rc_entry =
+  {
+    commands = commands;
+  }
 let create_tmp_file 
-  ~command
-  ~number
+  ~rc
+  ~daemon
   () : tmp_file =
   {
-    command = command;
-    number = number;
+    rc = rc;
+    daemon = daemon;
   }

src/tmp_biniou_v.mli

@@ -1,11 +1,22 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
-type tmp_file = Tmp_biniou_t.tmp_file = { command: string list; number: int }
+type rc_entry = Tmp_biniou_t.rc_entry = { commands: (string * int) }
+
+type tmp_file = Tmp_biniou_t.tmp_file = { rc: rc_entry list; daemon: int }
+
+val create_rc_entry :
+  commands: (string * int) ->
+  unit -> rc_entry
+  (** Create a record of type {!rc_entry}. *)
+
+val validate_rc_entry :
+  Ag_util.Validation.path -> rc_entry -> Ag_util.Validation.error option
+  (** Validate a value of type {!rc_entry}. *)
 
 val create_tmp_file :
-  command: string list ->
-  number: int ->
+  rc: rc_entry list ->
+  daemon: int ->
   unit -> tmp_file
   (** Create a record of type {!tmp_file}. *)
 

src/tmp_file.ml

@@ -69,7 +69,8 @@ let rec read () =
 
 (* Function to create the tmp file *)
 and create_tmp_file () =
-    Tmp_biniou_v.create_tmp_file ~command:[] ~number:0 ()
+    (* An empty list, without launchment *)
+    Tmp_biniou_v.create_tmp_file ~daemon:0 ~rc:[] ()
     (* Convert it to biniou *)
     |> write
 ;;
@@ -88,6 +89,13 @@ let rec init () =
       | `Yes -> read ()
 ;;
 
+(* Get a log of values from the tmp file, like this
+ * (cmd,number of launch) list *)
+let get_log ~rc =
+  List.map ~f:(fun { Tmp_biniou_t.commands = (cmd,number) } ->
+        (cmd,number)) rc
+;;
+
 (* Verify that the value exist *)
 let verify_key_exist ~key entry =
     if entry = key then
@@ -105,20 +113,27 @@ let rec is_prog_in_rc list_from_rc_file program =
 ;;
 
 (* Log when a program has been launched in a file in /tmp
-   ~func is the function applied to the value *)
-let log ?(func= (+) 1 ) () =
+   ~func is the function applied to the value
+   ~cmd is the launched entry *)
+let log ~cmd ?(func= (+) 1 ) () =
   (* Make sure that file exists, otherwise strange things appears *)
   let file = init () in
+  (* Function to generate the new list with right number *)
+  let new_li ( li : Tmp_biniou_t.rc_entry list ) =
+    let open List.Assoc in
+    (* Only number of launchment associated with commands *)
+    let l = get_log li in
+    find l cmd
+      |> (function None -> add l cmd 0 | Some n -> add l cmd (func n)) (* XXX Using 0 as default value *)
+      |> List.map ~f:(fun e -> { Tmp_biniou_t.commands = e})
+    in
   (* Write the file with the new value *)
-  write { file with Tmp_biniou_t.number = (func file.Tmp_biniou_t.number)}
+  write { file with Tmp_biniou_t.rc = new_li file.rc }
 ;;
 
 (* Return current number *)
 let get_current () =
-    (* Read tmp file *)
-    let tmp_file = init () in
-    (* Return the number *)
-    tmp_file.Tmp_biniou_t.number;
+    failwith "Deprecated"
 ;;
 
 (* Reset command number in two ways :
@@ -145,3 +160,15 @@ let reset cmd_num =
             sprintf "Tmp file reseted to %i" n |> Messages.ok
     | _ -> Messages.warning "Invalid number"
 ;;
+
+(* Get number of launchment for each command in rc file *)
+let get_accurate_log ~rc ~tmp =
+  let open List in
+  let rc_in_tmp = get_log tmp.Tmp_biniou_t.rc in
+  map rc.Settings_t.progs ~f:(fun key ->
+        Assoc.find rc_in_tmp key
+    |> Option.value ~default:0
+    |> (function number -> (key,number)))
+;;
+
+

src/tmp_file.mli

@@ -42,7 +42,8 @@ val init : unit -> t
 
 val verify_key_exist : key:'a -> 'a -> bool
 val is_prog_in_rc : 'a list -> 'a -> bool
-val log : ?func:(int -> int) -> unit -> unit
+val log : cmd:string -> ?func:(int -> int) -> unit -> unit
 (** Return current state *)
 val get_current : unit -> int
 val reset : int -> unit
+val get_accurate_log : rc:Settings_t.rc_file -> tmp:t -> (string * int) list

test.sh

@@ -2,4 +2,4 @@
 
 # Some script to test the behavior of the programe with custom rc file
 
-./oclaunch.native -v 5 --rc ./dev.json $*
+OC_TMP=/tmp/v033 ./oclaunch.native -v 5 --rc ./dev.json $*