### ----------------------------------------------------
### -- Config::BINDish
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman <vrurg@lflat.org>
### -- File: t/040-explicit-struct.rakutest
### ----------------------------------------------------
use v6.d;
use Test::Async <Config::BINDish::Test Base>;
use Config::BINDish;
use Config::BINDish::Grammar;
use Config::BINDish::AST;
use Config::BINDish::X;

plan 9, :parallel;

# The purpose of this test suite is to make sure that in strict mode only pre-declared constructs are allowed.
my $custom-set-invoked = False;

role CustomExt is BINDish-grammar {
    submethod setup-BINDish {
        $custom-set-invoked = True;
        self.declare-blocks:
            :my-top => { :in<.TOP> },
            :my-top-named => { :in<.TOP>, :named },
            my-sub => { :in<my-top> },
        ;
        self.declare-options:
            op-top => { :in<.TOP>, :type(Str) },
            op-bool => { :type(Bool) },
            op-any => {},
            op-numish => { value-sym => <int num rat> },
    }
}

my $cfg = Config::BINDish.new:
        :strict{:blocks, :options},
        blocks => (
            :general => { :in<.TOP>, :!named },
            :subsystem => { :in<.TOP>, :named },
            :paths => { :in<general subsystem>, :named, :type(Str), :value-only, :value-sym<file-path string> },
            :numbers => { :in<subsystem>, :type(Numeric), :value-only, :value-sym<int rat num> },
            :strings => { :in<subsystem general>, :type(Stringy), :value-only },
            blist => { :named, :!classified, :type-name<keyword>, :value-only },
            :unvaluable => { :no-values },
            lookup => { :value-sym<string file-path>, :value-only },
            :classy => { :named, :classified },
        ),
        options => (
            base => { :in<paths>, type => Str },
            max => { :in<general>, type => Int },
            min => { :in<general>, type => Int, :where(* >= 2), :why('must be 2 or more') },
            multi-type => { :in<general>, type => Int | Rat },
            stringy => { :in{:general, :unvaluable}, type-name => /\- string$/ },
            pathy => { value-sym => <file-path>, type => Str },
            :desc => { :in(:classy<described>), type => Str },
        );

does-ok $cfg.grammar, CustomExt, "grammar does our custom extension";

$cfg.read: string => '';
ok $custom-set-invoked, "custom extension setup method has been invoked";

subtest "Syntax" => {
    plan 10;

    lives-ok { $cfg.read: string => q<my-top "named" { }> },
        "when name is optional it can be used";

    lives-ok { $cfg.read: string => q<my-top-named "named" { }> },
        "name is required and present";

    lives-ok { $cfg.read: string => q<subsystem "named" classified { }> },
        "when class is optional it can be used";

    lives-ok { $cfg.read: string => q<my-top "named" classified { }> },
        "when name and class are optional both can be used";

    lives-ok { $cfg.read: string => q<classy "named" described { desc "anything"; }> },
        "option bound to a classified block";

    throws-like { $cfg.read: string => q<subsystem { }> },
        Config::BINDish::X::Parse::MissingPart,
        "when block must be named",
        :message(/"Name is missing in declaration of block 'subsystem'"/);

    throws-like { $cfg.read: string => q<op-numish;> },
        Config::BINDish::X::Parse::SpecificValue,
        "value type specific option requires a value",
        :message(/"Option 'op-numish' value must be int, num, or rat"/);

    throws-like { $cfg.read: string => q<general "named" { }> },
        Config::BINDish::X::Parse::ExtraPart,
        "when block must be unnamed",
        :message(/"Name is unexpected in declaration of block 'general" <.wb>/);

    throws-like { $cfg.read: string => q<blist "named" classified { }> },
        Config::BINDish::X::Parse::ExtraPart,
        "block can't be classified",
        :message(/"Class is unexpected in declaration of block 'blist \"named\""/);

    throws-like { $cfg.read: string => q<classy "named" non-desc { desc "can't be here" }> },
        Config::BINDish::X::Parse::Context,
        "option bound to a classified block in a differently classified one",
        :message(/"Option 'desc' cannot be used in block 'classy \"named\" 'non-desc'"/);
}

subtest "Structure" => {
    plan 7;

    throws-like { $cfg.read: string => q:to/CFG/;
                                        my-top {
                                            paths "public" {
                                                "pub/";
                                                "user/pub";
                                            }
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Context,
                "block used in a wrong context",
                :message(/"Block 'paths' cannot be used in block 'my-top'"/);

    lives-ok { $cfg.read: string => q:to/CFG/;
                                        subsystem "storage" {
                                            paths "public" {
                                                "pub/";
                                                "user/pub";
                                                etc/some.cfg;
                                            }
                                        }
                                        CFG
             },
             "block used within correct context";

    throws-like { $cfg.read: string => q:to/CFG/;
                                        subsystem "storage" {
                                            numbers {
                                                1;
                                                2;
                                                op-numish 13;
                                            }
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Context,
                "option used in a value-only block is an error",
                :message(/"Option 'op-numish' cannot be used in block 'numbers'"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                        subsystem "storage" {
                                            strings {
                                                3.1415926;
                                            }
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "bad value type within a value-only block",
                :message(/"Block 'strings' expects a (Stringy) value but got <rat> of (Rat)"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                        subsystem "storage" {
                                            numbers {
                                                "not a number";
                                            }
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::SpecificValue,
                "bad value type within a value-only block when specific value-sym is used",
                :message(/"Block 'numbers' value must be int, rat, or num"/);

    lives-ok { $cfg.read: string => q:to/CFG/;
                                    unvaluable {
                                        stringy "ok";
                                    }
                                    CFG
         },
        "a no-values block";

    throws-like { $cfg.read: string => q:to/CFG/;
                                        unvaluable {
                                            "not ok";
                                        }
                                        CFG
                },
        Config::BINDish::X::Parse::NoValueBlock,
        "a non-value block with a value",
        :message(/"A value encountered in a non-value block 'unvaluable'"/);
}

subtest "Value validation" => {
    plan 23;

    throws-like { $cfg.read: string => q<op-top 1;>; },
                Config::BINDish::X::Parse::Value,
                "bad option value type",
                :message(/"Option 'op-top' expects a (Str) value but got <int> of (Int)"/);

    lives-ok { $cfg.read: string => q<op-top "ok";>; }, "valid option type";

    lives-ok {
        $cfg.read: string => q:to/CFG/;
                    my-top {
                        op-bool off;
                    }
                    CFG
    }, "boolean option with explicit value";

    throws-like {
                    $cfg.read: string => q:to/CFG/;
                    my-top {
                        op-bool non-boolean;
                    }
                    CFG
                },
                Config::BINDish::X::Parse::Value,
                :message(/"Option 'op-bool' expects a (Bool) value but got <keyword> of (Str)"/),
                "boolean option with a non-boolean keyword";

    throws-like { $cfg.read: string => q:to/CFG/;
                                general {
                                    min 1;
                                }
                                CFG
                },
        Config::BINDish::X::Parse::Value,
        "option in a block, value doesn't pass `where` constraint",
        :message(/"Option 'min' expects a (Int) value (must be 2 or more) but got 1"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                general {
                                    max 4.2;
                                }
                                CFG
                },
                Config::BINDish::X::Parse::Value,
                "option in a block, bad value",
                :message(/"Option 'max' expects a (Int) value but got <rat> of (Rat)"/);

    lives-ok { $cfg.read: string => q:to/CFG/;
                                general {
                                    max 4;
                                }
                                CFG
            },
             "option in a block with good value type";

    throws-like { $cfg.read: string => q:to/CFG/;
                                        general {
                                            strings {
                                                "pub/";
                                                "user/pub";
                                                3.1415926;
                                            }
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "bad value type in a block",
                :message(/"Block 'strings' expects a (Stringy) value but got <rat> of (Rat)"/);

    lives-ok { $cfg.read: string => q:to/CFG/;
                                        general {
                                            paths "public" {
                                                "pub/";
                                                "user/pub";
                                            }
                                        }
                                        CFG
             },
             "all block values are good";

    lives-ok { $cfg.read: string => q:to/CFG/;
                                        general {
                                            multi-type 42;
                                            multi-type 3.1415926;
                                            stringy "dq-string";
                                            stringy 'sq-string';
                                        }
                                        CFG
             },
             "multi-typed options are accepted";

    throws-like { $cfg.read: string => q:to/CFG/;
                                        general {
                                            multi-type 1.0e1;
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "multi-type option only accepts allowed types",
                :message(/"Option 'multi-type' expects a any((Int), (Rat)) value but got <num> of (Num)"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                        general {
                                            stringy 13;
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "stringy option only accepts '-string' named types",
                :message(/"Option 'stringy' expects a \/\\- string\$\/ value but got <int> of (Int)"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                        general {
                                            stringy bareword;
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "stringy option doesn't accept a keyword even though it's a Str",
                :message(/"Option 'stringy' expects a \/\\- string\$\/ value but got <keyword> of (Str)"/);

    subtest "keyword list in a value-only block", :instant, {
        plan 5;

        if lives-ok {
                        $cfg.read: string => q:to/CFG/;
                                    blist "keywords" {
                                        foo; bar; baz;
                                    }
                                    CFG
             }, "keyword list block"
        {
            is-cfg-stmt-list $cfg.match<body>,
                             %(
                                 statements => 0 => %(
                                     block-head => %(
                                         block-type => "blist",
                                         block-name => value => dq-string => string => "keywords",
                                     ),
                                     block-body => token-statements(
                                         message => "block values list",
                                         stmt-count => 3,
                                         statements => %(
                                             0 => value => keyword => "foo",
                                             1 => value => keyword => "bar",
                                             2 => value => keyword => "baz",
                                         )
                                                                                                             )
                                 )),
                             "parsed structure of a value-only block";

            my $blist = $cfg.top.block('blist', :name<keywords>);
            my @expected = <foo bar baz>;
            my $idx = 0;
            while @expected {
                my $child = $blist.children[$idx++];
                next unless $child.is-marked('standalone');
                subtest "block child value $idx", :instant, {
                    plan 3;
                    isa-ok $child, Config::BINDish::AST::Value, "is a AST::Value";
                    is $child.type-name, 'keyword', "is a keyword";
                    is $child.payload, @expected.shift, "keyword value";
                }
            }
        }
    }

    throws-like { $cfg.read: string => q:to/CFG/;
                                        blist "strings" {
                                            "foo";
                                        }
                                        CFG
                },
                Config::BINDish::X::Parse::Value,
                "value-only block constrained by type-name",
                :message(/"Block 'blist' expects a <keyword> value but got <dq-string> of (Str)"/);

    throws-like { $cfg.read: string => q:to/CFG/;
                                        op-numish "12";
                                        CFG
                },
                Config::BINDish::X::Parse::SpecificValue,
                "option value parsing is limited to specific types",
                :message(/"Option 'op-numish' value must be int, num, or rat"/);

    lives-ok { $cfg.read: string => q:to/CFG/;
                                        op-numish 3.14;
                                        CFG
             },
             "option parses ok when has specific value type";

    # An option without value type specification would not consider etc to be a path
    lives-ok { $cfg.read: string => q:to/CFG/;
                                        pathy etc;
                                        CFG
             },
             "a file path option parsed ok with a single bareword";
    my $opt = $cfg.get('pathy', :raw);
    is $opt.value(:raw).type-name, 'file-path', "file path option type name";

    lives-ok { $cfg.read: string => q:to/CFG/;
                                    lookup {
                                        /etc;
                                        /usr/local/etc;
                                        conf;
                                        "~/.app.conf";
                                    }
                                    CFG
         },
         "a block set to file-path value type";
    my @lookup = $cfg.top.block('lookup').values(:raw).eager;
    is +@lookup, 4, "the number of file-path block values";
    is-deeply @lookup[^3].map(*.type-name), 'file-path' xx 3, "first three values are paths";
    is @lookup[*-1].type-name, 'dq-string', "the last block value is a string";
}

subtest "Competing Value Types" => {
    # When custom value type competes with another value type in terms of parsing it then specifying value-sym for an
    # option may help in specifying what exact value type is expected.
    # For example, in this test 'whatever' type is defined in a way it competes with double-quoted strings because it
    # starts and ends with double quotes. By setting value-sym to either 'string' or 'whatever' we limit parsing to
    # these particular types only.
    plan 2;
    my role BadValueType {
        # It is bad because it competes with dq-string
        token value:sym<whatever> {
            '"*"' { self.set-value: Str, :whatever($/) }
        }
    }

    my role BVTActions {
        method value:sym<whatever>($/) {
            make Config::BINDish::AST.new-ast: 'Value', :payload('*');
        }
    }

    for <string dq-string>, <whatever whatever> -> ($sym, $type-name) {
        subtest "value type is $sym" => {
            plan 5;
            my $cfg = Config::BINDish.new:
                :strict{:blocks, :options},
                extend-grammar => [BadValueType],
                extend-actions => [BVTActions],
                options => ( foo => { :type(Str), value-sym => ($sym) } );

            $cfg.read: string => q:to/CFG/;
                                foo "*";
                                CFG

            lives-ok {
                         $cfg.read: string => q:to/CFG/;
                                foo "*";
                                CFG
            }, "parsed with option being a $sym";
            ok ?$cfg.match, "parse is successfull";
            abort-testing unless ?$cfg.match;
            my $option = $cfg.get("foo", :raw);
            ok $option.defined, "option object is present";
            isa-ok $option.value, Str, "option's value is Str";
            is $option.value(:raw).type-name, $type-name, "option's value type name is $type-name";
        }
    }
}

subtest "Advanced Nesting" => {
    plan 3;

    subtest "Different Option Types" => {
        plan 6;

        my $cfg = Config::BINDish.new:
            :strict{:options},
            options => (
                :ids<id> => { :in<resource>, :type(Str) },
                :idn<id> => { :in<sequential>, :type(Int) },
            );

        lives-ok {
            $cfg.read: string => q:to/CFG/;
                                    resource {
                                        id "answer-0042";
                                    }
                                    sequential {
                                        id 13;
                                    }
                                    CFG
        }, "parsed didn't throw";

        ok ?$cfg.match, "parse is successfull";

        my $id = $cfg.get(:resource => "id");
        is $id, "answer-0042", "option 'id' value in 'resource'";
        $id = $cfg.get(:sequential => "id");
        is $id, 13, "option 'id' value in 'sequential'";

        throws-like {
                $cfg.read: string => q:to/CFG/;
                                        foo {
                                            id 1;
                                        }
                                        CFG
            },
            Config::BINDish::X::Parse::Context,
            "multi-variant option in a wrong block throws";

        throws-like {
                $cfg.read: string => q:to/CFG/;
                                        resource {
                                            id 1;
                                        }
                                        CFG
            },
            Config::BINDish::X::Parse::Value,
            "multi-variant option with incorrect value type";
    }

    subtest "Different blocks" => {
        plan 6;
        my $cfg = Config::BINDish.new:
            :strict{:blocks, :options},
            blocks => (
                :params1 => { :in<.TOP> },
                :params2 => { :in<.TOP> },
                :params3 => { },
                :det1<details> => { :in<params1>, },
                :det2<details> => { :in<params2>, },
            ),
            options => (
                :th1<threshold> => { :in<det1>, :type(Rat) },
                :th2<threshold> => { :in<det2>, :type(Int) },
            );

        lives-ok {
            $cfg.read: string => q:to/CFG/;
                                    params1 {
                                        details {
                                            threshold 3.1415926;
                                        }
                                    }
                                    params2 {
                                        details {
                                            threshold 42;
                                        }
                                    }
                                    CFG
        },
        "parse didn't throw";

        ok ?$cfg.match, "parse is successfull";

        my $thrshld = $cfg.get(:params1 => :details => "threshold");
        is $thrshld, 3.1415926, "option 'threshold' value in 'details' in 'params1'";
        $thrshld = $cfg.get(:params2 => :details => "threshold");
        is $thrshld, 42, "option 'threshold' value in 'details' in 'params2'";

        throws-like {
                        $cfg.read: string => q:to/CFG/;
                                    params3 {
                                        details {
                                            threshold 3.1415926;
                                        }
                                    }
                                    CFG
                    },
                    Config::BINDish::X::Parse::Context,
                    "use of pre-declared block in a wrong block throws";

        throws-like {
                        $cfg.read: string => q:to/CFG/;
                                    params2 {
                                        details {
                                            threshold 3.1415926;
                                        }
                                    }
                                    CFG
                    },
                    Config::BINDish::X::Parse::Value,
                    "wrong option value type in a multi-variant block throws";
    }

    subtest "Errors" => {
        plan 4;

        my $cfg = Config::BINDish.new:
            blocks => (
                :params1 => { :in<.TOP> },
                :params2 => { :in<.TOP> },
                :det1<details> => { :in<params1>, },
                :det2<details> => { :in<params1>, },
            );

        throws-like {
                        $cfg.read: string => 'params1 { }';
                    },
                    Config::BINDish::X::DuplicateKeyword,
                    "pre-declaring same-named blocks in the same parent block throws";

        $cfg = Config::BINDish.new:
            blocks => (
                :params => { :in<.TOP> },
            ),
            options => (
                :opt1<opt> => { :in<params> },
                :opt2<opt> => { :in<params> },
            );
        throws-like {
                        $cfg.read: string => 'params { }';
                    },
                    Config::BINDish::X::DuplicateKeyword,
                    "pre-declaring options with the same name in the same parent block throws";

        $cfg = Config::BINDish.new:
            blocks => ( :params => { :in<.TOP> }, ),
            options => ( :opt<opt1> => { :in<params> },
                         :opt<opt2> => { :in<params> },
            );
        throws-like {
                        $cfg.read: string => 'params { }';
                    },
                    Config::BINDish::X::DuplicateID,
                    "pre-declaring options with the same ID throws";

        $cfg = Config::BINDish.new:
            blocks => ( params => { :in<.TOP> },
                        :dup<foo> => { :in<params> },
                        :dup<bar> => { :in<params> },
            );
        throws-like {
                        $cfg.read: string => 'params { }';
                    },
                    Config::BINDish::X::DuplicateID,
                    "pre-declaring blocks with the same ID throws";
    }
}

subtest "Auto-vivification" => -> \suite {
    plan 8;
    # Using setup-BINDish to test autovivification becase direct access to grammar's `declare-*` is needed and this
    # submethod is the guaranteed location which is invoked always and provides us with a grammar instance, not its
    # typeobject, as we would get on $cfg.
    my $cfg = Config::BINDish.new:
        extend-grammar => my role {
            submethod setup-BINDish {
                self.declare-option: "opt", :in<params>;
                suite.ok: (my $props = self.prop-relations<.ANYWHERE><block><params>).defined,
                          "block is declared";
                suite.ok: $props.autovivified, "block was autovivified";
                suite.lives-ok: {
                                    self.declare-block: :id<params>, :keyword, props => { :in<.TOP> };
                                }, "re-declaration of autovivified block doesn't fail";
                suite.ok: self.prop-relations<.TOP><block><params>:exists,
                          "re-declared block resides on .TOP";
                suite.nok: self.prop-relations<.ANYWHERE><block><params>:exists,
                           "re-declared block is not anymore on .ANYWHERE";
                if (suite.ok(self.prop-relations<.TOP><block><params>:exists,
                             "the new block declaration is now on .TOP"))
                {
                    suite.nok: self.prop-relations<.TOP><block><params>.autovivified,
                               "the new block declaration is not autovivified";
                }
                else {
                    skip "can't test for autovivification on missing block declaration";
                }
                suite.throws-like: {
                                       self.declare-block: <params>, <params>;
                                   }, Config::BINDish::X::DuplicateID, "second manual re-declaration throws";
            }
        };
    $cfg.read: string => "";
}

subtest "Boolean/keyword conflicts" => {
    plan 17;
    my $cfg = Config::BINDish.new:
                options => (
                    |(|("true-opt$_" => { :type(Bool) }, "false-opt$_" => { :type(Bool) }) for ^3),
                    kw-opt => { :type(Str), :value-sym<keyword> },
                 );
    lives-ok {
        $cfg.read: string => q:to/CFG/;
                                true-opt0 on;
                                true-opt1 yes;
                                true-opt2 true;
                                false-opt0 off;
                                false-opt1 no;
                                false-opt2 false;
                                kw-opt true;
                                any-opt true;
                                CFG
    }, "config parsed";

    for (True, False) -> $val {
        my $opt-base = $val.Str.lc ~ '-opt';
        for ^3 -> $idx {
            my $opt-name = $opt-base ~ $idx;
            is $cfg.top.option($opt-name).value(:raw).type-name, 'bool', "$opt-name type is boolean";
            cmp-ok $cfg.top.value($opt-name), '===', $val, "$opt-name is " ~ $val;
        }
    }

    cmp-ok $cfg.top.value('any-opt'), '===', True,
           'option without a pre-declaration gets a bool';
    is $cfg.top.option('any-opt').value(:raw).type-name,
       'bool',
       'option without a pre-declaration parsed as a bool';

    is $cfg.top.value('kw-opt'),
       'true',
       '`keyword` value-sym makes `true` parsed as a keyword';
    is $cfg.top.option('kw-opt').value(:raw).type-name,
       'keyword',
       '`keyword` value-sym makes `true` parsed as `keyword` type';
}

done-testing;


