### ----------------------------------------------------
### -- LibXML::Class
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman
### -- File: t/040-basic-serialization.rakutest
### ----------------------------------------------------
use v6.e.PREVIEW;
use Test::Async;

use LibXML::Class;
use LibXML::Class::Config :types;
use LibXML::Class::X;

my constant TEST-NS1 = 'http://test1.namespace';
my constant TEST-NS2 = 'http://test2.namespace';
my constant TEST-NS3 = 'http://test3.namespace';

plan 2;

for True, False -> $eager {
    subtest ($eager ?? "Eager" !! "Lazy"), {
        plan 10;

        my sub is-two-way( \xml-object,
                           $expected-xml-ast,
                           Str:D $message = "serialize, then deserialize",
                           Bool :$dump,
                           Bool :$format = False,
                           Bool :$dump-ast,
                           :%config,
                           :%profile ) is test-assertion
        {
            subtest $message, :hidden, {
                plan 2;

                my $serialized = xml-object.to-xml(:%config);
                cmp-deeply $serialized.ast, $expected-xml-ast, "serialized OK";

                diag $serialized.Str(:$format) if $dump;
                diag $serialized.ast.raku if $dump-ast;

                my $deserialized = xml-object.WHAT.from-xml: $serialized.Str, :config(:$eager, |%config), |%profile;
                cmp-deeply $deserialized, xml-object, "deserialized version is the same";
            }
        }

        subtest "Most basic" => {
            plan 1;

            my class Prop is xml-element {
                has UInt:D $.count is xml-attribute<size> is required;
                has Str:D $.name is xml-attribute is required;
                has Str $.comment is xml-attribute;
                has %.data is xml-element;
            }

            my class Root is xml-element<dict> {
                has Str:D $.scope is xml-attribute is required;
                has Int:D $.max-something is xml-attribute is required;
                has Int:D $.something is xml-element is required;
                has Prop @.entry is xml-element;
                has Str:D @.idx is xml-element;
            }

            my Root $root = Root.new: :scope<global>, :max-something(42), :something(12), :idx<s1 s2 s3 s4>;

            $root.entry.push:
                Prop.new:
                    :count(2),
                    :name("article-1"),
                    :comment("dictionary entry #1"),
                    data => %(
                        keyword => "foo",
                        text => "whatever you like",
                    );

            $root.entry.push:
                Prop.new:
                    :count(3),
                    :name("article-2"),
                    :comment("another dictionary entry"),
                    data => %(
                        keyword => "bar",
                        text => "you may not like it, but...",
                        importance => "required",
                    );

            my $expected = "#xml" => [:dict([:scope("global"), :max-something("42"), :something(["12"]), :entry([:size("2"), :name("article-1"), :comment("dictionary entry #1"), :data([:keyword(["foo"]), :text(["whatever you like"])])]), :entry([:size("3"), :name("article-2"), :comment("another dictionary entry"), :data([:importance(["required"]), :keyword(["bar"]), :text(["you may not like it, but..."])])]), :idx(["s1"]), :idx(["s2"]), :idx(["s3"]), :idx(["s4"])])];
            is-two-way $root, $expected;
        }

        subtest "Implicit" => {
            plan 1;
            my class Record is xml-element {
                has Str:D $.data is required;
            }

            my class Root is xml-element {
                has Record:D $.record is required;
            }

            my $root = Root.new: record => Record.new(:data("some data"));
            my $expected = "#xml" => [:Root([:record([:data("some data")])])];
            is-two-way $root, $expected;
        }

        subtest "Namespaces" => {
            plan 2;

            my class Root is xml-element('root', :ns(TEST-NS1, :r1(TEST-NS2))) {
                has Str:D $.attr1 is xml-attribute(:ns(TEST-NS2)) is required;
                has Rat:D $.attr2 is xml-attribute(:ns(:r1)) is required;
                has Bool:D $.attr3 is xml-element(:ns(:r3, :r3(TEST-NS3))) is required;
            }

            my $root = Root.new: :attr1('a string'), :attr2(12.42), :!attr3, :attr4(42);

            my $expected = "#xml" => [:root(["xmlns:r1" => "http://test2.namespace", :xmlns("http://test1.namespace"), "r1:attr1" => "a string", "r1:attr2" => "12.42", "r3:attr3" => ["xmlns:r3" => "http://test3.namespace", "false"]])];
            is-two-way $root, $expected;

            my class Foo is xml-element {
                has Str $.foo is xml-attribute(:ns(TEST-NS1));
            }

            throws-like
                { Foo.new(:foo("test")).to-xml },
                LibXML::Class::X::NS::Namespace,
                "unresolvable attribute namespace throws at serialization time";
        }

        subtest "Containers" => {
            plan 1;

            my class Record is xml-element<record> {
                has Int $.idx is xml-attribute;
                has Str $.val is xml-element;
            }
            my class Root is xml-element<root> {
                # Uncontainerized
                has Record:D $.rec1 is xml-element is required;
                # Uncont, custom named
                has Record:D $.rec2 is xml-element<r2> is required;
                # Attribute name as container
                has Record:D $.rec3 is xml-element(:container) is required;
                # Named container over an xml-element object
                has Record:D $.rec4 is xml-element(:container<fourth-record>) is required;
                # Attribute name as value element, container explicit
                has UInt:D $.count is xml-element(:container<size>) is required;
                # Explicit value and container name
                has Str:D $.descr is xml-element("description", :container<info>) is required;
                # Containerized array
                has Record:D @.list1 is xml-element(:container);
                # Array with named container
                has Record:D @.entry is xml-element(:container<Items>);
                # Array with named container
                has Record:D @.list2 is xml-element('item', :container<LIST2>);
            }

            my $idx = 0;
            my sub next-rec {
                ++$idx;
                Record.new: :$idx, :val('record#' ~ $idx);
            }
            my $root = Root.new:
                rec1 => next-rec,
                rec2 => next-rec,
                rec3 => next-rec,
                rec4 => next-rec,
                count => 4,
                descr => "Fictional structure";

            $idx = 1000;
            for ^4 {
                $root.list1.push: next-rec;
            }

            $idx = 2000;
            for ^3 {
                $root.entry.push: next-rec;
            }

            $idx = 3000;
            for ^3 {
                $root.list2.push: next-rec;
            }

            my $expected = "#xml" => [:root([:rec1([:idx("1"), :val(["record#1"])]), :r2([:idx("2"), :val(["record#2"])]), :rec3([:record([:idx("3"), :val(["record#3"])])]), :fourth-record([:rec4([:idx("4"), :val(["record#4"])])]), :size([:count(["4"])]), :info([:description(["Fictional structure"])]), :list1([:record([:idx("1001"), :val(["record#1001"])]), :record([:idx("1002"), :val(["record#1002"])]), :record([:idx("1003"), :val(["record#1003"])]), :record([:idx("1004"), :val(["record#1004"])])]), :Items([:entry([:idx("2001"), :val(["record#2001"])]), :entry([:idx("2002"), :val(["record#2002"])]), :entry([:idx("2003"), :val(["record#2003"])])]), :LIST2([:item([:idx("3001"), :val(["record#3001"])]), :item([:idx("3002"), :val(["record#3002"])]), :item([:idx("3003"), :val(["record#3003"])])])])];
            is-two-way $root, $expected;
        }

        subtest "Containers and Namespaces" => {
            plan 1;

            my class Root is xml-element('root', :ns('http://default.namespace', :pfx<http://test.namespace>)) {
                has Str:D $.descr is xml-element('description', :container<INFO>, :ns(:pfx)) is required;
                has UInt:D $.count is xml-element(:container<weight>, :ns<http://cont.namespace>) is required;
                has Num $.constant is xml-element(:container<banal>, :ns(:pfx, :pfx<http://math.namespace>)) = π;
            }

            my $root = Root.new: descr => "this must be namespaced", count => 42;

            my $expected = "#xml" => [:root([:xmlns("http://default.namespace"), "xmlns:pfx" => "http://test.namespace", "pfx:INFO" => ["pfx:description" => ["this must be namespaced"]], :weight([:xmlns("http://cont.namespace"), :count(["42"])]), "pfx:banal" => ["xmlns:pfx" => "http://math.namespace", "pfx:constant" => ["3.141592653589793e+00"]]])];

            is-two-way $root, $expected;
        }

        subtest "Namespaced subrecords" => {
            plan 2;

            my class Meta is xml-element {
                has Str $.comment is xml-element;
                has DateTime:D $.created is xml-element(:ns(""), :derive) is required;
            }

            my class Record is xml-element(<record>, :ns(:pfx)) {
                has Int $.idx is xml-element(:derive);
                has Str $.val is xml-element(:ns(:xstr));
                has Meta $.meta is xml-element;
            }

            my class Root is xml-element('root', :ns('http://root.namespace', :pfx<http://prefix.namespace>)) {
                has Record:D $.rec is xml-element(:ns(:xstr<http://strings.namespace>)) is required;
            }

            my $meta = Meta.new(:comment("some extra info"), :created(DateTime.new('2023-05-05T18:00:00+0200')));
            my $root = Root.new: rec => Record.new(:idx(42), :val('The Answer'), :$meta);

            my $expected = "#xml" => [:root([:xmlns("http://root.namespace"), "xmlns:pfx" => "http://prefix.namespace", "pfx:rec" => ["xmlns:xstr" => "http://strings.namespace", "pfx:idx" => ["42"], "xstr:val" => ["The Answer"], :meta([:comment(["some extra info"]), :created([:xmlns(""), "2023-05-05T18:00:00+02:00"])])]])];
            is-two-way $root, $expected, "without :derive";

            $expected = "#xml" => [:root([:xmlns("http://root.namespace"), "xmlns:pfx" => "http://prefix.namespace", :rec(["xmlns:xstr" => "http://strings.namespace", :idx(["42"]), "xstr:val" => ["The Answer"], :meta([:comment(["some extra info"]), :created([:xmlns(""), "2023-05-05T18:00:00+02:00"])])])])];
            is-two-way $root, $expected, config => { :derive }, "with :derive";
        }

        subtest "Imposing role" => {
            plan 2;

            my class Meta is xml-element {
                has Str $.comment is xml-element;
                has DateTime:D $.created is xml-element(:ns(""), :derive) is required;
            }

            my class Record is xml-element(<record>) {
                has Int $.idx is xml-element;
                has Str $.val is xml-element(:ns(:xstr));
                has Meta $.meta is xml-element;
            }

            my role Recording is xml-element(:ns(:pfx, :xstr<http://strings.namespace>), :impose-ns) {
                has Record:D $.rec is required;
            }

            my class Root is xml-element('root', :ns('http://root.namespace', :pfx<http://prefix.namespace>)) {
                also does Recording;
            }

            my $meta = Meta.new(:comment("some extra info"), :created(DateTime.new('2023-05-05T18:00:00+0200')));
            my $root = Root.new: rec => Record.new(:idx(42), :val('The Answer'), :$meta);

            my $expected = "#xml" => [:root([:xmlns("http://root.namespace"), "xmlns:pfx" => "http://prefix.namespace", "xmlns:xstr" => "http://strings.namespace", "pfx:rec" => [:idx(["42"]), "xstr:val" => ["The Answer"], :meta([:comment(["some extra info"]), :created([:xmlns(""), "2023-05-05T18:00:00+02:00"])])]])];
            is-two-way $root, $expected, "without :derive";

            $expected = "#xml" => [:root([:xmlns("http://root.namespace"), "xmlns:pfx" => "http://prefix.namespace", "xmlns:xstr" => "http://strings.namespace", "pfx:rec" => ["pfx:idx" => ["42"], "xstr:val" => ["The Answer"], "pfx:meta" => ["pfx:comment" => ["some extra info"], :created([:xmlns(""), "2023-05-05T18:00:00+02:00"])]]])];
            is-two-way $root, $expected, config => { :derive }, "with :derive";
        }

        subtest "Serializer" => {
            plan 1;

            my sub serializer-ver(Version:D $ver) {
                "Ver." ~ $ver
            }
            my sub deserializer-ver(LibXML::Element:D $ver-elem) {
                if $ver-elem.textContent ~~ /^ "Ver." (\d+ % ".")/ -> $m {
                    return Version.new: ~$m[0]
                }
                die "Bad version format '" ~ $ver-elem.textContent ~ "'"
            }
            my class Record is xml-element<record> {
                has Version:D $.ver is xml-element(:serializer(&serializer-ver) :deserializer(&deserializer-ver)) is required;
            }

            my $root = Record.new(:ver(v1.2.3));
            my $expected = "#xml" => [:record([:ver(["Ver.1.2.3"])])];
            is-two-way $root, $expected;
        }

        subtest "Missing namespace prefix" => {
            plan 1;

            my class Record is xml-element(<record>, :ns(:pfx)) {
                has Int $.idx is xml-element(:derive);
                has Str $.val is xml-element(:ns(:xst));
            }

            my class Root is xml-element('root', :ns('http://root.namespace', :pfx<http://prefix.namespace>)) {
                has Record:D $.rec is xml-element(:ns(:xstr<http://strings.namespace>)) is required;
            }

            my $root = Root.new: rec => Record.new(:idx(42), :val('The Answer'));
            throws-like
                { $root.to-xml(config => %( :eager, :severity<STRICT> )) },
                LibXML::Class::X::NS::Prefix,
                "non-existing namespace prefix casuses an error in with STRICT severity";
        }

        subtest "XML:any" => {
            plan 7;

            my class Record is xml-element('record') {
                has Str:D $.id is required;
                has Numeric:D $.amount is required;
            }

            my constant HEADER-NS = 'http://header.namespace';

            my class HeaderRow is xml-element('hr', :ns(:hdr, :hdr(HEADER-NS))) {
                has Str:D $.title is xml-attribute is required;
                has Str:D $.body is xml-text is required;
            }

            my %config =
                severity => STRICT,
                :$eager,
                :derive,
                ns-map => (
                    HeaderRow, # Name and namespace will be picked up from the xml-element declaration
                    (TEST-NS1) => (
                        Record,
                        "float" => Num,
                        "string" => Str,
                    ),
                    (TEST-NS2) => (
                        "rec" => Record,
                        "size" => Int,
                        "text" => Str,
                    ),
                    (TEST-NS3) => {
                        "volume" => Numeric,
                        "comment" => Stringy,
                    }
                );

            my class Root is xml-element(<root>, :derive, :ns(TEST-NS1, :pfx(TEST-NS3))) {
                has $.header is xml-element(:any, :ns(HEADER-NS));
                has $.data is xml-element(:any) is required;
                has Cool:D $.perm-name is xml-element(:any, :ns(TEST-NS1)) is required;
                has @.array is xml-element(:any);
            }

            my $header = HeaderRow.new(:title('testing things'), :body("lorem ipsum, та інша беліберда"));

            my $root = Root.new(:data("foo"), :array(1e0, 2e0, "some more"), :perm-name(pi), :$header);
            my $expected = "#xml" => [:root([:xmlns("http://test1.namespace"), "xmlns:pfx" => "http://test3.namespace", :header([:xmlns("http://header.namespace"), "hdr:hr" => ["xmlns:hdr" => "http://header.namespace", :title("testing things"), "lorem ipsum, та інша беліберда"]]), :data([:string(["foo"])]), :perm-name([:float(["3.141592653589793e+00"])]), :array([:float(["1.0e+00"])]), :array([:float(["2.0e+00"])]), :array([:string(["some more"])])])];
            is-two-way $root, $expected, :%config, "all default namespaces, with header";

            $root = Root.new(:data(Record.new(:id<id0>, :amount(42.12))), :array(1e0, 2e0, "some more"), :perm-name(pi));
            $expected = "#xml" => [:root([:xmlns("http://test1.namespace"), "xmlns:pfx" => "http://test3.namespace", :data([:record([:id("id0"), :amount("42.12")])]), :perm-name([:float(["3.141592653589793e+00"])]), :array([:float(["1.0e+00"])]), :array([:float(["2.0e+00"])]), :array([:string(["some more"])])])];
            is-two-way $root, $expected, :%config, "all default namespaces, without header";

            $root = Root.new(:data(Record.new(:id<id0>, :amount(42.12))), :array(1, 2, "some more"), :perm-name(pi), :xml-default-ns(TEST-NS2));
            $expected = "#xml" => [:root([:xmlns("http://test2.namespace"), "xmlns:pfx" => "http://test3.namespace", :data([:rec([:id("id0"), :amount("42.12")])]), :perm-name([:xmlns("http://test1.namespace"), :float(["3.141592653589793e+00"])]), :array([:size(["1"])]), :array([:size(["2"])]), :array([:text(["some more"])])])];
            is-two-way $root, $expected, :%config, profile => { :xml-default-ns(TEST-NS2) }, "default to the second test namespace";

            $root = Root.new(:data("foo"), :array(1, 2, "some more"), :perm-name(pi), :$header, :xml-default-ns(TEST-NS2));
            $expected = "#xml" => [:root([:xmlns("http://test2.namespace"), "xmlns:pfx" => "http://test3.namespace", :header([:xmlns("http://header.namespace"), "hdr:hr" => ["xmlns:hdr" => "http://header.namespace", :title("testing things"), "lorem ipsum, та інша беліберда"]]), :data([:text(["foo"])]), :perm-name([:xmlns("http://test1.namespace"), :float(["3.141592653589793e+00"])]), :array([:size(["1"])]), :array([:size(["2"])]), :array([:text(["some more"])])])];
            is-two-way $root, $expected, :%config, profile => { :namespace(TEST-NS2) }, "default to the second test namesapce, with header";

            $root = Root.new(:data("foo"), :array(1e1, 2, "some more"), :perm-name(pi), :xml-default-ns-pfx<pfx>);
            $expected = "#xml" => ["pfx:root" => ["xmlns:pfx" => "http://test3.namespace", :xmlns("http://test1.namespace"), "pfx:data" => ["pfx:comment" => ["foo"]], :perm-name([:float(["3.141592653589793e+00"])]), "pfx:array" => ["pfx:volume" => ["1.0e+01"]], "pfx:array" => ["pfx:volume" => ["2"]], "pfx:array" => ["pfx:comment" => ["some more"]]]];
            is-two-way $root, $expected, :%config, :profile{ :prefix<pfx> }, "default to the third test namespace via a prefix";

            $root = Root.new(:data(13), :array(1e0, 2e0, "some more"), :perm-name(pi));
            throws-like
                { $root.to-xml(:%config) },
                LibXML::Class::X::Serialize::Impossible,
                "xml:any attribute can't be serialized when there is no map for a type";

            $root =
                Root.new(
                    :data(Record.new(:id<id0>, :amount(42.12))),
                    :array(1e0, 2e0, "some more"),
                    :perm-name(pi),
                    :xml-default-ns(TEST-NS3) );
            throws-like
                { $root.to-xml(:%config) },
                LibXML::Class::X::Serialize::Impossible,
                "xml:any attribute can't be serialized when there is no map for even an xml-element type";
        }
    }
}

done-testing;


