#
# This file is part of Config-Model-Itself
#
# This software is Copyright (c) 2007-2016 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
#    Copyright (c) 2007-2011 Dominique Dumont.
#
#    This file is part of Config-Model-Itself.
#
#    Config-Model-Itself is free software; you can redistribute it
#    and/or modify it under the terms of the GNU Lesser Public License
#    as published by the Free Software Foundation; either version 2.1
#    of the License, or (at your option) any later version.
#
#    Config-Model-Itself is distributed in the hope that it will be
#    useful, but WITHOUT ANY WARRANTY; without even the implied
#    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#    See the GNU Lesser Public License for more details.
#
#    You should have received a copy of the GNU Lesser Public License
#    along with Config-Model-Itself; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA

my @warp_in_uniline_or_string = (
    warp => {
        follow => {
            'type'  => '?type',
            'vtype' => '?value_type',
        },
        'rules' => [
            '    $type eq "leaf" 
                            and (    $vtype eq "uniline" 
                                  or $vtype eq "string" 
                                )
                          '
              => { level => 'normal', }
        ]
    },

);

my %warn_if_match_payload = (
    type       => 'hash',
    index_type => 'string',
    level      => 'hidden',
    cargo      => {
        type              => 'node',
        config_class_name => 'Itself::CommonElement::WarnIfMatch',
    },
    @warp_in_uniline_or_string,
);

my %assert_payload = (
    type       => 'hash',
    index_type => 'string',
    level      => 'hidden',
    cargo      => {
        type              => 'node',
        config_class_name => 'Itself::CommonElement::Assert',
    },
    @warp_in_uniline_or_string,
);

[
    [
        name    => 'Itself::CommonElement::WarnIfMatch',
        element => [
            msg => {
                type       => 'leaf',
                value_type => 'string',
                description =>
'Warning message to show user. "$_" will contain the bad value. Example "value $_ is bad". Leave blank or undef to use generated message',
            },
            fix => {
                type       => 'leaf',
                value_type => 'string',
                description =>
'Perl instructions to fix the value. These instructions may be triggered by user. $_ will contain the value to fix.  $_ will be stored as the new value once the instructions are done. C<$self> will contain the value object. Use with care.',
            },
        ],
    ],
    [
        name    => 'Itself::CommonElement::Assert',
        include => 'Itself::CommonElement::WarnIfMatch',
        include_after => 'code',
        element => [
            code => {
                type       => 'leaf',
                value_type => 'string',
                description =>
'Perl instructions to test the value. $_ will contain the value to test. C<$self> will contain the value object. Use with care.',
            },
        ],
    ],
    [
        name => 'Itself::CommonElement',

        # warp often depend on this one, so list it first
        'element' => [

            'mandatory' => {
                type       => 'leaf',
                value_type => 'boolean',
                level      => 'hidden',
                warp       => {
                    follow  => '?type',
                    'rules' => {
                        'leaf' => {
                            upstream_default => 0,
                            level            => 'normal',
                        }
                    }
                }
            },

            # node element (may be within a hash or list)

            'config_class_name' => {
                type       => 'leaf',
                level      => 'hidden',
                value_type => 'reference',
                refer_to   => '! class',
                warp       => {
                    follow => { t => '?type' },
                    rules  => [
                        '$t  eq "warped_node" ' => {

                            # should be able to warp refer_to ??
                            level => 'normal',
                        },
                        '$t  eq "node"' => {

                            # should be able to warp refer_to ??
                            level     => 'normal',
                            mandatory => 1,
                        },
                    ]
                }
            },

            # warped_node: warp parameter for warped_node. They must be
            # warped out when type is not a warped_node

            # end warp elements for warped_node

            # leaf element

            'choice' => {
                type        => 'list',
                level       => 'hidden',
                description => 'Specify the possible values',
                warp        => {
                    follow => {
                        t  => '?type',
                        vt => '?value_type',
                    },
                    'rules' => [
                        '  ($t eq "leaf" and (   $vt eq "enum" 
                                                or $vt eq "reference")
                             )
                           or $t eq "check_list"' => { level => 'normal', },
                    ]
                },
                cargo => { type => 'leaf', value_type => 'uniline' },
            },

            'min' => {
                type        => 'leaf',
                value_type  => 'number',
                level       => 'hidden',
                description => 'minimum value',
                warp        => {
                    follow => {
                        'type'  => '?type',
                        'vtype' => '?value_type',
                    },
                    'rules' => [
                        '    $type eq "leaf" 
                           and (    $vtype eq "integer" 
                                 or $vtype eq "number" 
                               )
                          '
                          => { level => 'normal', }
                    ]
                }
            },

            'max' => {
                type        => 'leaf',
                value_type  => 'number',
                level       => 'hidden',
                description => 'maximum value',
                warp        => {
                    follow => {
                        'type'  => '?type',
                        'vtype' => '?value_type',
                    },
                    'rules' => [
                        '    $type eq "leaf" 
                           and (    $vtype eq "integer" 
                                 or $vtype eq "number" 
                               )
                          '
                          => { level => 'normal', }
                    ]
                }
            },

            'min_index' => {
                type        => 'leaf',
                value_type  => 'integer',
                level       => 'hidden',
                description => 'minimum number of keys',
                warp        => {
                    follow  => { 'type' => '?type', },
                    'rules' => [
                        '$type eq "hash"' =>
                          { level => 'normal', },
                    ]
                }
            },

            'max_index' => {
                type        => 'leaf',
                value_type  => 'integer',
                level       => 'hidden',
                description => 'maximum number of keys',
                warp        => {
                    follow  => { 'type' => '?type', },
                    'rules' => [
                        '$type eq "hash" or $type eq "list"' =>
                          { level => 'normal', },
                    ]
                }
            },

            'default' => {
                type       => 'leaf',
                level      => 'hidden',
                value_type => 'uniline',
                description =>
'Specify default value. This default value will be written in the configuration data',
                warp => {
                    follow  => { 't'            => '?type' },
                    'rules' => [ '$t eq "leaf"' => { level => 'normal', } ]
                }
            },

            'upstream_default' => {
                type       => 'leaf',
                level      => 'hidden',
                value_type => 'uniline',
                description =>
'Another way to specify a default value. But this default value is considered as "built_in" the application and is not written in the configuration data (unless modified)',
                warp => {
                    follow  => { 't'            => '?type' },
                    'rules' => [ '$t eq "leaf"' => { level => 'normal', } ]
                }
            },

            'convert' => {
                type       => 'leaf',
                value_type => 'enum',
                level      => 'hidden',
                description => 'Convert value or index to uppercase (uc) or lowercase (lc).',
                warp => {
                    follow  => { 't' => '?type' },
                    'rules' => [
                        '$t eq "leaf" or $t eq "hash"' => {
                            choice => [qw/uc lc/],
                            level  => 'normal',
                        }
                    ]
                }
            },

            'match' => {
                type       => 'leaf',
                value_type => 'uniline',
                level      => 'hidden',
                description =>
                    'Perl regular expression to assert the validity of the value. To check the '
                    . q!whole value, use C<^> and C<$>. For instance C<^foo|bar$> will allow !
                    . q!C<foo> or C<bar> but not C<foobar>. To be case insentive, !
                    . q!use the C<(?i)> extended pattern. For instance, the regexp !
                    . q!C<^(?i)foo|bar$> will also allow the values !
                    . q!C<Foo> and C<Bar>.!,
                @warp_in_uniline_or_string,
            },

            'assert' => {
                %assert_payload,
                description =>
                  'Raise an error if the test code snippet does returns false. Note this snippet will '
                  . 'also be run on undefined value, which may not be what you want.',
            },

            'warn_if' => {
                %assert_payload,
                description => 'Warn user if the code snippet returns true',
            },

            'warn_unless' => {
                %assert_payload,
                description =>
                  'Warn user if the code snippet returns false',
            },

            'warn_if_match' => {
                %warn_if_match_payload,
                description =>
                  'Warn user if a I<defined> value matches the regular expression. ',
            },

            'warn_unless_match' => {
                %warn_if_match_payload,
                description =>
                  'Warn user if I<defined> value does not match the regular expression',
            },

            'warn' => {
                type       => 'leaf',
                value_type => 'string',
                level      => 'hidden',
                description =>
'Unconditionally issue a warning with this string when this parameter is used. This should be used mostly with "accept"',
                warp => {
                    follow  => { t              => '?type' },
                    'rules' => [ '$t eq "leaf"' => { level => 'normal', }, ]
                },
            },

            'grammar' => {
                type       => 'leaf',
                value_type => 'string',
                level      => 'hidden',
                description =>
"Feed this grammar to Parse::RecDescent to perform validation",
                @warp_in_uniline_or_string,
            },

            'default_list' => {
                type        => 'check_list',
                level       => 'hidden',
                refer_to    => '- choice',
                description => 'Specify items checked by default',
                warp        => {
                    follow  => { t => '?type', o => '?ordered' },
                    'rules' => [
                        '$t eq "check_list" and not $o ' =>
                          { level => 'normal', },
                        '$t eq "check_list" and $o ' => {
                            level   => 'normal',
                            ordered => 1,
                        },
                    ]
                },
            },

            'upstream_default_list' => {
                type     => 'check_list',
                level    => 'hidden',
                refer_to => '- choice',
                description =>
                  'Specify items checked by default in the application',
                warp => {
                    follow  => { t => '?type', o => '?ordered' },
                    'rules' => [
                        '$t eq "check_list" and not $o ' =>
                          { level => 'normal', },
                        '$t eq "check_list" and $o ' => {
                            level   => 'normal',
                            ordered => 1,
                        },
                    ]
                },
            },

            # hash element

            # list element

        ],
    ],
    ];
