### ----------------------------------------------------
### -- LibXML::Class
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman
### -- File: lib/LibXML/Class.rakumod
### ----------------------------------------------------
### -- Chunk 3 of 3
HAT, :$ns) {
            $xml-config.alert:
                LibXML::Class::X::Serialize::Impossible.new(
                    :type(self.WHAT),
                    :what($item),
                    :why("no XML name found in config's ns-map for sequential <" ~ $node.localName ~ "> and namespace '$ns'"));
            return Nil
        }

        $desc.clone: :xml-default-ns($ns), :xml-name($ns-map.xml-name)
    }

    method xml-create-item-element( ::?CLASS:D:
                                    LibXML::Element:D $parent,
                                    LibXML::Class::ItemDescriptor:D $desc )
    {
        my (Str $namespace, Str $prefix) = $desc.infer-ns(:from($parent));
        self.xml-create-child-element($parent, $desc, |(:name($_) with $desc.xml-name), :$namespace, :$prefix)
    }

    method xml-serialize-item(LibXML::Element:D $node, LibXML::Class::ItemDescriptor:D $desc, Mu $value) {
        my LibXML::Element:D $item-elem = self.xml-create-item-element($node, $desc);
        my $*LIBXML-CLASS-ELEMENT = $item-elem;
        self.xml-ser-desc-val2elem($item-elem, $desc, $value);
        $item-elem
    }

    method xml-to-element-seq(LibXML::Element:D $node) {
        my Iterator:D $iter = self.iterator;
        my $xml-config = $.xml-config;
        loop {
            last if (my Mu $item := $iter.pull-one) =:= IterationEnd;

            my LibXML::Class::ItemDescriptor $desc = self!xml-ser-guess-descriptor($node, $item);
            with $desc {
                my $*LIBXML-CLASS-DESCRIPTOR = $desc;
                self.xml-serialize-item($node, $desc, $item);
            }
            else {
                $xml-config.alert:
                    LibXML::Class::X::Serialize::Impossible.new( :type(self.WHAT),
                                                                 :what($item),
                                                                 :why("no known serialization method"));
            }
        }
    }

    method xml-deserialize-item( ::?CLASS:D:
                                 LibXML::Element:D $node,
                                 LibXML::Class::ItemDescriptor:D $desc,
                                 UInt:D :$index,
                                 Mu :$value-type is raw = NOT-SET,
                                 DeserializingCtx:D :$dctx = $*LIBXML-CLASS-CTX ) is raw
    {
        self.xml-try-deserializer: $desc, $node, :!coerce, {
            # For whatever reason, deserializer hasn't produced a value. Do it the standard way then.
            my Mu $item-type := $value-type =:= NOT-SET ?? $desc.value-type !! $value-type;

            if $item-type ~~ XMLObject {
                # Make sure prefixes declared on this item descriptor are propagaded downstream.
                my %*LIBXML-CLASS-NS-OVERRIDE = $desc.xml-namespaces;
                my ($namespace, $prefix) =
                    $desc.infer-ns(:from(self), :default-ns($dctx.xml-default-ns), :default-pfx($dctx.xml-default-ns-pfx));
                return $item-type.from-xml( $node,
                                        $.xml-document,
                                        :name($desc.xml-name),
                                        :$namespace,
                                        :$prefix,
                                        user-profile => $dctx.user-profile )
            }
            self.xml-try-deserializer: $desc, ($_ ?? $node.getAttribute($_) !! $node.textContent), :$value-type
                given $desc.value-attr
        }
    }

    multi method xml-deserialize-element( ::?CLASS:D:
                                          LibXML::Element:D $node,
                                          LibXML::Class::ItemDescriptor:D $desc )
    {
        my $unique-key = $node.unique-key;
        for ^ @!xml-seq-elems.elems -> $idx {
            # Skip if an item is already deserialized. This is not our case and the document object should've found
            # this item's registration already.
            if @!xml-seq-elems.EXISTS-POS($idx) && @!xml-seq-elems.AT-POS($idx).unique-key eq $unique-key {
                return self.AT-POS($idx);
            }
        }

        nextwith($node, $desc, :no-match)
    }
    multi method xml-deserialize-element( ::?CLASS:D:
                                          LibXML::Element:D $elem,
                                          LibXML::Class::ItemDescriptor:D $desc,
                                          Bool:D :$no-match! )
    {
        LibXML::Class::X::Sequence::ForeignElement.new(:type(self.WHAT), :$elem, :sequence($.xml-backing)).throw
    }

    multi method xml-deserialize-element(::?CLASS:D: LibXML::Element:D $node, LibXML::Class::Descriptor:D) {
        # Redelegate to XMLObject
        nextsame
    }

    method AT-POS(::?CLASS:D: $idx --> Mu) is raw {
        return @!xml-items[$idx] if @!xml-items.EXISTS-POS($idx);
        fail X::OutOfRange(:what<Index>, :got($idx), :range(0 .. self.end)) if $idx > self.end;

        # Item is not ready, deserialize corresponding element
        my LibXML::Element:D $node = @!xml-seq-elems[$idx];


        self.xml-lazy-deserialize-context: {
            my LibXML::Class::ItemDescriptor $desc = $*LIBXML-CLASS-CTX.desc-for-elem($node);

            my Mu $value-type := NOT-SET;

            if !$desc && $!xml-is-any {
                unless ($value-type := $*LIBXML-CLASS-CONFIG.ns-map($node)) =:= Nil {
                    # When succeed in mapping an element into a type for xml-any try to go back to the registry and locate
                    # a descriptor for the type.
                    $desc = self!xml-ser-guess-descriptor($node, $value-type);
                }
            }

            without $desc {
                LibXML::Class::X::Deserialize::UnknownTag.new(:type(self.WHAT), :xml-name($node.localName)).throw
            }

            KEEP {
                @!xml-seq-elems.DELETE-POS($idx);
                # Pickup any deserializations registed by complex structures like hashes.
                for $*LIBXML-CLASS-CTX.take-out-deserializations -> (:key($node), :$value) {
                    self.xml-add-deserialization($node, $value);
                }
            }

            self.xml-add-deserialization:
                $node,
                @!xml-items[$idx] := self.xml-deserialize-item($node, $desc, :$value-type, :index($idx))
        }
    }

    method EXISTS-POS(::?CLASS:D: Int:D $pos) {
        @!xml-seq-elems.EXISTS-POS($pos) || @!xml-items.EXISTS-POS($pos)
    }

    proto method HAS-POS(::?CLASS:D: Any:D) {*}
    multi method HAS-POS(::?CLASS:D: Int:D $pos, Bool:D :$has = True) {
        ! (@!xml-items.EXISTS-POS($pos) ^^ $has)
    }
    multi method HAS-POS(::?CLASS:D: Iterable:D \positions, Bool:D :$has = True) {
        gather for positions<> { take ! (@!xml-items.EXISTS-POS($_) ^^ $has) }
    }

    method elems {
        @!xml-seq-elems.elems max @!xml-items.elems
    }

    method end {
        @!xml-seq-elems.end max @!xml-items.end
    }

    multi method iterator(::?CLASS:D:) {
        class :: does Iterator {
            has $.idx = 0;
            has $.seq;

            method pull-one is raw {
                return IterationEnd if $!idx > $.seq.end;
                $.seq.AT-POS($!idx++)
            }
        }.new(:seq(self))
    }
    multi method iterator(::?CLASS:U:) {
        (self,).iterator
    }
}

our role XMLSequential does XMLRepresentation is XMLSequence {
    method of { ::?CLASS.^xml-array-type.of }
    method xml-seq-array-type { ::?CLASS.^xml-array-type }
    method xml-seq-either-any { ::?CLASS.^xml-either-any }
    method xml-seq-desc-for-type(Mu $item) { ::?CLASS.^xml-desc-for-type($item) }
}

BEGIN {
    my sub typeobj-as-sequence(Mu:U \typeobj, $sequence, Mu $any is raw) {
        my \child-types = $sequence.List;
        LibXML::Class::X::Sequence::NoItemDesc.new(:type(typeobj)).throw unless child-types.elems;

        my proto sub validate-args(Capture:D) {*}
        multi sub validate-args(
            $ ( Mu:U $type,
                Str :attr(:$value-attr),
                :namespace(:$ns) is copy,
                :&serializer,
                :&deserializer,
                Bool :$derive,
                *%c))
        {
            if %c {
                my $sfx = %c > 1 ?? "s" !! "";
                LibXML::Class::X::Trait::Argument.new(
                    :trait-name<xml-element>,
                    :why("unexpected named argument$sfx passed to :sequence of 'xml-element' trait: "
                        ~ %c.keys.sort.join(", "))).throw;
            }
            \(:$type, :$value-attr, :$derive, :&serializer, :&deserializer, |(:$ns with $ns))
        }
        multi sub validate-args($ (*%)) {
            LibXML::Class::X::Trait::Argument.new(
                :trait-name<xml-element>,
                :why(':sequence requires a type object')).throw
        }
        multi sub validate-args($ (Mu:D $p, *%)) {
            LibXML::Class::X::Trait::Argument.new(
                :trait-name<xml-element>,
                :why(':sequence requires a type object, not an instance of ' ~ $p.^name)).throw
        }
        multi sub validate-args($ (*@, *%)) {
            LibXML::Class::X::Trait::Argument.new(
                :trait-name<xml-element>,
                :why(':sequence only takes a single type object')).throw
        }

        my %std = :seq-how(typeobj.HOW), :declarant($*PACKAGE);
        my @item-desc;

        for child-types -> \ctype {
            my LibXML::Class::ItemDescriptor $child-desc;
            given ctype {
                when Pair:D {
                    # The order of constructor arguments is important here as client must be able to override the
                    # default naemspace, for example. And, yet, must not be able to use xml-name, not even by accident.
                    @item-desc.push:
                        LibXML::Class::ItemDescriptor.new(
                            |validate-args(.value.List.Capture),
                            :xml-name(.key),
                            |%std );
                }
                when Positional:D {
                    # Item declared as (XMLElementType, :ns(...))
                    @item-desc.push:
                        LibXML::Class::ItemDescriptor.new(
                            |validate-args(.List.Capture), |%std );
                }
                when Mu:U {
                    if $_ ~~ XMLRepresentation {
                        @item-desc.push: LibXML::Class::ItemDescriptor.new: $_, :xml-name(.xml-class.^xml-name), |%std;
                    }
                    elsif $any === NOT-SET {
                        LibXML::Class::X::Sequence::NotAny.new(:type(typeobj),
                                                               :why("can't use a bare type '" ~ .^name ~ "' with it"))
                            .throw
                    }
                    else {
                        # A bare non-xml-element type would derive its namespace.
                        @item-desc.push:
                            LibXML::Class::ItemDescriptor.new: $_, :derive(xml-implicit-value(True)), |%std;
                    }
                }
                default {
                    my $is-composed = True;
                    try { $is-composed = .^is_composed; }
                    if $is-composed {
                        LibXML::Class::X::Sequence::ChildType.new(:type(typeobj), :child-decl(ctype)).throw
                    }
                    @item-desc.push: LibXML::Class::ItemDescriptor.new(:type($_<>), |%std);
                }
            }
        }

        typeobj.^xml-set-sequence-any($any !=== NOT-SET);
        typeobj.^xml-set-item-descriptors(@item-desc);
    }

    my subset TraitArg of Any where Bool:D | Str:D;

    my sub no-extra-nameds(%named) {
        if %named {
            my $singular = %named.keys == 1;
            LibXML::Class::X::Trait::Argument.new(
                :$singular,
                :why("named" ~ ($singular ?? "" !! "s")
                    ~ " '" ~ %named.keys.sort.join("', '") ~ "'") ).throw
        }
    }

    my proto sub typeobj-as-element(|) {*}

    multi sub typeobj-as-element(Mu:U \typeobj, *@pos, *%params) {
        my $pos;
        if @pos == 1 && ($pos = @pos.head) !~~ TraitArg {
            LibXML::Class::X::Trait::Argument.new(
                :why("$*LIBXML-CLASS-TRAIT name must be a string, not "
                    ~ ($pos andthen "an instance of " orelse "a type object ") ~ $pos.^name)).throw
        }
        elsif @pos > 1 {
            LibXML::Class::X::Trait::Argument.new(
                :why("too many positionals for trait $*LIBXML-CLASS-TRAIT")).throw
        }

        if $pos ~~ Str:D {
            %params<xml-name> = $pos;
        }

        given typeobj.HOW {
            when Metamodel::ClassHOW {
                samewith(|%params, :class(typeobj))
            }
            when Metamodel::ParametricRoleHOW {
                samewith(|%params, :role(typeobj))
            }
            default {
                LibXML::Class::X::UnsupportedType.new(:type(typeobj)).throw
            }
        }
    }

    multi sub typeobj-as-element( Mu :$class! is raw,
                                  Str :$xml-name,
                                  Bool :$implicit,
                                  SerializeSeverity :$severity,
                                  Mu :$sequence = NOT-SET,
                                  Mu :$any = NOT-SET,
                                  Bool :$lazy,
                                  :$derive,
                                  Bool :$impose-ns,
                                  :namespace(:$ns) is raw,
                                 *%named )
    {
        no-extra-nameds(%named);

        if $class.HOW ~~ LibXML::Class::HOW::Element {
            LibXML::Class::X::Redeclaration::Type.new(:type($class), :kind<class>, :what<xml-element>).throw;
        }

        # If a role is consumed where a parent is xml-element this may result in inability to build c3mro due to
        # an ambiguity about LibXML::Class::Object. The ambiguity is resolved the trait goes before that role.
        my sub is-Object(Mu $role is raw) is raw {
            my \rhow = $role.HOW;
            if rhow ~~ Metamodel::ParametricRoleHOW {
                return ($role.^parents(:local).any ~~ XMLObject) || $role.^roles(:transitive).map({ is-Object($_) })
                    .any;
            }
            elsif rhow ~~ Metamodel::ParametricRoleGroupHOW {
                return $role.^candidates.map({ is-Object($_) }).any
            }
            elsif rhow ~~ Metamodel::CurriedRoleHOW {
                return $role.^role_typecheck_list.map({ is-Object($_) }).any
            }
            die "Cannot check if object ", $role.^name, " of ", $role.HOW.^name, " is an xml-element";
        }
        for $class.^role_typecheck_list -> Mu $role is raw {
            LibXML::Class::X::TraitPosition.new(:trait<xml-element>, :$class, :$role).throw if is-Object($role);
        }

        if $sequence !=== NOT-SET {
            $class.HOW does LibXML::Class::HOW::ElementSeq[LibXML::Class::HOW::Element];
            $class.^add_role(XMLSequential);
        }
        else {
            $class.HOW does LibXML::Class::HOW::Element;
            $class.^add_role(XMLRepresentation);
        }

        my %config-defaults = |(:$severity with $severity), |(:$derive with $derive);
        $class.^xml-set-name($_) with $xml-name;
        $class.^xml-set-ns-defaults($_) with $ns;
        $class.^xml-set-impose-ns($_) with $impose-ns;
        $class.^xml-set-explicit(!$_) with $implicit;
        with $lazy {
            $class.^xml-set-lazy($lazy);
            %config-defaults<eager> = !$lazy;
        }
        else {
            # Default is lazy but without eager being explicitly specified...
            $class.^xml-set-lazy(True);
        }

        typeobj-as-sequence($class, $sequence, $any) unless $sequence === NOT-SET;

        $class.^xml-set-config-defaults: %config-defaults;
    }

    multi sub typeobj-as-element( Mu :$role! is raw,
                                  Str :$xml-name,
                                  Bool :$implicit,
                                  Bool :$impose-ns,
                                  Bool :$lazy,
                                  :namespace(:$ns),
                                  :$sequence,
                                  Mu :$any = NOT-SET,
                                  *%named )
    {
        no-extra-nameds(%named);

        if $role.HOW ~~ LibXML::Class::HOW::ElementRole {
            LibXML::Class::X::Redeclaration::Type.new(:type($role), :kind<role>, :what<xml-element>).throw;
        }

        with $sequence {
            typeobj-as-sequence($role, LibXML::Class::HOW::ElementRole, $sequence, $any);
        }
        else {
            $role.HOW does LibXML::Class::HOW::ElementRole;
        }

        $role.^xml-set-lazy($lazy) with $lazy;
        $role.^xml-set-ns-defaults($_) with $ns;
        $role.^xml-set-explicit(!$_) with $implicit;
        $role.^xml-set-impose-ns($_) with $impose-ns;
        $role.^xml-set-name($_) with $xml-name;
    }

    multi sub trait_mod:<is>(Mu:U \typeobj, :$xml-element!) is export {
        my $*LIBXML-CLASS-TRAIT = "xml-element";
        typeobj-as-element(typeobj, |$xml-element.List.Capture)
    }

    multi sub trait_mod:<is>(Attribute:D $attr, :$xml-attribute!) is export {
        my $*LIBXML-CLASS-TRAIT = "xml-attribute";
        LibXML::Class::Attr::mark-attr-xml($attr, |$xml-attribute.List.Capture, :!as-xml-element);
        # Unless the owning package is manually marked as implicit any explicitly marked attribute turns it into an
        # explicit one.
        $*PACKAGE.^xml-set-explicit(True);
    }

    multi sub trait_mod:<is>(Attribute:D $attr, :$xml-element!) is export {
        my $*LIBXML-CLASS-TRAIT = "xml-element";
        LibXML::Class::Attr::mark-attr-xml($attr, |$xml-element.List.Capture, :as-xml-element);
        $*PACKAGE.^xml-set-explicit(True);
    }

    multi sub trait_mod:<is>(Attribute:D $attr, :$xml-text!) is export {
        my $*LIBXML-CLASS-TRAIT = "xml-text";
        LibXML::Class::Attr::mark-attr-xml($attr, |$xml-text.List.Capture, :as-xml-text);
        $*PACKAGE.^xml-set-explicit(True);
    }

    sub xml-I-cant(--> Nil) is export { LibXML::Class::CX::Cannot.new.throw }
}

multi sub postcircumfix:<[ ]>(XMLSequence:D \XMLSEQ, Any:D $pos, Bool:D :$has!) is raw is export {
    XMLSEQ.HAS-POS($pos, :$has)
}

our sub META6 {
    $?DISTRIBUTION.meta
}

# Copyright (c) 2023, Vadim Belman <vrurg@cpan.org>
#
# See the LICENSE file for the license


