|
@@ -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 *)
|