### ----------------------------------------------------
### -- JSON::Class
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman
### -- File: t/055-dict.rakutest
### ----------------------------------------------------
use v6.e.PREVIEW;
use Test::Async;
use JSON::Class:auth<zef:vrurg>;

plan 7;

subtest "Basics" => {
    plan 26;

    my class JDict is json( :dictionary( default => Num, Num(Rat), Str:D ) ) {}

    my $jdict = JDict.new("pi", π, "the-answer", 42.0, "foo" => "bar", "baz" => 12e0, "nullish" => Nil, "undefy" => Num);

    isa-ok $jdict<the-answer>, Num, "coercive item";

    throws-like {
            $jdict<bad> = 13;
        },
        X::TypeCheck::Assignment,
        :got(13),
        :expected($jdict.of),
        "assignment of a wrong value type";

    throws-like {
            $jdict<noundef> = Str;
        },
        X::TypeCheck::Assignment,
        :got(Str),
        :expected($jdict.of),
        "assignment of an undef type";

    my $json = $jdict.to-json(:!pretty, :sorted-keys);
    my $expected = q<{"baz":12e0,"foo":"bar","nullish":null,"pi":3.141592653589793e0,"the-answer":42e0,"undefy":null}>;

    is $json, $expected, "serialized dictionary";

    my $deserialized = JDict.from-json($expected);

    is $deserialized.elems, 6, "element count before full deserialization";
    cmp-deeply $deserialized, $jdict, "deserialized into indentical object";
    ok $deserialized.json-all-set, "iterating over all keys fully deserialzies";
    # Address a bug where resetting $!json-raw to Nil results in it counted as an extra element.
    is $deserialized.elems, 6, "element count after full deserialization";

    $deserialized = JDict.from-json($expected);

    nok $deserialized<undefy>:has, "an item is not deserialized";

    my @expected-keys := <baz foo nullish pi the-answer undefy>;
    cmp-deeply $deserialized.keys.sort.List, @expected-keys, "all keys found";
    cmp-deeply $deserialized{@expected-keys}:has, False xx +@expected-keys, "pulling in keys doesn't deserialize";

    is $deserialized<undefy>, Num, "deserialized initially undefined value";
    is $deserialized<nullish>, Num, "deserialized initially Nil value, turned into the default";
    is $deserialized<the-answer>, 42e0, "deserialized a former rational, coerced into a Num";

    cmp-deeply $deserialized{@expected-keys}:has.List, (False, False, True, False, True, True),
               ":has on unmarshalled is true";
    ok $deserialized<nullish>:has, ":has on on individual key after deserialization";

    cmp-deeply $deserialized{@expected-keys}:exists, (True xx +@expected-keys).List,
               ":exists is true, no matter if already unmarshalled";

    nok $deserialized<NO-VALUE-FOR-THIS>:has, ":has on a non-existing key";
    nok $deserialized<NO-VALUE-FOR-THIS>:exists, ":exists on a non-existing key";

    nok $deserialized.json-all-set, "still not fully deserialized";

    # Older versions of Rakudo return hash .of upon deleting non-existing keys for parameterized hashes, not their `is
    # default`. We just make sure here that JSON::Dict follows the current semantics.
    my Int:D %std{Str:D} is default(42);
    my $expected-default := %std<foo>:delete ~~ 42 ?? JDict.^json-item-default !! JDict.of;
    is-deeply $deserialized<baz foo pi>:delete, ($expected-default xx 3).List,
              "deleting pending items returns dictionary default value";

    ok $deserialized.json-all-set, "deleting all pending items makes the dictionary complete";

    subtest "preliminary completion" => {
        plan 6;
        $deserialized = JDict.from-json(q<{"foo":"bar"}>);
        nok $deserialized.json-all-set, "not complete yet";
        ok $deserialized<foo>:exists, "key exists";
        nok $deserialized<foo>:has, "key not deserialized";
        $deserialized<foo> = "override";
        ok $deserialized<foo>:exists, "key still exists";
        ok $deserialized<foo>:has, "key is deserialized";
        ok $deserialized.json-all-set, "complete";
    }

    my @old-keys = $jdict.keys;
    $jdict<> = (:key<first>, :second(2.0));
    is ($jdict.keys ∩ @old-keys).elems, 0, "list-assigning to a dictionary replaces all keys";

    my %jdict is JDict;
    isa-ok %jdict, JDict, "JSON dictionary can be used as a %-sigil type";
    %jdict = $jdict;
    cmp-deeply %jdict, $jdict.Hash, "assigning from another JSON dictionary";
}

subtest "Deep Struct" => {
    plan 2;
    my class Rec is json(:implicit) {
        has Int:D $.id is required;
        has Str:D $.file is required;
    }

    my class RecDict is json( :dict(Rec:D) ) {}

    my class State is json(:implicit) {
        has Version:D() $.ver is required;
        has %.records is RecDict;
    }

    my $st = State.new(:ver<0.1.2>);
    $st.records =
        "r1" => Rec.new(id => 1, file => "a/b/c.pdf"),
        "r2" => Rec.new(id => 2, file => "X/Y/Z.txt");

    my $expected = q<{"records":{"r1":{"file":"a/b/c.pdf","id":1},"r2":{"file":"X/Y/Z.txt","id":2}},"ver":"0.1.2"}>;
    is $st.to-json(:!pretty, :sorted-keys), $expected, "serialized";

    my $deserialized = State.from-json($expected);
    cmp-deeply $deserialized, $st, "deserialized";
}

subtest "Non-basic Values" => {
    plan 3;
    my class JRec is json {
        has Num:D(Numeric:D) $.x is required;
        has Num:D(Numeric:D) $.y is required;
        has Num:D(Numeric:D) $.size is required;
    }

    my class Rec {
        has Str:D $.descr is required;
        has Rat:D(Numeric:D) $.value is required;
    }

    class JDict is json( :dictionary(JRec, Rec:D) ) {}

    my %jdict is JDict =
        jrec => JRec.new(:x(10), :y(20), :size(1.25)),
        rec => Rec.new(:descr("some object"), :value(3.1415926));

    my $expected = q<{"jrec":{"size":1.25e0,"x":10e0,"y":20e0},"rec":{"descr":"some object","value":3.1415926}}>;
    is %jdict.to-json(:!pretty, :sorted-keys), $expected, "serialized";

    my $deserialized = JDict.from-json($expected);
    cmp-deeply $deserialized, %jdict, "deserialization is identical to the original";
    cmp-ok $deserialized<rec>.WHAT, &[=:=], Rec, "deserialization of a non-JSON class doesn't alter original value type";
}

subtest "Key Marshalling" => {
    plan 3;

    subtest "Default Key Type" => {
        plan 9;
        my class JKDict
            is json(
                :dictionary(
                    Num(Numeric), Str:D,
                    default => Num,
                    :keyof( to-json => { "FOO:" ~ $^key },
                            from-json => {
                                $^json-key.starts-with("FOO:")
                                    ?? $json-key.substr(4)
                                    !! die "bad source key '$json-key'"
                            } ))) {}

        my %jdict is JKDict = :k1(1), :k2<second>;

        is-deeply %(%jdict.kv), %(%jdict.pairs), ".kv is identical to .pairs";
        is-deeply %jdict.kv[0,2...*].sort, %jdict.keys.sort, "keys from .kv are the same as in .keys";
        is (%jdict.kv[1,3...*] (-) %jdict.values).elems, 0, "values from .kv are the same as in .values";

        my $expected = q<{"FOO:k1":1e0,"FOO:k2":"second"}>;

        is-deeply %jdict.keys.List.sort, <k1 k2>, "keys are unmodified for the user";
        is-deeply %jdict<k1 k2>, (1e0, "second"), "values are visible through the keys";
        is %jdict.to-json(:!pretty, :sorted-keys), $expected,
           "but serialized modified by the :to-json/:serializer code";

        my %deserialized is JKDict .= from-json($expected);

        cmp-deeply %deserialized.Hash, %jdict.Hash, "unmarshalling restores the original keys";

        lives-ok { %deserialized := JKDict.from-json(q<{"bad-key":"dies"}>); }, "bad key survives lazy deserialization";
        throws-like
            { %deserialized.keys },
            X::AdHoc,
            :message("bad source key 'bad-key'"),
            "user deserializer dies on what it considers a badly formatted key";
    }

    subtest "Coercive Key Type" => {
        plan 6;

        my class JKDict
            is json(
                :dictionary(
                    default => False, Bool:D, Str:D,
                    :keyof(
                        Real:D(),
                        to-json => { $^key.fmt("%.5f") } ))) {}

        my %jdict is JKDict = (π) => True, (e) => True, 1 => False, 2.123456789 => "questionable";

        my $expected = q<{"1.00000":false,"2.12346":"questionable","2.71828":true,"3.14159":true}>;

        is %jdict.to-json(:!pretty, :sorted-keys), $expected, "user serializer modifies keys";

        %jdict{"12.24"} = "coerced?";
        is %jdict{12.24}, "coerced?", "key gets coerced on assignment";

        my %deserialized is JKDict .= from-json($expected);
        # We can't test for roundtripping here because user serializer loses precission.
        my %expected{Real:D()} = 1.0 => False, 2.12346 => "questionable", 2.71828 => True, 3.14159 => True;
        cmp-deeply %deserialized.Hash, %expected, "deserialized correctly";
        is-deeply %deserialized.keys.map({ .WHAT }).List, (Rat xx 4), "deserialized key types";

        # Try different key type.
        %deserialized .= from-json(q<{"1.00000e2":false,"2.12346":"questionable","2.71828":true,"3.14159":true}>);
        is-deeply %deserialized.keys.sort.List, (2.12346, 2.71828, 3.14159, 1e2), "deserialized with different key types";
        is-deeply %deserialized.keys.sort.map({ .WHAT }), (Rat xx 3, Num).flat, "deserialized key types are different";
    }

    subtest "Class Key Type" => {
        plan 3;

        my class DKey is json {
            has Str:D $.fname is required;
            has Int:D(Str:D) $.id is required;
        }

        my sub is-identical(\deserialized, \original, $msg?) is test-assertion {
            my @dkeys = deserialized.keys;
            my @okeys = original.keys;
            ok ? ((original{@dkeys}:exists, deserialized{@okeys}:exists).flat.all
                    && (original{@dkeys}.Bag (==) deserialized{@okeys}.Bag)),
                ($msg // "deserialization is identical to the original");
        }

        subtest "Plain" => {
            plan 3;
            my class TDict is json( :dict( :keyof(DKey:D), Str:D ) ) {}

            my $tdict = TDict.new(
                DKey.new(:fname<f1>, :id(1)) => "v1",
                DKey.new(:fname<f1>, :id(2)) => "v2",
                DKey.new(:fname<f2>, :id(1)) => "v3",
            );

            is $tdict{ DKey.new(:fname<f1>, :id(1)) }, "v1", "key objects are invariants over their JSON representation";

            my $expected = q<{"{\"fname\":\"f1\",\"id\":1}":"v1","{\"fname\":\"f1\",\"id\":2}":"v2","{\"fname\":\"f2\",\"id\":1}":"v3"}>;

            is $tdict.to-json(:!pretty, :sorted-keys), $expected,
               "by default class key serializes into its JSON representation";

            my $deserialized = TDict.from-json($expected);

            # WAITING cmp-deeply is for when fixed version 0.1.16+ of Test::Async gets published.
            # cmp-deeply $deserialized, $tdict, "same as the original";

            # Until we can use cmp-deeply compare the two by matching all keys and all values.
            is-identical($deserialized, $tdict);
        }

        subtest "Custom Key Marshalling" => {
            plan 2;
            my class TDictCustom
                is json(
                    :dict(
                        :keyof( DKey:D,
                                to-json => { .fname ~ ":" ~ .id },
                                from-json => { DKey.new(|%( <fname id> Z=> .split(":") )) } ),
                        Str:D ) ) {}

            my $tdict = TDictCustom.new(
                DKey.new(:fname<f1>, :id(1)) => "v1",
                DKey.new(:fname<f1>, :id(2)) => "v2",
                DKey.new(:fname<f2>, :id(1)) => "v3",
            );

            my $expected = q<{"f1:1":"v1","f1:2":"v2","f2:1":"v3"}>;
            is $tdict.to-json(:!pretty, :sorted-keys), $expected, "serialized";

            my $deserialized = TDictCustom.from-json($expected);
            is-identical($deserialized, $tdict);
        }

        subtest "Non-JSON Key Class" => {
            my class PKey {
                has Str:D $.name is required;
                has Rat:D $.q is required;
            }
            my class TDictPKey is json( :dict( :keyof(PKey:D), Str:D ) ) {}

            my $tdict = TDictPKey.new(
                PKey.new(:name<pk1>, :q(1.2)) => "v1",
                PKey.new(:name<pk1>, :q(3.141)) => "v2",
                PKey.new(:name<pk2>, :q(42.12)) => "v3",
            );

            my $expected = q<{"{\"name\":\"pk1\",\"q\":1.2}":"v1","{\"name\":\"pk1\",\"q\":3.141}":"v2","{\"name\":\"pk2\",\"q\":42.12}":"v3"}>;
            is $tdict.to-json(:!pretty, :sorted-keys), $expected, "non-JSON class instance as key";

            my $deserialized = TDictPKey.from-json: $expected;
            ok ? $deserialized.keys.map({ .WHAT =:= PKey }).all, "all keys are of the original type";
        }
    }
}

subtest "Inheritance And Roles" => {
    plan 10;

    my role RDict is json(:dictionary(Str:D, :keyof(Str:D))) {}

    my class PDict is json(:dictionary(Num:D, :keyof(Int))) {}

    my class CDict1 is json(:dictionary(Int:D, :default(42))) does RDict {}
    my class CDict2 is json(:dictionary(Int:D, :default(42))) is PDict does RDict {}

    my $cdict1 := CDict1.new;
    my %cdict2 is CDict2;

    isa-ok CDict2, PDict, "dictionary is subclassing another dictionary";

    cmp-ok CDict1.keyof, &[=:=], Str:D, "key type is picked from role";
    cmp-ok CDict2.keyof, &[=:=], Str:D, "key type is picked from role, inheritance is irrelevant";

    lives-ok { $cdict1<what> = "The Answer" }, "assignment with valid key type";

    throws-like
        { $cdict1{11} = 12 },
        X::TypeCheck::Assignment,
        "using a wrong key type throws";

    throws-like
        { $cdict1<what> = 1e0 },
        X::TypeCheck::Assignment,
        "assigning a wrong type throws";

    throws-like
        { $cdict1{Str} = 2e0 },
        X::TypeCheck::Assignment,
        "undefined key throw when keyof is a definite";

    lives-ok { %cdict2<what> = 1e0 }, "value type is picked from parent class";

    %cdict2.CLEAR;

    %cdict2 = the-answer => 42, const => π, comment => "better a good one";

    my $expected = q<{"comment":"better a good one","const":3.141592653589793e0,"the-answer":42}>;
    is %cdict2.to-json(:sorted-keys), $expected, "serialized";

    cmp-deeply CDict2.from-json($expected), %cdict2, "deserialized";
}

subtest "Vivification" => {
    plan 2;

    my class JDict is json( :dictionary(Int:D) ) {}

    subtest "Scalar" => {
        plan 12;

        my JDict $jdict;

        nok $jdict.defined, "not defined initially";
        lives-ok { $jdict<foo> = 42; }, "assign into a key on undefined";
        ok $jdict.defined, "the scalar now has a definite value";
        isa-ok $jdict, JDict, "scalar value is the dictionary";
        is $jdict<foo>, 42, "key value";

        lives-ok { $jdict = Nil; }, "reset the scalar";
        nok $jdict.defined, "reset to undef";

        throws-like
            { $jdict<bar> = "13"; },
            X::TypeCheck::Assignment,
            :expected(JDict.of),
            :got(Str),
            "wrong value type on assignment vivifies and then throws on assignment";

        ok $jdict.defined, "thrown assignment still leaves the scalar vivified";

        $jdict = Nil;
        $jdict.STORE: (:K1(11), :K2(21));

        ok $jdict.defined, ".STORE vivifies";
        is $jdict.Hash, %(:K1(11), :K2(21)), ".STORE works";

        $jdict = Nil;
        throws-like
            { $jdict.STORE: (:B(1e0),) },
            X::TypeCheck::Assignment,
            :expected(JDict.of),
            :got(Num),
            "wrong value type when .STORE vivifies and then throws on assignment";
    }

    subtest "%-Attribute" => {
        my class Rec is json {
            has %.jdict is JDict is json(:predicate);
        }

        my $r = Rec.from-json: q<{"jdict":{"a":1,"b":2}}>;
        nok $r.json-has-jdict, "the attribute is initially unset";
        cmp-deeply $r.jdict.Hash, {:a(1), :b(2)}, "deserialized";
        ok $r.json-has-jdict, "access to the attribute vivifies it";
    }

}

subtest "Errors" => {
    plan 1;

    throws-like
        q<class BDict is json( :dictionary(:keyof(:default(42))) ) {}>,
        X::Adverb,
        :message(/"Unexpected adverb ':default'" .* "'BDict'"/),
        ":keyof accepts only constraint-related declarations";
}

done-testing;


