package Data::Sah;
BEGIN {
  $Data::Sah::VERSION = '0.01';
}

# split because loading Regexp::Grammars, as well as compiling the grammar, is
# quite heavy.

use 5.010;

sub parse_string_shortcuts {
    my ($self, $str) = @_;

    use Regexp::Grammars;
    state $grammar = qr{
        ^<Answer>$

        <rule: Answer>
            <MATCH=Any_All> | <MATCH=Array> | <MATCH=Hash>

        # {k=>v, ...}
        <rule: Hash>
            \{ <[Operand=Pair]> ** (,) \}
                (?{
                    $MATCH = [ hash => {} ];
                    for (@{ $MATCH{Operand} }) {
                        my ($k, $v) = @$_;
                        if ($k eq '*') {
                            $MATCH->[1]{values_of} = $v;
                        } else {
                            $MATCH->[1]{keys} //= {};
                            $MATCH->[1]{keys}{$k} = $v;
                        }
                    }
                })

        <rule: Pair>
            <Literal> =\> <Answer>
                (?{
                    $MATCH = [ $MATCH{Literal}, $MATCH{Answer} ];
                })

        # [a, b, ...]
        <rule: Array>
            \[ <[Operand=Star_Sub]> ** (,) \]
                (?{
                    $MATCH = [ array => {elems => $MATCH{Operand}} ];
                })

        # a|b and a&b
        <rule: Any_All>
            <[Operand=Star_Sub]> ** <[Op=([&|])]>
                # XXX: catch mixed: a|b&c
                (?{
                    $MATCH = @{ $MATCH{Operand} } == 1 ?
                        $MATCH{Operand}[0] :
                        [ $MATCH{Op}[0] eq '&' ? 'all' : 'any', => {of => $MATCH{Operand}} ];
                })

        # a* and a[]
        <rule: Star_Sub>
            <Operand=Term> <[Op=(\[\]|\[\d+\]|\[\d+-\]|\[-\d+\]|\[\d+-\d+\]|\*?)]>+
                (?{ $MATCH = $MATCH{Operand};
                    for (@{ $MATCH{Op} }) {
                        if ($_ eq '*') {
                            $MATCH = ref($MATCH) ?
                                [$MATCH->[0], { %{ $MATCH->[1] }, req=>1 }] :
                            [$MATCH, { req=>1 }];
                        } elsif (substr($_, 0, 1) eq '[') {
                            my $l = length($_)-2;
                            $_ = substr($_, 1, $l); # strip the [ and ]
                            my $i = index($_, '-');
                            if ($_ eq '') {
                                $MATCH = [array => {of => $MATCH}];
                            } elsif ($i == -1) {
                                $MATCH = [array => {of => $MATCH, len=>$_}];
                            } elsif ($i == 0) {
                                $MATCH = [array => {of => $MATCH,
                                                    max_len=>substr($_, 1)}];
                            } elsif ($i == length($_)-1) {
                                $MATCH = [array => {of => $MATCH,
                                                    min_len=>substr($_, 0, $l-1)}];
                            } else {
                                $MATCH = [array => {of => $MATCH,
                                                    min_len=>substr($_, 0, $i),
                                                    max_len=>substr($_, $i+1),
                                                }];
                            }
                        }
                    }
                })

        # a and (a)
        <rule: Term>
               <MATCH=Typename>
          |    <MATCH=Array>
          |    <MATCH=Hash>
          | \( <MATCH=Answer> \)

        <token: Typename>
            <MATCH=( \w+ )>

        <token: Literal>
            # XXX support quotes and escape inside quotes
            #<MATCH=( \* | \w+ | "[^"]*" | '[^"]*' )>
            <MATCH=( \* | \w+ )>
    }xms;

    return unless $str =~ $grammar;
    $/{Answer};
}

1;

__END__
=pod

=head1 NAME

Data::Sah

=head1 VERSION

version 0.01

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Steven Haryanto.

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

