Using ppx_protocol_conv, how can I deserialize a <xs:choice> XML element into an OCaml variant type?

Learning
1

Cross-posting from here.

I am trying to use the ppx_protocol_conv library to parse an XML format I do not have control over. Suppose it has an XSD as follows:

<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified">
  <xs:element name="modules">
    <xs:complexType>
      <xs:sequence>
        <xs:element name="RootModule" type="xs:string"/>
        <xs:sequence maxOccurs="unbounded">
          <xs:choice>
            <xs:element ref="ModuleNode"/>
            <xs:element ref="ModuleNodeRef"/>
          </xs:choice>
        </xs:sequence>
      </xs:sequence>
    </xs:complexType>
  </xs:element>
</xs:schema>

Here is an example XML input:

<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<modules>
  <RootModule>Test</RootModule>
  <ModuleNodeRef>
    <UID>304</UID>
  </ModuleNodeRef>
  <ModuleNode>
    <uniquename>Test</uniquename>
  </ModuleNode>
</modules>

I would like to deserialize this into something similar to the following, where the ModuleNodeRef and ModuleNode instances are a list of variant types:

open Protocol_conv_xml

type module_node = {
  uniquename : string
} [@@deriving protocol ~driver:(module Xml_light)]

type module_node_ref = {
  uid : int [@key "UID"]
} [@@deriving protocol ~driver:(module Xml_light)]

type module_node_or_ref =
  | ModuleNode of module_node [@key "ModuleNode"]
  | ModuleNodeRef of module_node_ref [@key "ModuleNodeRef"]
[@@deriving protocol ~driver:(module Xml_light)]

type modules = {
  root_module: string; [@key "RootModule"]
  modules : module_node_or_ref list;
} [@@deriving protocol ~driver:(module Xml_light)]

let () =
  let xml = Xml.parse_file "Test.xml" in
  match modules_of_xml_light xml with
  | Ok s -> s |> modules_to_xml_light |> Xml.to_string_fmt |> Printf.printf "t serialized: %s\n";
  | Error e -> print_endline (Xml_light.error_to_string_hum e)

However, when I run the program on the example input it just produces:

t serialized: <record>             
  <RootModule>Test</RootModule>
</record>

So the variants are ignored. How can I correctly parse the variants? Thanks!

2

As a follow-on, if I start from a variant type and try to round-trip to XML I get an error; here is the code:

open Protocol_conv_xml

type foo = {
  name : string [@key "name"]
}
[@@deriving protocol ~driver:(module Xml_light)]

type bar = {
  value : int
}
[@@deriving protocol ~driver:(module Xml_light)]

type t =
  | A of foo [@key "A"]
  | B of bar [@key "B"]
[@@deriving protocol ~driver:(module Xml_light)]

let () = 
  let value = A {name = "test"} in
  let xml = to_xml_light value in
  Printf.printf "t serialized: %s\n" (Xml_light.to_string xml);
  ()

This produces an error when run:

Fatal error: exception Primitive value expected in node: variant for string. T: '<variant>
A
  <record>
    <name>test</name>
  </record>
</variant>'
Raised at Protocol_conv_xml__Xml_light.raise_errorf.(fun) in file "drivers/xml_light/xml_light.ml", line 30, characters 34-63
Called from Protocol_conv_xml__Xml_light.to_value in file "drivers/xml_light/xml_light.ml", line 193, characters 38-120
Called from Protocol_conv_xml__Xml_light.to_string in file "drivers/xml_light/xml_light.ml" (inlined), line 214, characters 16-46
Called from Dune__exe__Main in file "bin/main.ml", line 21, characters 37-62