Dependency to ocf removed

CHANGES

 ; -*-org-*-
+* Version 1.5.1
+** Remove dependency to the ocf package
 * Version 1.5.0
 ** The acgc.opt/acgc compiler and the acg.opt/acg interpreter:
 + Some syntax changes:

CHANGES.md

+# Version 1.5.1
+## Remove dependency to the ocf package
+
 # Version 1.5.0
 ## The acgc.opt/acgc compiler and the acg.opt/acg interpreter:
 * Removed the dependency to BOLT (replaced by Logs) and dypgen (replaced by menhir)

acgtk.opam

@@ -22,7 +22,6 @@ depends: [
   "cairo2"
   "yojson"
   "easy-format"
-  "ocf"
 ]
 
 dev-repo: "git+https://gitlab.inria.fr/ACG/dev/ACGtk.git"

acgtk.version

-1.5.0
+1.5.1
\ No newline at end of file

acgtkLib.install

 lib: [
-  "_build/install/default/lib/acgtkLib/META" {"META"}
+  "_build/install/default/lib/acgtkLib/META"
   "_build/install/default/lib/acgtkLib/acgData/acgData.a" {"acgData/acgData.a"}
   "_build/install/default/lib/acgtkLib/acgData/acgData.cma" {"acgData/acgData.cma"}
   "_build/install/default/lib/acgtkLib/acgData/acgData.cmi" {"acgData/acgData.cmi"}
@@ -98,7 +98,7 @@ lib: [
   "_build/install/default/lib/acgtkLib/datalogLib/persistentArray.mli" {"datalogLib/persistentArray.mli"}
   "_build/install/default/lib/acgtkLib/datalogLib/unionFind.ml" {"datalogLib/unionFind.ml"}
   "_build/install/default/lib/acgtkLib/datalogLib/unionFind.mli" {"datalogLib/unionFind.mli"}
-  "_build/install/default/lib/acgtkLib/dune-package" {"dune-package"}
+  "_build/install/default/lib/acgtkLib/dune-package"
   "_build/install/default/lib/acgtkLib/logic/abstract_syntax.ml" {"logic/abstract_syntax.ml"}
   "_build/install/default/lib/acgtkLib/logic/abstract_syntax.mli" {"logic/abstract_syntax.mli"}
   "_build/install/default/lib/acgtkLib/logic/lambda.ml" {"logic/lambda.ml"}
@@ -131,18 +131,15 @@ lib: [
   "_build/install/default/lib/acgtkLib/logic/typeInference.mli" {"logic/typeInference.mli"}
   "_build/install/default/lib/acgtkLib/logic/varUnionFind.ml" {"logic/varUnionFind.ml"}
   "_build/install/default/lib/acgtkLib/logic/varUnionFind.mli" {"logic/varUnionFind.mli"}
-  "_build/install/default/lib/acgtkLib/opam" {"opam"}
+  "_build/install/default/lib/acgtkLib/opam"
   "_build/install/default/lib/acgtkLib/utilsLib/dependencyManager.ml" {"utilsLib/dependencyManager.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/dependencyManager.mli" {"utilsLib/dependencyManager.mli"}
-  "_build/install/default/lib/acgtkLib/utilsLib/essai_couleurs.ml" {"utilsLib/essai_couleurs.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/focused_list.ml" {"utilsLib/focused_list.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/focused_list.mli" {"utilsLib/focused_list.mli"}
   "_build/install/default/lib/acgtkLib/utilsLib/idGenerator.ml" {"utilsLib/idGenerator.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/idGenerator.mli" {"utilsLib/idGenerator.mli"}
   "_build/install/default/lib/acgtkLib/utilsLib/log.ml" {"utilsLib/log.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/log.mli" {"utilsLib/log.mli"}
-  "_build/install/default/lib/acgtkLib/utilsLib/nonEmptyList.ml" {"utilsLib/nonEmptyList.ml"}
-  "_build/install/default/lib/acgtkLib/utilsLib/nonEmptyList.mli" {"utilsLib/nonEmptyList.mli"}
   "_build/install/default/lib/acgtkLib/utilsLib/sharedForest.ml" {"utilsLib/sharedForest.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/sharedForest.mli" {"utilsLib/sharedForest.mli"}
   "_build/install/default/lib/acgtkLib/utilsLib/table.ml" {"utilsLib/table.ml"}
@@ -163,9 +160,6 @@ lib: [
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__DependencyManager.cmt" {"utilsLib/utilsLib__DependencyManager.cmt"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__DependencyManager.cmti" {"utilsLib/utilsLib__DependencyManager.cmti"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__DependencyManager.cmx" {"utilsLib/utilsLib__DependencyManager.cmx"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Essai_couleurs.cmi" {"utilsLib/utilsLib__Essai_couleurs.cmi"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Essai_couleurs.cmt" {"utilsLib/utilsLib__Essai_couleurs.cmt"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Essai_couleurs.cmx" {"utilsLib/utilsLib__Essai_couleurs.cmx"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Focused_list.cmi" {"utilsLib/utilsLib__Focused_list.cmi"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Focused_list.cmt" {"utilsLib/utilsLib__Focused_list.cmt"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Focused_list.cmti" {"utilsLib/utilsLib__Focused_list.cmti"}
@@ -178,10 +172,6 @@ lib: [
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Log.cmt" {"utilsLib/utilsLib__Log.cmt"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Log.cmti" {"utilsLib/utilsLib__Log.cmti"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Log.cmx" {"utilsLib/utilsLib__Log.cmx"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__NonEmptyList.cmi" {"utilsLib/utilsLib__NonEmptyList.cmi"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__NonEmptyList.cmt" {"utilsLib/utilsLib__NonEmptyList.cmt"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__NonEmptyList.cmti" {"utilsLib/utilsLib__NonEmptyList.cmti"}
-  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__NonEmptyList.cmx" {"utilsLib/utilsLib__NonEmptyList.cmx"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__SharedForest.cmi" {"utilsLib/utilsLib__SharedForest.cmi"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__SharedForest.cmt" {"utilsLib/utilsLib__SharedForest.cmt"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__SharedForest.cmti" {"utilsLib/utilsLib__SharedForest.cmti"}
@@ -202,8 +192,14 @@ lib: [
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Version.cmt" {"utilsLib/utilsLib__Version.cmt"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Version.cmti" {"utilsLib/utilsLib__Version.cmti"}
   "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Version.cmx" {"utilsLib/utilsLib__Version.cmx"}
+  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Warnings.cmi" {"utilsLib/utilsLib__Warnings.cmi"}
+  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Warnings.cmt" {"utilsLib/utilsLib__Warnings.cmt"}
+  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Warnings.cmti" {"utilsLib/utilsLib__Warnings.cmti"}
+  "_build/install/default/lib/acgtkLib/utilsLib/utilsLib__Warnings.cmx" {"utilsLib/utilsLib__Warnings.cmx"}
   "_build/install/default/lib/acgtkLib/utilsLib/version.ml" {"utilsLib/version.ml"}
   "_build/install/default/lib/acgtkLib/utilsLib/version.mli" {"utilsLib/version.mli"}
+  "_build/install/default/lib/acgtkLib/utilsLib/warnings.ml" {"utilsLib/warnings.ml"}
+  "_build/install/default/lib/acgtkLib/utilsLib/warnings.mli" {"utilsLib/warnings.mli"}
 ]
 doc: [
   "_build/install/default/doc/acgtkLib/CHANGES"

acgtkLib.version

-1.5.0
+1.5.1
\ No newline at end of file

src/acg-data/error.mli

@@ -84,7 +84,6 @@ type env_error =
     
 type version_error =  Outdated_version of (string*string)
     
-    
 (** The type for errors *)
 type error = 
 | Parse_error of parse_error * (Lexing.position * Lexing.position)

src/scripting/dune

@@ -61,7 +61,8 @@
   (modules (:standard \ acg io_test))
   (libraries
    cairo2
-   ocf
+   yojson
+   
    utilsLib
    acgData
    grammars
@@ -77,7 +78,6 @@
  (flags (:standard -w -58))
  (libraries
   cairo2
-  ocf
   fmt.tty
   utilsLib
   acgData

src/scripting/rendering_config.ml

 open UtilsLib
 open AcgData
 
-let background = Ocf.(triple ~doc: "Comment: Background color as a triple of int as RGB values" Wrapper.int Wrapper.int Wrapper.int (255,255,255))
-  
-let node_background = Ocf.(triple ~doc: "Comment: Node background color as a triple of int as RGB values" Wrapper.int Wrapper.int Wrapper.int (128,128,128))
-
-
-let color_options =
-  let g = Ocf.add Ocf.group ["background"] background in
-  Ocf.add g ["node-background"] node_background
-
-
-
-let name = Ocf.string ~doc: "Comment: name of the signature" "dummy name"
-let engine = Ocf.string ~doc: "Comment: name of the rendering engine (trees, logic, syntactic) " "DUMMY NAME"
-  
-(* This function defines the group options for signatures. It contains
-   the name of the signatue ("name" option) and its rendering engine
-   ("engine" option*)
-let engine_group =
-  let rendering_option =
-    let g = Ocf.add Ocf.group ["name"] name in
-    Ocf.add g ["engine"] engine in
-  rendering_option
-    
-let engine_group_wrapper =
-  let _default_engine_group = engine_group in
-  Ocf.Wrapper.make
-    Ocf.to_json
-    (fun ?def:g j ->
-      match g with
-      | None ->
-	 let () = Ocf.from_json engine_group j in
-	 let n = Ocf.get name in
-	 let e = Ocf.get engine in
-	 Ocf.(add (add group ["name"] (string n)) ["engine"] (string e))
-      | Some actual_g ->
-	 let () = Printf.printf "Actual Branch\n%!" in
-	 let () = Ocf.from_json actual_g j in actual_g)
-    
-let make_sig_list_options lst =
-  Ocf.(list
-	 ~doc: "List of signatures with a specific rendering engine"
-	 engine_group_wrapper
-	 (List.map (fun (n,e) ->
-	   let () = Ocf.set name n in
-	   let () = Ocf.set engine e in
-	   Ocf.group ) lst))
-
-let sig_options = make_sig_list_options [("dummy","DUMMY")]
-  
-let default_config_group =
-  let g = Ocf.(add_group group ["colors"] color_options) in
-  Ocf.add g ["signatures"] sig_options
-
 
 type engine = STRINGS | LOGIC | DERIVED_TREES | TREES | DEFAULT
 
@@ -68,17 +15,6 @@ let get_engine s =
     
 type config = {bg:int * int * int;node:int*int*int;engines:engine Utils.StringMap.t}
 
-
-let get_sig_engines m =
-  let grp_lst = Ocf.get sig_options in
-  List.fold_left
-    (fun acc g -> 
-      let j = Ocf.to_json g  in
-      let () = Ocf.from_json engine_group j in
-      let n = Ocf.get name in
-      let e = Ocf.get engine in
-      Utils.StringMap.add n (get_engine e) acc) m grp_lst
-
 let default_map =
   List.fold_left
     (fun acc (lst,engine) ->
@@ -99,23 +35,84 @@ let default = {bg=(255,255,255);
 	       node=(239,239,239);
 	       engines=default_map}
 
+            
+let get_color key colors default_col =
+  match Yojson.Basic.Util.([colors] |> filter_member key |> flatten)  with
+  | (`Int r)::(`Int g)::(`Int b)::_ -> (r,g,b)
+  | _ -> default_col
+            
 let get_config filename includes =
   try
     let fullname = Utils.find_file filename includes in
-    let () = Ocf.from_file default_config_group fullname in
-    let bg = Ocf.get background in
-    let node_color = Ocf.get node_background in
-    let engines = get_sig_engines Utils.StringMap.empty in
+    let json_val = Yojson.Safe.(to_basic (from_channel ~fname:fullname (open_in fullname))) in
+    (try 
+      let conf = Yojson.Basic.Util.to_assoc json_val in
+      let signatures = List.assoc_opt "signatures" conf in
+      let engines =
+        match signatures with
+        | None ->
+           let () = Warnings.(issue_warning (Config (Missing_key (fullname,[],"signatures")))) in
+           let () = Warnings.(issue_warning (Config Default_engines)) in
+           default_map
+        | Some signatures ->
+           List.fold_left
+             (fun acc json ->
+               try
+                 let _json_acc = Yojson.Basic.Util.member "name" json in
+                 let _json_acc = Yojson.Basic.Util.member "engine" json in
+                 let sig_name =
+                   try Yojson.Basic.Util.(to_string_option (member "name" json)) with
+                   | Yojson.Basic.Util.Type_error (s,j) ->
+                      let () = Warnings.(issue_warning (Config (Bad_group (fullname,["signatures";"name"],s,j,"A json object string was expected","Skipping this signature name")))) in
+                      None in
+                 let sig_engine =
+                   try Yojson.Basic.Util.(to_string_option (member "engine" json)) with
+                   | Yojson.Basic.Util.Type_error (s,j) ->
+                      let () = Warnings.(issue_warning (Config (Bad_group (fullname,["signatures";"engine"],s,j,"A json object string was expected","Skipping this engine")))) in
+                      None in
+                 match sig_name,sig_engine with
+                 | Some n, Some e ->  Utils.StringMap.add n (get_engine e) acc
+                 | None, Some e ->
+                    let () = Warnings.(issue_warning
+                                         (Config (Missing_name (fullname,["signatures"],"name",e)))) in
+                    acc
+                 | Some n, None ->
+                    let () = Warnings.(issue_warning
+                                         (Config (Missing_engine (fullname,["signatures"],"engine",n)))) in
+                    acc
+                 | _,_ -> acc
+               with
+               | Yojson.Basic.Util.Type_error (s,j) ->
+                  let () = Warnings.(issue_warning (Config (Bad_group (fullname,["signatures"],s,j,"A json object with fields \"name\" and \"engine\" was expected","Skipping this signature name/engine association")))) in
+                  acc)
+             Utils.StringMap.empty
+             (Yojson.Basic.Util.to_list signatures) in
+      let colors = List.assoc_opt "colors" conf in
+      let bg,node_color =
+        match colors with
+        | None ->
+           let () = Warnings.(issue_warning (Config (Missing_key (fullname,[],"colors")))) in
+           let () = Warnings.(issue_warning (Config Default_colors)) in
+           default.bg,default.node
+        | Some colors ->
+           let bg = get_color "background" colors (255,255,255) in
+           let node = get_color "node-background" colors (239,239,239) in
+           bg,node in
       {bg=bg;
        node=node_color;
        engines=engines}
      with 
-  | Ocf.Error e -> let () = Printf.fprintf stderr "Ocf error: %s\n%!" (Ocf.string_of_error e) in default
+     | Yojson.Basic.Util.Type_error (s,j) ->
+        let () = Warnings.(issue_warning (Config (Bad_group (fullname,[],s,j,"A json object with fields \"signatures\" and \"colors\" was expected","Using default signature to engine mapping")))) in
+        default)
+  with
   | Utils.No_file(f,msg) ->
-     let e = Error.System_error (Printf.sprintf "No such file \"%s\" in %s" f msg) in
-     let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
+     let e = Error.System_error (Printf.sprintf "No such file \"%s\" in %s. Using default configuration." f msg) in
+     let () = Logs.err (fun m -> m "Error: %s\n%!" (Error.error_msg e filename)) in
+     default
+  | Yojson.Json_error s ->
+     let () = Warnings.(issue_warning (Config (Json_error s))) in
      default
-       
        
 let background_color {bg} = bg
 let node_color {node} = node

src/utils/dune

@@ -5,21 +5,22 @@
  (name utilsLib)
  (public_name acgtkLib.utilsLib)
  (flags (:standard -w -58))
- (modules (:standard \ test_sharedForest test_dependencyManager))
+ (modules (:standard \ test_sharedForest test_dependencyManager test_couleurs))
  (libraries
   str ; external libraries
   ANSITerminal ; external libraries
   logs
   logs.fmt
   mtime.clock.os
+  yojson
   ))
 
 (tests
- (names test_sharedForest test_dependencyManager)
+ (names test_sharedForest test_dependencyManager test_couleurs)
  (libraries
   fmt.tty
   utilsLib)
- (modules test_sharedForest test_dependencyManager)
+ (modules test_sharedForest test_dependencyManager test_couleurs)
  )
 
 

src/utils/essai_couleurs.ml → src/utils/test_couleurs.ml

-let tag_functions = Format.(pp_get_formatter_tag_functions std_formatter ())
+let tag_functions = Format.(pp_get_formatter_stag_functions std_formatter ())
 
 let () = Format.set_tags true
 
@@ -26,7 +26,7 @@ let open_color c = Printf.sprintf "\027[1;%im" (color_code c)
 
 let close_color = "\027[0m"
 
-let () = Printf.printf "Ceci est un %sessai%s pour voir la couleur\n%!" (open_color Red) close_color
+(*let () = Format.printf "Ceci est un %sessai%s pour voir la couleur\n%!" (open_color Red) close_color *)
 
 let new_print_open_tag t = 
   match t with
@@ -43,19 +43,19 @@ let new_print_close_tag = function
 
 let new_mark_open_tag t = 
   match t with
-  | "sig" -> open_color Green
-  | "lex" -> open_color Red
-  | "tag" -> open_color Blue
+  | Format.String_tag "sig" -> open_color Green
+  | Format.String_tag "lex" -> open_color Red
+  | Format.String_tag "tag" -> open_color Blue
   | _ ->  ""
 
 let new_mark_close_tag = function _ -> close_color
 
-let () = Format.(pp_set_formatter_tag_functions std_formatter
+let () = Format.(pp_set_formatter_stag_functions std_formatter
 						{tag_functions with
 						  (*print_open_tag=new_print_open_tag;
 						  print_close_tag=new_print_close_tag; *)
-						  mark_open_tag=new_mark_open_tag;
-						  mark_close_tag=new_mark_close_tag})
+						  mark_open_stag=new_mark_open_tag;
+						  mark_close_stag=new_mark_close_tag})
 
 
 let () = Format.fprintf Format.std_formatter "@[<v5>@[Voici@ un@ example@ avec :@]@,@[<2>Plusieurs@ @{<tag>tags@}@ pour@ bien@ illustrer@ le@ phénomène@ et@ vérifier@ que@ ça@ marche@ bien@ avec@ une@ phrase@ assez@ longue@ pour@ tenir@ sur@ plusieurs@ lignes@]@,@[une@ @{<sig>signature@}@ tout@ d'abord@]@,@[puis@ un@ @{<lex>lexique@}@ ensuite@]@.@?"

src/utils/version.ml

@@ -17,4 +17,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let version = "1.5.0-20181019"
+let version = "1.5.1-20191028"

src/utils/warnings.ml

+(** This module implements a warning management module *)
+
+type warning =
+   | Config of config_warning
+and config_warning =
+  | Missing_key of (string * string list * string) (* Aimed at providing info
+                                             about incorrect json
+                                             config file. The string
+                                             list is a path to the
+                                             group of the expected key
+                                                    *)
+  | Missing_name of (string * string list * string * string)
+  | Missing_engine of (string * string list * string * string)
+  | Default_engines
+  | Default_colors
+  | Bad_group of (string * string list * string * Yojson.Basic.t * string * string)
+  | Json_error of string
+
+let grp_preamble file path =
+  match path with
+  | [] -> Printf.sprintf "In file \"%s\"" file
+  | path -> Printf.sprintf "In file \"%s\", under the path \"%s\"" file (Utils.string_of_list " -> " (fun x -> x) path)
+
+let issue_warning = function
+  | Config (Missing_key (file,path,key)) ->
+     Logs.warn (fun m -> m "%s, key \"%s\" is missing" (grp_preamble file path) key)
+  | Config (Missing_name (file,path,key,msg)) ->
+     Logs.warn (fun m -> m "%s, key \"%s\" is missing in association with signature engine \"%s\"" (grp_preamble file path) key msg)
+  | Config (Missing_engine (file,path,key,msg)) ->
+     Logs.warn (fun m -> m "%s, key \"%s\" is missing in association with signature name \"%s\"" (grp_preamble file path) key msg)
+  | Config Default_engines -> Logs.warn (fun m -> m "Using default signature to engine mapping")
+  | Config Default_colors -> Logs.warn (fun m -> m "Using default bacground and node colors")
+  | Config (Bad_group (file,path,yojson_msg,json,msg,msg')) ->
+     let () = Logs.warn (fun m -> m "%s, %s" (grp_preamble file path) yojson_msg) in
+     let () = Logs.warn (fun m -> m "%s, but got: \"%s\"" msg (Yojson.Basic.pretty_to_string ~std:true json)) in
+     Logs.warn (fun m -> m "%s" msg')
+  | Config (Json_error msg) -> 
+     let () = Logs.warn (fun m -> m "Json error: %s" msg) in
+     Logs.warn (fun m -> m "Using default configuration")

src/utils/warnings.mli

+(** This module implements a warning management module *)
+
+type warning =
+   | Config of config_warning
+and config_warning =
+  | Missing_key of (string * string list * string) (* Aimed at providing info
+                                             about incorrect json
+                                             config file. The string
+                                             list is a path to the
+                                             group of the expected key
+                                                    *)
+  | Missing_name of (string * string list * string * string)
+  | Missing_engine of (string * string list * string * string)
+  | Default_engines
+  | Default_colors
+  | Bad_group of (string * string list * string * Yojson.Basic.t * string * string)
+  | Json_error of string
+
+val issue_warning : warning -> unit