Commit 46944819 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Dependency to ocf removed

parent 6a31f296
; -*-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:
......
# 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)
......
......@@ -22,7 +22,6 @@ depends: [
"cairo2"
"yojson"
"easy-format"
"ocf"
]
dev-repo: "git+https://gitlab.inria.fr/ACG/dev/ACGtk.git"
......
1.5.0
\ No newline at end of file
1.5.1
\ No newline at end of file
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"
......
1.5.0
\ No newline at end of file
1.5.1
\ No newline at end of file
......@@ -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)
......
......@@ -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
......
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) ->
......@@ -98,25 +34,86 @@ let default_map =
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
{bg=bg;
node=node_color;
engines=engines}
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
| 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
| Ocf.Error e -> let () = Printf.fprintf stderr "Ocf error: %s\n%!" (Ocf.string_of_error e) in default
| 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
let engines {engines} = engines
......@@ -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)
)
......
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@]@.@?"
......@@ -17,4 +17,4 @@
(* *)
(**************************************************************************)
let version = "1.5.0-20181019"
let version = "1.5.1-20191028"
(** 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")
(** 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment