Allow to use multiple tmp files

 + Updated CHANGELOG, TODO

CHANGELOG.md

@@ -6,8 +6,10 @@
 
  + Fix bug: in special circumstances, it was not possible to write in lock file.
    The program was crashing.
- + Changed tmp file format, the new one would allow more things: running
-   infinite, daemon mode, relaunch after editing...
+ + Changed tmp file format, the new one would allow to do more things:
+   + Restart edited command (reset number of launch)
+   + Support multiple configuration file
+   + For the futur : Running infinite, daemon mode...
 
 ## 0.2.x
 

TODO.md

@@ -11,7 +11,6 @@
     Or send an email to the author !**
 
 ## Major issue
- + Make multiple tmp file really working by using checksum for rc file.
 
 ## Short term
 
@@ -30,6 +29,9 @@
  + Relaunch the terminal detached after (possible -> use $TERM &; it resists to
    program exit)
  + Allow to tag entry and do things according to tags
+   + Make it extensible
+ + Get statistics and collect them : running time, frequency per item, output of
+   the commands...
 
 ### Misc
  + Documentation ;-)
@@ -41,3 +43,6 @@
  + Translate displayed messages.
  + Better command line interface by grouping commands.
  + Use Batteries instead of Core to improve apps size?
+ + Be more carefull with file reading, lazy evaluation (especially in
+   tmp_file.get_accurate_log)
+ + Improve file_com.ml

src/const.mli

@@ -43,7 +43,6 @@ val verbosity : int ref
 val no_color : bool ref
 
 (* Files *)
-val rc_file_default : string Core.Std.Lazy.t
 val rc_file : string Core.Std.Lazy.t ref
 val tmp_file : string
 (* Conf *)

src/default.ml

@@ -49,7 +49,7 @@ let run ~rc cmd_number =
   match cmd_number with
     | None -> begin
         (* Execute each item (one by one) in config file *)
-        let cmd_to_exec = Exec_cmd.what_next ~rc ~tmp in
+        let cmd_to_exec = Exec_cmd.what_next ~tmp in
         Exec_cmd.execute cmd_to_exec;
       end
     | Some num -> begin

src/exec_cmd.ml

@@ -62,8 +62,8 @@ let less_launched (log : (string * int) list) =
 
 (* Function to determinate what is the next command to
  * execute. It takes the current number from tmp file. *)
-let what_next ~rc ~tmp =
-  Tmp_file.get_accurate_log ~rc ~tmp
+let what_next ~tmp =
+  Tmp_file.get_accurate_log ~tmp ()
   (* Find the less launched, with order *)
   |> less_launched
   |> function

src/tmp_biniou.atd

@@ -45,8 +45,10 @@ type rc_entry = {
     of launches *)
 }
 
+type rc_name = string
+
 (* Source of the file *)
 type tmp_file = {
-    rc: rc_entry list; (* A list of rc files *)
+  rc: (rc_name * (rc_entry list)) list; (* A list of rc files *)
     daemon: int; (* The current state of the daemon, maybe by pid *)
 }

src/tmp_biniou_b.ml

@@ -1,10 +1,34 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
+type rc_name = Tmp_biniou_t.rc_name
+
 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 }
+type tmp_file = Tmp_biniou_t.tmp_file = {
+  rc: (rc_name * (rc_entry list)) list;
+  daemon: int
+}
 
+let rc_name_tag = Bi_io.string_tag
+let write_untagged_rc_name = (
+  Bi_io.write_untagged_string
+)
+let write_rc_name ob x =
+  Bi_io.write_tag ob Bi_io.string_tag;
+  write_untagged_rc_name ob x
+let string_of_rc_name ?(len = 1024) x =
+  let ob = Bi_outbuf.create len in
+  write_rc_name ob x;
+  Bi_outbuf.contents ob
+let get_rc_name_reader = (
+  Ag_ob_run.get_string_reader
+)
+let read_rc_name = (
+  Ag_ob_run.read_string
+)
+let rc_name_of_string ?pos s =
+  read_rc_name (Bi_inbuf.from_string ?pos s)
 let rc_entry_tag = Bi_io.record_tag
 let write_untagged_rc_entry : Bi_outbuf.t -> rc_entry -> unit = (
   fun ob x ->
@@ -141,13 +165,110 @@ let read__1 = (
 )
 let _1_of_string ?pos s =
   read__1 (Bi_inbuf.from_string ?pos s)
+let _2_tag = Bi_io.array_tag
+let write_untagged__2 = (
+  Ag_ob_run.write_untagged_list
+    Bi_io.tuple_tag
+    (
+      fun ob x ->
+        Bi_vint.write_uvint ob 2;
+        (
+          let x, _ = x in (
+            write_rc_name
+          ) ob x
+        );
+        (
+          let _, x = x in (
+            fun ob x ->
+              Bi_io.write_tag ob Bi_io.tuple_tag;
+              Bi_vint.write_uvint ob 1;
+              (
+                let x = x in (
+                  write__1
+                ) ob x
+              );
+          ) ob x
+        );
+    )
+)
+let write__2 ob x =
+  Bi_io.write_tag ob Bi_io.array_tag;
+  write_untagged__2 ob x
+let string_of__2 ?(len = 1024) x =
+  let ob = Bi_outbuf.create len in
+  write__2 ob x;
+  Bi_outbuf.contents ob
+let get__2_reader = (
+  Ag_ob_run.get_list_reader (
+    fun tag ->
+      if tag <> 20 then Ag_ob_run.read_error () else
+        fun ib ->
+          let len = Bi_vint.read_uvint ib in
+          if len < 2 then Ag_ob_run.missing_tuple_fields len [ 0; 1 ];
+          let x0 =
+            (
+              read_rc_name
+            ) ib
+          in
+          let x1 =
+            (
+              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 < 1 then Ag_ob_run.missing_tuple_fields len [ 0 ];
+                let x0 =
+                  (
+                    read__1
+                  ) ib
+                in
+                for i = 1 to len - 1 do Bi_io.skip ib done;
+                (x0)
+            ) ib
+          in
+          for i = 2 to len - 1 do Bi_io.skip ib done;
+          (x0, x1)
+  )
+)
+let read__2 = (
+  Ag_ob_run.read_list (
+    fun tag ->
+      if tag <> 20 then Ag_ob_run.read_error () else
+        fun ib ->
+          let len = Bi_vint.read_uvint ib in
+          if len < 2 then Ag_ob_run.missing_tuple_fields len [ 0; 1 ];
+          let x0 =
+            (
+              read_rc_name
+            ) ib
+          in
+          let x1 =
+            (
+              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 < 1 then Ag_ob_run.missing_tuple_fields len [ 0 ];
+                let x0 =
+                  (
+                    read__1
+                  ) ib
+                in
+                for i = 1 to len - 1 do Bi_io.skip ib done;
+                (x0)
+            ) ib
+          in
+          for i = 2 to len - 1 do Bi_io.skip ib done;
+          (x0, x1)
+  )
+)
+let _2_of_string ?pos s =
+  read__2 (Bi_inbuf.from_string ?pos s)
 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 '\128' '\000' 'c' '\177';
     (
-      write__1
+      write__2
     ) ob x.rc;
     Bi_outbuf.add_char4 ob '\152' '\163' '\253' '\132';
     (
@@ -174,7 +295,7 @@ let get_tmp_file_reader = (
             | 25521 ->
               field_rc := (
                 (
-                  read__1
+                  read__2
                 ) ib
               );
               bits0 := !bits0 lor 0x1;
@@ -207,7 +328,7 @@ let read_tmp_file = (
         | 25521 ->
           field_rc := (
             (
-              read__1
+              read__2
             ) ib
           );
           bits0 := !bits0 lor 0x1;

src/tmp_biniou_b.mli

@@ -1,9 +1,50 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
+type rc_name = Tmp_biniou_t.rc_name
+
 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 }
+type tmp_file = Tmp_biniou_t.tmp_file = {
+  rc: (rc_name * (rc_entry list)) list;
+  daemon: int
+}
+
+(* Writers for type rc_name *)
+
+val rc_name_tag : Bi_io.node_tag
+  (** Tag used by the writers for type {!rc_name}.
+      Readers may support more than just this tag. *)
+
+val write_untagged_rc_name :
+  Bi_outbuf.t -> rc_name -> unit
+  (** Output an untagged biniou value of type {!rc_name}. *)
+
+val write_rc_name :
+  Bi_outbuf.t -> rc_name -> unit
+  (** Output a biniou value of type {!rc_name}. *)
+
+val string_of_rc_name :
+  ?len:int -> rc_name -> string
+  (** Serialize a value of type {!rc_name} into
+      a biniou string. *)
+
+(* Readers for type rc_name *)
+
+val get_rc_name_reader :
+  Bi_io.node_tag -> (Bi_inbuf.t -> rc_name)
+  (** Return a function that reads an untagged
+      biniou value of type {!rc_name}. *)
+
+val read_rc_name :
+  Bi_inbuf.t -> rc_name
+  (** Input a tagged biniou value of type {!rc_name}. *)
+
+val rc_name_of_string :
+  ?pos:int -> string -> rc_name
+  (** Deserialize a biniou value of type {!rc_name}.
+      @param pos specifies the position where
+                 reading starts. Default: 0. *)
 
 (* Writers for type rc_entry *)
 

src/tmp_biniou_t.ml

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

src/tmp_biniou_t.mli

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

src/tmp_biniou_v.ml

@@ -1,16 +1,27 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
+type rc_name = Tmp_biniou_t.rc_name
+
 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 }
+type tmp_file = Tmp_biniou_t.tmp_file = {
+  rc: (rc_name * (rc_entry list)) list;
+  daemon: int
+}
 
+let validate_rc_name = (
+  (fun _ _ -> None)
+)
 let validate_rc_entry : _ -> rc_entry -> _ = (
   fun _ _ -> None
 )
 let validate__1 = (
   fun _ _ -> None
 )
+let validate__2 = (
+  fun _ _ -> None
+)
 let validate_tmp_file : _ -> tmp_file -> _ = (
   fun _ _ -> None
 )

src/tmp_biniou_v.mli

@@ -1,9 +1,18 @@
 (* Auto-generated from "tmp_biniou.atd" *)
 
 
+type rc_name = Tmp_biniou_t.rc_name
+
 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 }
+type tmp_file = Tmp_biniou_t.tmp_file = {
+  rc: (rc_name * (rc_entry list)) list;
+  daemon: int
+}
+
+val validate_rc_name :
+  Ag_util.Validation.path -> rc_name -> Ag_util.Validation.error option
+  (** Validate a value of type {!rc_name}. *)
 
 val create_rc_entry :
   commands: (string * int) ->
@@ -15,7 +24,7 @@ val validate_rc_entry :
   (** Validate a value of type {!rc_entry}. *)
 
 val create_tmp_file :
-  rc: rc_entry list ->
+  rc: (rc_name * (rc_entry list)) list ->
   daemon: int ->
   unit -> tmp_file
   (** Create a record of type {!tmp_file}. *)

src/tmp_file.ml

@@ -91,9 +91,9 @@ let rec init () =
 
 (* Get a log of values from the tmp file, like this
  * (cmd,number of launch) list *)
-let get_log ~rc =
+let get_log ~rc_tmp =
   List.map ~f:(fun { Tmp_biniou_t.commands = (cmd,number) } ->
-        (cmd,number)) rc
+        (cmd,number)) rc_tmp
 ;;
 
 (* Verify that the value exist *)
@@ -118,17 +118,25 @@ let rec is_prog_in_rc list_from_rc_file program =
 let log ~cmd ?(func= (+) 1 ) () =
   (* Make sure that file exists, otherwise strange things appears *)
   let file = init () in
+  (* Get rc_file name *)
+  let name = Lazy.force !Const.rc_file in
   (* Function to generate the new list with right number *)
-  let new_li ( li : Tmp_biniou_t.rc_entry list ) =
+  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
+    let l = get_log ~rc_tmp:li in
     find l cmd
       |> (function None -> add l cmd Const.default_launch | Some n -> add l cmd (func n))
       |> List.map ~f:(fun e -> { Tmp_biniou_t.commands = e})
     in
   (* Write the file with the new value *)
-  write Tmp_biniou_t.{ file with rc = new_li file.rc }
+  let updated_li =
+    List.Assoc.(find file.Tmp_biniou_t.rc name)
+      |> Option.value ~default:[]
+      |> new_li
+  in
+  write Tmp_biniou_t.{ file with rc = List.Assoc.add file.rc name
+  updated_li }
 ;;
 
 (* Return current number *)
@@ -136,10 +144,20 @@ let get_current () =
     failwith "Deprecated"
 ;;
 
-(* Get number of launchment for each command in rc file *)
-let get_accurate_log ~rc ~tmp =
+(* Get number of launch for each command in rc file *)
+let get_accurate_log ?rc_name ~tmp () =
   let open List in
-  let rc_in_tmp = get_log tmp.Tmp_biniou_t.rc 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
+    |> Option.value ~default:[])
+  in
   map rc.Settings_t.progs ~f:(fun key ->
         Assoc.find rc_in_tmp key
     |> Option.value ~default:0
@@ -153,7 +171,7 @@ let reset ~rc cmd cmd_num =
     |> List.map ~f:(fun (i , str) -> str ^ ": " ^ (Int.to_string i))
     |> List.iter ~f:(fun s -> Messages.debug s);
 
-  let log' = get_accurate_log ~rc ~tmp:(init ()) in
+  let log' = get_accurate_log ~tmp:(init ()) () in
   (* The command (string) corresponding to the number *)
   let cmd_str = (File_com.num_cmd2cmd ~rc cmd_num |> function Some s -> s
                                   | None -> failwith "Out of bound") in

src/tmp_file.mli

@@ -46,4 +46,4 @@ val log : cmd:string -> ?func:(int -> int) -> unit -> unit
 (** Return current state *)
 val get_current : unit -> int
 val reset : rc:Settings_t.rc_file -> int -> int -> unit
-val get_accurate_log : rc:Settings_t.rc_file -> tmp:t -> (string * int) list
+val get_accurate_log : ?rc_name:string -> tmp:t -> unit -> (string * int) list