diff --git a/src/reference_tree.ml b/src/reference_tree.ml index 0efaf56..874991d 100644 --- a/src/reference_tree.ml +++ b/src/reference_tree.ml @@ -20,6 +20,18 @@ type completion_help_type = | Script of string [@name "script"] [@@deriving yojson] +type doc_hints = { + text: string; + hint_type: string; +} [@@deriving yojson] + +type docs = { + headline: string; + text: string; + usageExample: string; + hints: doc_hints list; +} [@@deriving yojson] + type ref_node_data = { node_type: node_type; constraints: Value_checker.value_constraint list; @@ -35,6 +47,7 @@ type ref_node_data = { default_value: string option; hidden: bool; secret: bool; + docs: docs; } [@@deriving yojson] type t = ref_node_data Vytree.t [@@deriving yojson] @@ -58,6 +71,12 @@ let default_data = { default_value = None; hidden = false; secret = false; + docs = { + headline = ""; + text = ""; + usageExample = ""; + hints = []; + }; } let default = Vytree.make default_data "" @@ -155,6 +174,34 @@ let load_constraint_group_from_xml d c = | _ -> raise (Bad_interface_definition ("Malformed constraint: " ^ Xml.to_string c)) in Xml.fold aux d c +let load_docs_hints d c = + let aux d c = + match c with + | Xml.Element ("hints", attrs, [Xml.PCData s]) -> + let hint_type = List.assoc "type" attrs in + let hint = { text = s; hint_type = hint_type } in + let new_docs = { d.docs with hints = hint :: d.docs.hints } in + { d with docs = new_docs } + | _ -> raise (Bad_interface_definition ("Malformed hint: " ^ Xml.to_string c)) + in aux d c + +let load_docs_from_xml d x = + let aux d x = + match x with + | Xml.Element ("headline", _, [Xml.PCData s]) -> + let new_docs = {d.docs with headline = s} in + {d with docs = new_docs} + | Xml.Element ("text", _, [Xml.PCData s]) -> + let new_docs = {d.docs with text = s} in + {d with docs = new_docs} + | Xml.Element ("hints", _, _) -> + load_docs_hints d x + | Xml.Element ("usageExample", _, [Xml.PCData s]) -> + let new_docs = {d.docs with usageExample = s} in + {d with docs = new_docs} + | _ -> d (* Ignore unknown elements instead of raising an error *) + in Xml.fold aux d x + let data_from_xml d x = let aux d x = match x with @@ -172,6 +219,7 @@ let data_from_xml d x = {d with priority=Some i} | Xml.Element ("hidden", _, _) -> {d with hidden=true} | Xml.Element ("secret", _, _) -> {d with secret=true} + | Xml.Element ("docs", _, _) -> load_docs_from_xml d x | _ -> raise (Bad_interface_definition ("Malformed property tag: " ^ Xml.to_string x)) in Xml.fold aux d x diff --git a/src/reference_tree.mli b/src/reference_tree.mli index a8d4efa..b1447df 100644 --- a/src/reference_tree.mli +++ b/src/reference_tree.mli @@ -9,6 +9,18 @@ type completion_help_type = | Script of string [@name "script"] [@@deriving yojson] +type doc_hints = { + text: string; + hint_type: string; +} [@@deriving yojson] + +type docs = { + headline: string; + text: string; + usageExample: string; + hints: doc_hints list; +} [@@deriving to_yojson] + type ref_node_data = { node_type: node_type; constraints: Value_checker.value_constraint list; @@ -24,6 +36,7 @@ type ref_node_data = { default_value: string option; hidden: bool; secret: bool; + docs: docs; } [@@deriving yojson] type t = ref_node_data Vytree.t [@@deriving yojson]