Browse Source

Improved rc file methods

 + Add some to map without filtering.
 + Add method to get list of objects, easier to use for instance to
 display a list of command by extracting what you need from entries.
 + Create type for brevity and clarity.

 + Compiles with warnings, need to be fixed.
 + Values in mli file should be there to stay, even though they need
 comment.
 + Make failwith all the same.
Leo 8 years ago
parent
commit
a1b855a411
2 changed files with 135 additions and 103 deletions
  1. 102 55
      src/rc.ml
  2. 33 48
      src/rc.mli

+ 102 - 55
src/rc.ml

@@ -78,10 +78,12 @@ let rc_header =
 
 (* XXX Module exposing functions hidden by the mli file for tests *)
 module Test : sig
-  val basic_rc_of_sexp : Sexp.t -> basic_rc
+  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;;
@@ -133,7 +135,40 @@ let entry_of_object entry =
 ;;
 
 (* Now transformed objects *)
-let object_of_tag tag = failwith "TODO"
+
+(* Create class for tags to extend it easier *)
+class tag name arg = object
+  val name : string = name
+  val arguments : string = arg
+end;;
+
+(* Types of objects, exposed *)
+type entry = < command : string; tags : tag list >;;
+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_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
@@ -148,63 +183,75 @@ let object_of_entry object_common_tags entry = object
   method command = command
   method tags = tags
 end;;
-let object_of_setting setting = failwith "TODO";;
+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
-
-  (* 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 >}
-
-  (* Shorthand *)
-  method change_entry n ~f =
-    self#filter_map_entries ~f:(fun i e -> if i=n then Some (f e) else Some e)
-  method remove_entry n =
-    self#filter_map_entries ~f:(fun i e -> if i=n then None else Some e)
-  method read_common_tags ~f =
-    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 ; "\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;;
+  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
+
+    (* 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;;
 
 (*
    (* Tools to create new tag *)

+ 33 - 48
src/rc.mli

@@ -38,56 +38,41 @@ open Core.Std;;
 
 (* 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; }
-val basic_tag_of_sexp : Sexplib.Type.t -> basic_tag
-val sexp_of_basic_tag : basic_tag -> Sexplib.Type.t
-type basic_entry = { command : string; tags : basic_tag list; }
-val basic_entry_of_sexp : Sexplib.Type.t -> basic_entry
-val sexp_of_basic_entry : basic_entry -> Sexplib.Type.t
-type basic_rc = {
-  entries : basic_entry list;
-  common_tags : basic_tag list;
-  settings : string list;
-}
-val basic_rc_of_sexp : Sexplib.Type.t -> basic_rc
-val sexp_of_basic_rc : basic_rc -> Sexplib.Type.t
-val basic_template : string
 module Test :
   sig
-    val basic_rc_of_sexp : Sexp.t -> basic_rc
+    type basic_rc_t
+    val basic_rc_of_sexp : Sexp.t -> basic_rc_t
     val basic_template : string
   end
+
 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 -> < command : string; tags : 'a list >
-val object_of_setting : 'a -> 'b
-val init :
-  ?rc:string lazy_t -> unit ->
-  (< 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:(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)
+
+(* TODO Improve documentation *)
+class tag :
+  string -> string -> object val arguments : string val name : string end
+type entry = < command : string; tags : tag list >
+type setting = < key : string; value : string >;;
+type t = <
+  entries : entry list;
+  common_tags : tag list;
+  settings : setting list;
+  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