### ----------------------------------------------------
### -- JSON::Class
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman
### -- File: t/100-types.rakutest
### ----------------------------------------------------
use v6.e.PREVIEW;
use Test::Async;
use JSON::Class::Config:auth<zef:vrurg>;
use JSON::Class::Utils:auth<zef:vrurg>;
use JSON::Class::X:auth<zef:vrurg>;
use JSON::Class:auth<zef:vrurg>;
use JSON::Fast;

plan 8;

subtest "Version" => -> $subtest {
    plan 3;
    my class VFoo is json {
        has Version:D $.ver is required;
    }

    my $vfoo = VFoo.new(ver => v42.13.2);

    is $vfoo.to-json, q<{"ver":"42.13.2"}>, "Version serializes as a string";

    cmp-deeply VFoo.from-json(q«{"ver":"1.23.45"}»), VFoo.new(:ver(v1.23.45)), "version deserializes from a string";

    {
        CONTROL {
            when CX::Warn {
                $subtest.like: .message, /Version .* implicit .* JSONification/, "we're warned about Version JSONification";
            }
        }
        JSON::Class::Config.jsonify(Version).new("12.13.14").to-json;
    }
}

subtest "Setty" => {
    plan 2;
    for Set, SetHash -> \type {
        my $tname = type.^name;
        my \cclass = "my class C$tname is json \{ has $tname \$.s; }".EVAL;
        my @sets = (), ("a",), (<foo bar baz>);
        subtest $tname => {
            plan +@sets;
            for @sets -> @set {
                subtest "Set of " ~ +@set ~ " elements" => {
                    plan 3;
                    my $c = cclass.new(s => type.new(@set));
                    my $json = $c.to-json;
                    my %data = from-json($json);
                    ok %data<s>:exists, "attribute was serialized";
                    cmp-deeply %data<s>.sort, @set.sort, "keys are serialized";
                    cmp-deeply cclass.from-json($c.to-json), $c, "deserialized";
                }
            }
        }
    }
}

subtest "Baggy/Mixy" => {
    plan 4;
    for Bag, BagHash, Mix, MixHash -> \type {
        my $tname = type.^name;
        my \cclass = "my class C$tname is json \{ has $tname \$.qh; }".EVAL;
        my @sets = %(), %( a => 1.23 ), %(:foo(2.2), :bar(42), :baz(pi));
        subtest $tname => {
            plan +@sets;
            for @sets -> %set {
                subtest "Set of " ~ %set.elems ~ " elements" => {
                    plan 2;
                    my $c = cclass.new(qh => type.new-from-pairs(%set));
                    my $json = $c.to-json;
                    my %data = from-json($json);
                    my %expected = qh => type.new-from-pairs(%set).Hash;
                    cmp-deeply %data, %expected, "serialized";
                    cmp-deeply cclass.from-json($json).qh.Hash, $c.qh.Hash, "deserialized";
                }
            }
        }
    }
}

subtest "Prohibited JSONifications" => {
    my $config = JSON::Class::Config.new(:strict);
    my Mu @types = Promise, Supply, Channel, Lock, IO::Handle, IO::Socket::INET, IO::Pipe;
    plan +@types;

    for @types -> \typeobj {
        throws-like
            { $config.jsonify(typeobj) },
            JSON::Class::X::UnsupportedType,
            :type(typeobj),
            :message(*.contains: "cannot be implicitly JSONified"),
            typeobj.^name ~ " cannot be implicitly JSONified";
    }
}
subtest "Complex Hashes And Arrays" => {
    plan 1;
    my class Rec is json {
        has Int:D $.id is required;
        has Str:D $.payload is required;
        multi method new(Int:D $id, Str:D $payload) is raw {
            self.new: :$id, :$payload
        }
    }
    my class Cmplx is json(:implicit) {
        has Array[Rec:D] %.codes;
        has Hash[Rec:D, Int:D()] @.code-idx;
    }

    my $expected =
        Cmplx.new:
            codes =>
                ( "c1" => (my @ is Array[Rec:D] = Rec.new(11, "rec1"), Rec.new(21, "rec2")),
                "c2" => (my @ is Array[Rec:D] = Rec.new(12, "s1"), Rec.new(22, "s2")) ),
            code-idx =>
                ( (my % is Hash[Rec:D, Int:D()] = 331 => Rec.new(331, "rec100"), 32 => Rec.new(32, "rec101")),
                (my % is Hash[Rec:D, Int:D()] = 41 => Rec.new(41, "rec200"), 42 => Rec.new(42, "rec201")) )
            ;

    my $json = q<{"code-idx":[{"331":{"id":331,"payload":"rec100"},"32":{"id":32,"payload":"rec101"}},{"41":{"id":41,"payload":"rec200"},"42":{"id":42,"payload":"rec201"}}],"codes":{"c1":[{"id":11,"payload":"rec1"},{"id":21,"payload":"rec2"}],"c2":[{"id":12,"payload":"s1"},{"id":22,"payload":"s2"}]}}>;
    my $deserialized = Cmplx.from-json($json);
    cmp-deeply $deserialized, $expected, "deserialized";
}

subtest "Generics" => {
    plan 3;

    subtest "sequence itself as argument" => {
        plan 4;

        my role R[::T] is json {
            has @.items is T;
        }

        my role R is json {
            has Str:D $.id is required;
        }

        my class JSeq is json(:sequence(Num:D())) {}

        my class CInt is json does R[JSeq] does R {}

        my $c = CInt.from-json(q<{"items":[3,4,1],"id":"ABCD-EF-18"}>);

        isa-ok $c.items, JSeq, "the positional attribute type is the sequence";
        isa-ok $c.items.List[1], Num, "sequence item has correct type";
        is $c.items[1], 4e0, "item value";
        is $c.id, "ABCD-EF-18", "both candidates of the role are active";
    }

    subtest "sequence item type as argument" => {
        plan 3;

        my class ItemRec is json {
            has Str:D $.id is required;
            has Str:D $.name is required;
        }

        my \r = my role R[::T] is json {
            # This package here is only to create tougher conditions for the test itself. No functional meaning here.
            my package S {
                class RJSeq is json(:sequence(T, default => T)) {}
            }

            has @.items is S::RJSeq;

            method seq-type { S::RJSeq }
        }

        my class CS does R[Str:D()] {}
        my class CN does R[Num:D()] {}

        my $role-attr = r.^get_attribute_for_usage('@!items');

        ok $role-attr.type.^archetypes.generic, "role attribute's type is generic";

        my sub is-non-generic(Mu \class-type, Mu \data-type) is test-assertion {
            subtest "Class " ~ class-type.^name => {
                plan 6;
                my $attr = class-type.^get_attribute_for_usage('@!items');
                nok $attr.type.^json-item-descriptors.map(*.is-generic).any, "no generic descriptor slips in";
                nok $attr.type.^json-item-default.^archetypes.generic, "default value is not generic";
                nok class-type.^archetypes.generic, "class itself is not generic";
                isa-ok class-type.seq-type, $role-attr.type, "instantiated class is a subclass of the role's generic one";
                isa-ok class-type.seq-type.^json-item-default, nominalize-type(data-type), "default value type";

                my $json = q<{"items":[7,4,8,3]}>;
                my $obj = class-type.from-json($json);

                ok $obj.items.List.all ~~ nominalize-type(data-type), "JSON values deserialized into correct data type";
            }
        }

        is-non-generic(CS, Str:D());
        is-non-generic(CN, Num:D());
    }

    subtest "dictionary item and key types as arguments" => {

        my class ItemRec is json {
            has Str:D $.id is required;
            has Str:D $.name is required;
        }

        my \r = my role R[::VT, ::KT] is json {
            # This package here is only to create tougher conditions for the test itself. No functional meaning here.
            my package S {
                class RJDict is json(:dict(default => VT, VT, :keyof(KT))) {}
            }

            has %.items is S::RJDict;

            method dict-type { S::RJDict }
        }

        my $role-attr = r.^get_attribute_for_usage('%!items');

        ok $role-attr.type.^archetypes.generic, "role attribute's type is generic";

        my sub is-non-generic(Mu \class-type, Mu \data-type, Mu \key-type) is test-assertion {
            subtest "Class " ~ class-type.^name => {
                plan 8;
                my $attr = class-type.^get_attribute_for_usage('%!items');
                nok $attr.type.^json-item-descriptors.map(*.is-generic).any, "no generic descriptor slips in";
                nok $attr.type.^json-key-descriptor.is-generic, "key descriptor is not generic";
                nok $attr.type.^json-item-default.^archetypes.generic, "default value is not generic";
                nok class-type.^archetypes.generic, "class itself is not generic";
                isa-ok class-type.dict-type, $role-attr.type, "instantiated class is a subclass of the role's generic one";
                isa-ok class-type.dict-type.^json-item-default, nominalize-type(data-type), "default value type";

                my $json = q<{"items":{"1.1":"42","2.2":"3.1415926"}}>;
                my $obj = class-type.from-json($json);

                cmp-deeply
                    $obj.items.values.map({ .WHAT }).List,
                    (nominalize-type(data-type) xx $obj.items.values.elems).List,
                    "JSON values deserialized into correct data type";
                cmp-deeply
                    $obj.items.keys.map({ .WHAT }).List,
                    (nominalize-type(key-type) xx $obj.items.keys.elems).List,
                    "JSON keys deserialized into correct data type";
            }
        }

        my class DS does R[Str:D(),Int:D()] {}
        my class DN does R[Num:D(),Rat:D()] {}

        is-non-generic(DS, Str:D(), Int:D());
        is-non-generic(DN, Num:D(), Rat:D());
    }
}

subtest "Keyed hash" => {
    plan 4;

    my class ComplexKey {
        has Str:D $.pfx is required;
        has Str:D $.key is required;
    }
    my class KHRec is json(:implicit, :lazy) {
        has %.id2name{Int:D};
        has %.cmplx{ComplexKey:D};
    }

    my $khrec;

    $khrec = KHRec.new: id2name => (123 => "name1", 42 => "name 2");

    my $expected = q<{"cmplx":{},"id2name":{"123":"name1","42":"name 2"}}>;
    is $khrec.to-json(:sorted-keys, :!pretty), $expected, "serialized hash with basic key type";

    my $json = q<{"id2name":{"123": "name1","42":"name 2"}}>;
    cmp-deeply KHRec.from-json($json), $khrec, "deserialized hash with basic key type";

    $khrec = KHRec.new: cmplx => (
        ComplexKey.new(:pfx<aa>, :key<kk>) => "value 1",
        ComplexKey.new(:pfx<bb>, :key<kk>) => "value 2",
    );

    my $cmplx-expected = q<{"cmplx":{"{\"key\":\"kk\",\"pfx\":\"aa\"}":"value 1","{\"key\":\"kk\",\"pfx\":\"bb\"}":"value 2"},"id2name":{}}>;
    is $khrec.to-json(:sorted-keys, :!pretty), $cmplx-expected, "serialized hash with complex key";

    my $cmplx-json = q<{"cmplx":{"{\"key\":\"kk\",\"pfx\":\"aa\"}":"value 1","{\"key\":\"kk\",\"pfx\":\"bb\"}":"value 2"}}>;
    cmp-deeply
        KHRec.from-json($cmplx-json).cmplx.keys.sort(*.pfx),
        $khrec.cmplx.keys.sort(*.pfx),
        "deserialized hash with complex key: keys are the same";
}

subtest "Coercion Into A JSONish" => {
    plan 3;

    my subset MyURIStr of Str:D where /^ "mine://" <.wb> /;
    my class MyURI is json {
        has Str:D $.orig is required;
        method COERCE(MyURIStr $orig) {
            test-suite.pass: "coercion method is involved";
            self.new: :$orig
        }
    }

    my class Locator is json {
        has MyURI:D(MyURIStr) $.pos is json(:to-json<Str>, :from-json<COERCE>);
    }

    my $my-uri = "mine://foo/bar/baz";

    subtest "direct" => {
        plan 3;
        my $loc;
        lives-ok { $loc = Locator.from-json(q:s<{"pos":"$my-uri"}>) }, "deserialized via coercion";
        is $loc.pos.orig, $my-uri, "deserialized via coercion";
    }

    throws-like
        { Locator.from-json(q<{"pos":"not-mine://irrelevant"}>, :config(:eager)) },
        JSON::Class::X::Deserialize::Fatal,
        exception => JSON::Class::X::Deserialize::Impossible,
        "deserialization fails if string doesn't match coercions constrain";

    subtest "with type wrapping" => {
        plan 3;
        my $config = JSON::Class::Config.new;

        my class WrapURI is json-wrap(MyURI) {}
        $config.map-type(MyURI, WrapURI);

        is $config.type-from(MyURI), WrapURI, "ok, there is a mapping for " ~ MyURI.WHICH;

        my $loc = Locator.from-json(q:s<{"pos":"$my-uri"}>, :$config);

        isa-ok $loc.pos, WrapURI, "type mapping works when coercion is involved";
    }
}

done-testing;


