The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Sah::Schema::Sah;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.9.39'; # VERSION
our $DATE = '2015-09-09'; # DATE

our %SCHEMAS;

$SCHEMAS{sah_type_name} = ['str' => {
    match => '\A[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*\z',
}];

$SCHEMAS{sah_str_schema} = ['str' => {
    match => '\A[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*\*?\z',
}];

$SCHEMAS{sah_clause_name} = undef; # TODO

$SCHEMAS{sah_clause_set} = [defhash => {
    # tmp
    _prop => {
        # from defhash
        v => {},
        defhash_v => {},
        name => {},
        summary => {},
        description => {},
        tags => {},
        default_lang => {},
        x => {},

        # incomplete
        clause => {
        },
        clset => {
        },
    },
}];

# XXX sah_num_clause_set (based on sah_clause_set)
# XXX sah_

$SCHEMAS{sah_extras} = [defhash => {
    _prop => {
        def => {},
    },
}];

$SCHEMAS{sah_array_schema} = ['array' => {
    elems => [
        'sah_type_name',
        'sah_clause_set',
        'sah_extras',
    ],
    min_len => 1,
}];

$SCHEMAS{sah_schema} = [any => {
    of => [
        'sah_str_schema',
        'sah_array_schema',
    ],
}];

1;
# ABSTRACT: Sah schemas for Sah schema

=pod

=encoding UTF-8

=head1 NAME

Sah::Schema::Sah - Sah schemas for Sah schema

=head1 VERSION

This document describes version 0.9.39 of Sah::Schema::Sah (from Perl distribution Sah), released on 2015-09-09.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Sah>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Sah>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__

# commented temporarily, unfinished refactoring
sub schemas {
    my $re_var_nameU   = '(?:[A-Za-z_][A-Za-z0-9_]*)'; # U = unanchored
    my $re_func_name   = '\A(?:'.$re_var_nameU.'::)*'.$re_var_nameU.'+\z';
    my $reu_var_name   = '(?:[A-Za-z_][A-Za-z0-9_]*)';
    my $re_clause_name = '\A(?:[a-z_][a-z0-9_]*)\z'; # no uppercase
    my $re_cattr_name  = '\A(?:'.$re_var_nameU.'\.)*'.$re_var_nameU.'+\z';
    my $re_clause_key  = ''; # XXX ':ATTR' or 'NAME' or 'NAME:ATTR'

    # R = has req=>1
    my $clause_setR = ['hash' => {
        keys_regex => $re_clause_key,
    }];

    my $str_schemaR = ['str*' => {

        # TODO: is_sah_str_shortcut
        #if => [not_match => $re_type_name, isa_sah_str_shortcut=>1],

        # for now, we don't support string shortcuts
        match => $re_type_name,
    }];

    # TODO: is_expr

    my $array_schemaR = ['array*' => {
        min_len    => 1,
        # the first clause set checks the type
        {
            elems => [$str_schemaR],
        },

        # the second clause set checks the clause set
        {
            # first we discard the type first
            prefilters => ['array_slice($_, 1)'],
            deps       => [
                # no clause sets, e.g. ['int']
                [[array => {len=>1}],
                 'any'], # do nothing, succeed

                # a single clause set, flattened in the array, but there are odd
                # number of elements, e.g. ['int', min=>1, 'max']
                [[array => {elems=>['str*'], check=>'array_len($_) % 2 != 0'}],
                 ['any', fail=>1,
                  err_msg=>'Odd number of elements in clause set']],

                # a single clause set, flattened in the array, with even number
                # of elements, e.g. ['int', min=>1, max=>10]
                [[array => {elems=>['str*']}],
                 $clause_setR],

                # otherwise, all elements must be a clause set
                 ['any',
                  [array => {of => $clause_setR}]],
            ] # END deps
        },

    }];

    # predeclare
    my $hash_schemaR = ['hash*' => undef];

    my $schema => ['any' => {
        of   => [qw/str array hash/],
        deps => [
            ['str*'   => $str_schemaR],
            ['array*' => $array_schemaR],
            ['hash*'  => $hash_schemaR],
        ],
    }];

    my $defR = ['hash*' => {
        keys_of   => ['str*' => {,
                                 # remove optional '?' suffix
                                 prefilters => [q(replace('[?]\z', '', $_))],
                                 match      => $re_type_name,
                             }],
        values_of => $schema,
    }];