Parcourir la source

Implement write method

 + Should work without tag and settings
 + Updated automatically object part of the mli
 + Improve a comment
Leo il y a 8 ans
Parent
commit
374cab37b5
2 fichiers modifiés avec 65 ajouts et 18 suppressions
  1. 41 7
      src/rc.ml
  2. 24 11
      src/rc.mli

+ 41 - 7
src/rc.ml

@@ -68,7 +68,15 @@ let basic_template =
   "((entries())(common_tags())(settings()))"
 ;;
 
-(* XXX Module exposing functions (hidden by the mli file) for tests *)
+(* 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
   val basic_rc_of_sexp : Sexp.t -> basic_rc
   val basic_template : string
@@ -114,6 +122,16 @@ let rec get_basic rc_name =
     |> basic_rc_of_sexp
 ;;
 
+(* 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 *)
 let object_of_tag tag = failwith "TODO"
 (* object
@@ -127,6 +145,8 @@ let object_of_tag_list =
 let object_of_entry object_common_tags entry = object
   val command = entry.command;
   val tags = (object_of_tag_list entry.tags) @ object_common_tags
+  method command = command
+  method tags = tags
 end;;
 let object_of_setting setting = failwith "TODO";;
 
@@ -134,12 +154,6 @@ 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)
-  (* Name of rc file when written to disk *)
-  val name = Lazy.force rc
-  method change_name new_name = {< name = new_name >}
-  (* Write rc file *)
-  method write = failwith "Not implemented"
-
   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
@@ -170,6 +184,26 @@ object (self)
     self#filter_map_common_tags ~f:(fun e -> f e; Some e)
   method read_settings ~f =
     self#filter_map_settings ~f:(fun e -> f e; 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 ] 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;;
 
 (*

+ 24 - 11
src/rc.mli

@@ -36,7 +36,7 @@
 
 open Core.Std;;
 
-(* TODO Add all but basic_template, create_basic, get_basic, *)
+(* TODO Add all but basic_template, create_basic, get_basic, rc_header *)
 
 (* XXX Temporal, to be removed *)
 type basic_tag = { name : string; arguments : string list; }
@@ -61,20 +61,33 @@ module Test :
 val welcome_msg : string
 val create_basic : string -> unit
 val get_basic : string -> basic_rc
+val tag_of_object : 'a -> 'b
+val setting_of_object : 'a -> 'b
+val entry_of_object : < command : string; tags : 'a list; .. > -> basic_entry
 val object_of_tag : 'a -> 'b
 val object_of_tag_list : 'a list -> 'b list
-val object_of_entry : 'a list -> basic_entry -> <  >
+val object_of_entry :
+  'a list -> basic_entry -> < command : string; tags : 'a list >
 val object_of_setting : 'a -> 'b
 val init :
   ?rc:string lazy_t ->
-  (< add_common_tag : 'b -> 'a; add_common_tags : 'b list -> 'a;
-     change_entry : int -> f:(<  > option -> <  >) -> 'a;
-     change_name : string -> 'a; change_setting : 'c -> f:'d -> 'e;
-     common_tags : 'b list; entries : <  > list;
-     entry : n:int -> <  > option;
+  (< add_common_tags : 'b list -> 'a;
+     add_entries : < command : string; tags : 'c list > list -> 'a;
+     add_settings : 'd list -> 'a;
+     change_entry : int ->
+                    f:(< command : string; tags : 'c list > ->
+                       < command : string; tags : 'c list >) ->
+                    'a;
+     change_name : string -> 'a;
+     entry : n:int -> < command : string; tags : 'c list > option;
      filter_map_common_tags : f:('b -> 'b option) -> 'a;
-     filter_map_entries : f:(<  > -> <  > option) -> 'a;
-     filter_map_settings : f:('f -> 'f option) -> 'a; settings : 'f list;
-     write : 'g >
+     filter_map_entries : f:(int ->
+                             < command : string; tags : 'c list > ->
+                             < command : string; tags : 'c list >
+                             option) ->
+                          'a;
+     filter_map_settings : f:('d -> 'd option) -> 'a;
+     get_name : string; read_common_tags : f:('b -> unit) -> 'a;
+     read_settings : f:('d -> unit) -> 'a; remove_entry : int -> 'a;
+     write : unit >
    as 'a)
-