chore: ♻️ wrapper for Xml

bin/main.ml

@@ -10,7 +10,7 @@ let get_filename () =
 let () =
   Log.set_log_level Log.DEBUG;
   let filename = get_filename () in
-  let xml = Xml.parse_file filename in
+  let xml = XmlUtil.parse_file filename in
   let (book, rules) = Reader.read xml in
   Log.debug "book is:\n  %s" (AddressBook.dump book);
   Log.debug "rules is:\n  %s" (List.map Rule.dump rules |> String.concat "\n  ");

bin/reader.ml

@@ -1,55 +1,16 @@
 open Needlework_scenario_generator
 open Common
 module Ip = Ipaddr.V4
-
-let find_child tag xml =
-  Xml.children xml
-  |> List.find_opt (fun xml -> Xml.tag xml = tag)
-
-let find_child_data tag xml =
-  Xml.children xml
-  |> List.find_opt (fun xml -> Xml.tag xml = tag)
-  |> Option.map Xml.children
-  |> Option.map List.hd
-  |> Option.map Xml.pcdata
-
-let get_child tag xml =
-  Xml.children xml
-  |> List.find_opt (fun xml -> Xml.tag xml = tag)
-  |> function
-    | None ->
-       failwith (!%"get_child: tag '%s' not found." tag)
-    | Some xml -> xml
-
-let text xml = try Xml.children xml |> List.hd |> Xml.pcdata with
-               | e -> prerr_endline (!%"Reader.text: %s: %s" (Printexc.to_string e) (Xml.to_string xml));
-                      raise e
-
-let get_child_data tag xml =
-  find_child_data tag xml
-  |> function
-    | None -> failwith (!%"get_child_data: tag '%s' not found." tag)
-    | Some xml -> xml
-
-let get_child_data_list tag xml =
-  Xml.children xml
-  |> List.filter (fun xml -> Xml.tag xml = tag)
-  |> List.map Xml.pcdata
-
-let has tag xml =
-  Xml.children xml
-  |> List.exists (fun xml -> Xml.tag xml = tag)
-
-let (/) xml tag = Xml.children xml |> List.filter (fun xml -> Xml.tag xml = tag)
-let (//) xml tag : Xml.xml = get_child tag xml
-let (/@) xml attr = Xml.attrib xml attr
+module XmlLight = Xml
+open XmlUtil
+module Xml = XmlUtil
 
 open AddressBook
 
 let address_book_of_xmls address_entries address_grps =
   let address_of_xml entry =
-    let name = Xml.attrib entry "name" in
-    let addr = match find_child_data "ip-netmask" entry, find_child_data "fqdn" entry with
+    let name = entry /@ "name" in
+    let addr = match entry //? "ip-netmask" |> Option.map text, entry //? "fqdn" |> Option.map text with
     | Some ip, _ when String.ends_with ~suffix:"32" ip ->
        let ip = String.split_on_char '/' ip |> List.hd in
        SingleHost (Ip.of_string_exn ip)
@@ -99,13 +60,13 @@ let read_vsys_entry xml =
   let rules = read_rules xml in
   (book, rules)
 
-let read : Xml.xml -> (AddressBook.t * Rule.t list) = fun xml ->
+let read : xml -> (AddressBook.t * Rule.t list) = fun xml ->
   try
   xml // "devices" // "entry" // "vsys" // "entry"
   |> read_vsys_entry
   with
-  | Xml.Not_pcdata xml as e ->
-     Log.error "===ERROR: Not pcdata %s" (Xml.to_string xml);
+  | XmlLight.Not_pcdata xml as e ->
+     Log.error "===ERROR: Not pcdata %s" (XmlLight.to_string xml);
      raise e
   | e ->
      Log.error "===ERROR: %s" (Printexc.to_string e);

lib/dune

@@ -1,3 +1,3 @@
 (library
  (name needlework_scenario_generator)
- (libraries dolog))
+ (libraries xml-light dolog))

lib/needle_work_scenario_generator.ml

@@ -1,3 +1,5 @@
 module Common = Common
 
 module Gen = Gen
+
+module XmlUtil = XmlUtil

lib/xmlUtil.ml

@@ -0,0 +1,59 @@
+open Common
+
+type xml = Xml.xml
+type t = xml
+
+let parse_file filename = Xml.parse_file filename
+
+let to_string = Xml.to_string
+let children = Xml.children
+(*let find_child tag xml =
+  Xml.children xml
+  |> List.find_opt (fun xml -> Xml.tag xml = tag)
+
+let find_child_data tag xml =
+  Xml.children xml
+  |> List.find_opt (fun xml -> Xml.tag xml = tag)
+  |> Option.map Xml.children
+  |> Option.map List.hd
+  |> Option.map Xml.pcdata
+
+let get_child tag xml =
+  Xml.children xml
+  |> List.find_opt (fun xml -> Xml.tag xml = tag)
+  |> function
+    | None ->
+       failwith (!%"get_child: tag '%s' not found." tag)
+    | Some xml -> xml
+*)
+let text xml = try Xml.children xml |> List.hd |> Xml.pcdata with
+               | e -> prerr_endline (!%"Reader.text: %s: %s" (Printexc.to_string e) (Xml.to_string xml));
+                      raise e
+(*
+let get_child_data tag xml =
+  find_child_data tag xml
+  |> function
+    | None -> failwith (!%"get_child_data: tag '%s' not found." tag)
+    | Some xml -> xml
+
+let get_child_data_list tag xml =
+  Xml.children xml
+  |> List.filter (fun xml -> Xml.tag xml = tag)
+  |> List.map Xml.pcdata
+
+let has tag xml =
+  Xml.children xml
+  |> List.exists (fun xml -> Xml.tag xml = tag)
+*)
+
+let (/) xml tag = Xml.children xml |> List.filter (fun xml -> Xml.tag xml = tag)
+
+let (//) xml tag : xml =
+  Xml.children xml
+  |> List.find (fun xml -> Xml.tag xml = tag)
+
+let (//?) xml tag : xml option =
+  Xml.children xml
+  |> List.find_opt (fun xml -> Xml.tag xml = tag)
+
+let (/@) xml attr = Xml.attrib xml attr

lib/xmlUtil.mli

@@ -0,0 +1,13 @@
+type xml
+type t = xml
+
+val parse_file : string -> t
+val children : t -> t list
+
+val to_string : t -> string
+
+val (//) : t -> string -> t
+val (//?) : t -> string -> t option
+val (/) : t -> string -> t list
+val (/@) : t -> string -> string
+val text : t -> string