package Getopt::Dakkar::Role::Command;
use Getopt::Dakkar::Style qw(role);
with 'Getopt::Dakkar::Role::Piece';
# VERSION
# ABSTRACT: a command

has options => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
has parameters => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
has subcommands => ( is => 'ro', isa => ArrayRef, default => sub { [] } );

sub parse($self,$args,$stash) {
    my $stash = $self->_parse($args,$stash);
    if (my $op = $self->op) {
        return $stash->$op();
    }
    return $stash;
}

sub _parse($self,$args,$stash) {
    my $argpack = Getopt::Dakkar::ArgPack->new({getopt=>$self});
    while ($args->@*) {
        my $this = $args->[0];

        if ($self->_looks_like_option($this)
                and not $self->_is_terminator($this)) {
            if (my $match = $self->_match_option($this)) {
                # ->parse will remove $this (or parts of
                # it, if it's a bundle) and shift its own arguments
                # out of $args
                my $option = $match->parse($args,$stash);
                $argpack->options->{$match->name} = $option;
            }
            else {
                Getopt::Dakkar::X::BadOption->throw({
                    input => $this,
                });
            }
        }
        elsif (my $match = $self->_match_subcommand($this)) {
            shift $args->@*;
            $stash //= $self->_make_stash($argpack);
            my $op = $self->op;
            $stash->$op($argpack);
            $match->parse($args,$stash);
        }
        else {
            shift $args->@* if $self->_is_terminator($this);
            for my $parameter ($self->parameters->@*) {
                # ->parse will remove the argument(s) from $args
                my $argument = $parameter->parse($args,$stash);
                $argpack->arguments->{$argument->name} = $argument;
            }

            # if we've parsed all arguments, and there's still stuff
            # in the input, something is wrong: complain
            if ($args->@*) {
                Getopt::Dakkar::X::ExtraArgs->throw({
                    args => $args,
                });
            }
            # hmmm. what about 'ls foo -l' ?
        }
    }
    return $stash;
}

sub _is_terminator($self,$arg) { return $arg eq q{--} }
sub _looks_like_option($self,$arg) { return $arg =~ /^-/ }
sub _match_option($self,$arg) {
    for my $option ($self->options->@*) {
        return $option if $option->match($arg);
    }
    return undef;
}
sub _match_subcommand($self,$arg) {
    for my $subcommand ($self->subcommands->@*) {
        return $subcommand if $subcommand->match($arg);
    }
    return undef;
}

sub match($self,$arg) {
    return !! grep { $_ eq $arg } $self->matching_strings->@*;
}