# ============================================================================
package MooseX::App::Meta::Role::Class::Base;
# ============================================================================

use utf8;
use 5.010;

use namespace::autoclean;
use Moose::Role;

use MooseX::App::Utils;
use Path::Class;
use Module::Pluggable::Object;

has 'app_messageclass' => (
    is          => 'rw',
    isa         => 'ClassName',
    lazy_build  => 1,
);

has 'app_namespace' => (
    is          => 'rw',
    isa         => 'Str',
    lazy_build  => 1,
);

has 'app_base' => (
    is          => 'rw',
    isa         => 'Str',
    default     => sub { Path::Class::File->new($0)->basename },
);

has 'app_fuzzy' => (
    is          => 'rw',
    isa         => 'Bool',
    default     => 1,
);

has 'app_command_name' => (
    is          => 'rw',
    isa         => 'CodeRef',
    default     => sub { \&MooseX::App::Utils::class_to_command },
);


has 'app_commands' => (
    is          => 'rw',
    isa         => 'HashRef[Str]',
    traits      => ['Hash'],
    handles     => {
        command_register    => 'set',   
    },
    lazy_build  => 1,
);

sub _build_app_messageclass {
    my ($self) = @_;
    return 'MooseX::App::Message::Block'
}

sub _build_app_namespace {
    my ($self) = @_;
    return $self->name;
}

sub _build_app_commands {
    my ($self) = @_;
    
    my $mpo = Module::Pluggable::Object->new(
        search_path => [ $self->app_namespace ],
    );
    
    my $namespace = $self->app_namespace;
    my $commandsub = $self->app_command_name;
    
    my %return;
    foreach my $command_class ($mpo->plugins) {
        my $command_class_name =  substr($command_class,length($namespace)+2);
        
        next
            if $command_class_name =~ m/::/;
        
        $command_class_name =~ s/^\Q$namespace\E:://;
        $command_class_name =~ s/^.+::([^:]+)$/$1/;
        
        my $command = $commandsub->($command_class_name);
        
        $return{$command} = $command_class;
    }
    
    return \%return;
}

sub proto_command {
    my ($self) = @_;
    
    local $Getopt::Long::Parser::autoabbrev = $self->app_fuzzy;
    my $opt_parser = Getopt::Long::Parser->new( 
        config => [
            'no_auto_help',
            'pass_through',
            ($self->app_fuzzy ? 'auto_abbrev' : 'no_auto_abbrev')
        ],
        
    );
    my $result = {};
    $opt_parser->getoptions(
        $self->proto_options($result)
    );
    return $result;
}

sub proto_options {
    my ($self,$result) = @_;
    
    $result->{help} = 0;
    return (
        "help|usage|?"      => \$result->{help},
    );
}

sub command_candidates {
    my ($self,$command) = @_;
    
    my $lc_command = lc($command);
    my $commands = $self->app_commands;
    
    my @candidates;
    my $candidate_length = length($command);
    
    # Compare all commands to find matching candidates
    foreach my $command_name (keys %$commands) {
        if ($command_name eq $lc_command) {
            return $command_name;
        } elsif ($lc_command eq substr($command_name,0,$candidate_length)) {
            push(@candidates,$command_name);
        }
    }
    
    return [ sort @candidates ];
}

sub command_get {
    my ($self,$command) = @_;
    
    my $lc_command = lc($command);
    my $commands = $self->app_commands;
    
    # Exact match
    if (defined $commands->{$lc_command}) {
        return $lc_command;
    } else {
        my $candidate =  $self->command_candidates($command);
        
        if (ref $candidate eq '') {
            return $candidate;
        } else {
            given (scalar @{$candidate}) {
                when (0) {
                    return $self->command_message(
                        header          => "Unknown command: $command",
                        type            => "error",
                    );
                }
                when (1) {
                    if ($self->app_fuzzy) {
                        return $candidate->[0];
                    } else {
                        return $self->command_message(
                            header          => "Unknown command: $command",
                            type            => "error",
                            body            => "Did you mean '".$candidate->[0]."'?",
                        );
                    }
                }
                default {
                    return $self->command_message(
                        header          => "Ambiguous command: $command",
                        type            => "error",
                        body            => "Which command did you mean?\n".MooseX::App::Utils::format_list(map { [ $_ ] } sort @{$candidate}),
                    );
                }
            }
        }
    }
}

sub command_message {
    my ($self,@args) = @_;
    my $messageclass = $self->app_messageclass;
    Class::MOP::load_class($messageclass);
    return $messageclass->new(@args);
}

sub command_usage_attributes_list {
    my ($self,$metaclass) = @_;
    
    $metaclass ||= $self;
    
    my @return;
    # TODO order by insertion order
    foreach my $attribute ($metaclass->get_all_attributes) {
        next
            unless $attribute->does('AppOption');
        push(@return,$attribute);
    }
    
    return @return;
}

sub command_usage_attributes_raw {
    my ($self,$metaclass) = @_;
    
    $metaclass ||= $self;
    
    my @attributes;
    foreach my $attribute ($self->command_usage_attributes_list($metaclass)) {
        
        my ($attribute_name,$attribute_description) = $self->command_usage_attribute_detail($attribute);
        
        push(@attributes,[$attribute_name,$attribute_description]);
    }
    
    @attributes = sort { $a->[0] cmp $b->[0] } @attributes;
    return @attributes;
}

sub command_usage_attribute_detail {
    my ($self,$attribute) = @_;
    
    my $name = $self->command_usage_attribute_name($attribute);
    my @tags = $self->command_usage_attribute_tags($attribute);
    my $description = ($attribute->has_documentation) ? $attribute->documentation : '';
    
    if (scalar @tags) {
        $description .= ' '
            if $description;
        $description .= '['.join('; ',@tags).']';
    }
    
    return ($name,$description);
}

sub command_usage_attribute_name {
    my ($self,$attribute) = @_;
    
    my @names;
    if ($attribute->can('cmd_flag')
        && $attribute->has_cmd_flag) {
        push(@names,$attribute->cmd_flag);
    } else {
        push(@names,$attribute->name);
    }
    
    if ($attribute->can('cmd_aliases')
        && $attribute->cmd_aliases) {
        push(@names, @{$attribute->cmd_aliases});
    }
    
    if ($attribute->has_type_constraint
        && $attribute->type_constraint->equals('Bool')) {
        if ($attribute->has_default 
            && ! $attribute->is_default_a_coderef
            && $attribute->default == 1) {
            @names = map { 'no'.$_ } @names;    
        } elsif (! $attribute->has_default
            && $attribute->is_required) {
            push(@names,map { 'no'.$_ } @names);        
        }
    }
    
    return join(' ', map { (length($_) == 1) ? "-$_":"--$_" } @names);
}

sub command_usage_attribute_tags {
    my ($self,$attribute) = @_;
    
    my @tags;
    
    if ($attribute->is_required
        && ! $attribute->is_lazy_build
        && ! $attribute->has_default) {
        push(@tags,'Required')
    }
    
    if ($attribute->has_default && ! $attribute->is_default_a_coderef) {
        if ($attribute->has_type_constraint
            && $attribute->type_constraint->equals('Bool')) {
#            if ($attribute->default) {
#                push(@tags,'Default:Enabled');
#            } else {
#                push(@tags,'Default:Disabled');
#            }
        } else {
            push(@tags,'Default:"'.$attribute->default.'"');
        }
    }
    
    if ($attribute->has_type_constraint) {
        my $type_constraint = $attribute->type_constraint;
        if ($type_constraint->is_subtype_of('ArrayRef')) {
            push(@tags,'Multiple');
        }
        unless ($attribute->should_coerce) {
            if ($type_constraint->equals('Int')) {
                push(@tags,'Integer');
            } elsif ($type_constraint->equals('Num')) {
                push(@tags ,'Number');
            } elsif ($type_constraint->equals('Bool')) {
                push(@tags ,'Flag');
            }
        }
    }
    
    if ($attribute->can('cmd_tags')
        && $attribute->can('cmd_tags')
        && $attribute->has_cmd_tags) {
        push(@tags,@{$attribute->cmd_tags});
    }
    
    return @tags;
}


sub command_usage_attributes {
    my ($self,$metaclass,$headline) = @_;
    
    $headline ||= 'options:';
    $metaclass ||= $self;
    
    my @attributes = $self->command_usage_attributes_raw($metaclass);
    
    return
        unless scalar @attributes > 1;
    
    return $self->command_message(
        header  => $headline,
        body    => MooseX::App::Utils::format_list(@attributes),
    );
}

sub command_usage_header {
    my ($self,$command_meta_class) = @_;
    
    my $caller = $self->app_base;
    
    my ($command_name,$usage);
    if ($command_meta_class) {
        $command_name = $self->command_class_to_command($command_meta_class->name);
        if ($command_meta_class->can('has_command_usage')
            && $command_meta_class->has_command_usage) {
            $usage = MooseX::App::Utils::format_text($command_meta_class->command_usage);
        }
    } else {
        $command_name = 'command';
    }
    
    $usage ||= MooseX::App::Utils::format_text("$caller $command_name [long options...]
$caller help
$caller $command_name --help");
    
    return $self->command_message(
        header  => 'usage:',
        body    => $usage,
    );
}

sub command_usage_description {
    my ($self,$command_meta_class) = @_;
    
    $command_meta_class ||= $self;
    
    if ($command_meta_class->can('command_long_description')
        && $command_meta_class->command_long_description_predicate) {
        return $self->command_message(
            header  => 'description:',
            body    => MooseX::App::Utils::format_text($command_meta_class->command_long_description),
        );
    } elsif ($command_meta_class->can('command_short_description')
        && $command_meta_class->command_short_description_predicate) {
        return $self->command_message(
            header  => 'short description:',
            body    => MooseX::App::Utils::format_text($command_meta_class->command_short_description),
        );
    }
    return;
}

sub command_class_to_command {
    my ($self,$command_class) = @_;
    
    my $commands = $self->app_commands;
    foreach my $element (keys %$commands) {
        if ($command_class eq $commands->{$element}) {
            return $element;
        }
    }
    
    return;
}

sub command_usage_command {
    my ($self,$command_meta_class) = @_;
    
    $command_meta_class ||= $self;
    
    my $command_class = $command_meta_class->name;
    my $command_name = $self->command_class_to_command($command_class);
    
    my @usage;
    push(@usage,$self->command_usage_header($command_meta_class));
    push(@usage,$self->command_usage_description($command_meta_class));
    push(@usage,$self->command_usage_attributes($command_meta_class));
    
    return @usage;
}

sub command_usage_global {
    my ($self) = @_;
    
    my @commands;
    push(@commands,['help','Prints this usage information']);
    
    my $commands = $self->app_commands;
    
    while (my ($command,$class) = each %$commands) {
        Class::MOP::load_class($class);
        my $description;
        $description = $class->meta->command_short_description
            if $class->meta->can('command_short_description');
        
        $description ||= '';
        push(@commands,[$command,$description]);
    }
    
    @commands = sort { $a->[0] cmp $b->[0] } @commands;
    
    my @usage;
    push (@usage,$self->command_usage_header());
    push (@usage,$self->command_usage_attributes($self,'global options:'));
    push (@usage,
        $self->command_message(
            header  => 'available commands:',
            body    => MooseX::App::Utils::format_list(@commands),
        )
    );
    
    return @usage;
}

1;

__END__

=pod

=encoding utf8

=head1 NAME

MooseX::App::Meta::Role::Class::Base - Meta class role for application base class

=head1 DESCRIPTION

This meta class role will automatically be applied to the application base
class. This documentation is only of interest if you intent to write
plugins for MooseX-App.

=head1 ACCESSORS

=head2 app_messageclass

Message class for generating error messages. Defaults to
MooseX::App::Message::Block. The default can be overwritten by altering
the C<_build_app_messageclass> method. Defaults to MooseX::App::Message::Block

=head2 app_namespace

Usually MooseX::App will take the package name of the base class as the 
namespace for commands. This namespace can be changed.

=head2 app_base

Usually MooseX::App will take the name of the calling wrapper script to 
construct the programm name in various help messages. This name can 
be changed via the app_base accessor. Defaults to the base name of $0

=head2 app_fuzzy

Boolean attribute that controlls if command names and attributes should be 
matched exactly or fuzzy. Defaults to true.

=head2 app_command_name

Coderef attribute that controlls how package names are translated to command 
names and attributes. Defaults to MooseX::App::Utils::class_to_command

=head1 METHODS

=head2 command_class_to_command

 my $command_moniker = $meta->command_class_to_command($command_class);

Returns the command moniker for the given command class name.

=head2 command_message

 my $message = $meta->command_message( header => $header, type => 'error', body => $message );

Generates a message object (based on L<app_messageclass>)

=head2 command_usage_attributes

 my $message = $meta->command_usage_attributes($metaclass,$headline);

Returns a message object containing the attribute documentation for a given
meta class.

=head2 command_usage_attributes_list

 my @attributes = $meta->command_usage_attributes($metaclass);

Returns a list of attributes/command options.

=head2 command_usage_attributes_raw

 my @attributes = $meta->command_usage_attributes_raw($metaclass);

Returns a list of attribute documentations for a given meta class.

=head2 command_usage_attribute_detail

 my ($name,$description) = $meta->command_usage_attribute_detail($metaattribute);

Returns a name and description for a given meta attribute class.

=head2 command_usage_attribute_tags

 my (@tags) = $meta->command_usage_attribute_tags($metaattribute);

Returns a list of tags for the given attribute.

=head2 command_usage_attribute_name

 my ($name,$description) = $meta->command_usage_attribute_name($metaattribute);

Returns a name for a given meta attribute class.

=head2 command_usage_attribute_tag

 my @tags = $meta->command_usage_attribute_name($metaattribute);

Returns a list of tags for a given meta attribute class.

=head2 command_usage_command

 my @messages = $meta->command_usage_command($command_metaclass);

Returns a list of messages containing the documentation for a given
command meta class.

=head2 command_usage_description

 my $message = $meta->command_usage_description($command_metaclass);

Returns a messages with the basic command description.

=head2 command_usage_global

 my @messages = $meta->command_usage_global();

Returns a list of messages containing the documentation for the application.

=head2 command_usage_header

 my $message = $meta->command_usage_header();
 my $message = $meta->command_usage_header($command_meta_class);

Returns a message containing the basic usage documentation

=head2 app_commands

 my $commands = $meta->app_commands;

Returns a hashref of command name and command class.

=head2 command_get

 my @commands = $meta->command_get($user_command_input);

Returns a list of command names matching the user input

=head2 command_candidates

 my $commands = $meta->command_candidates($user_command_input);

Returns either a single command or an arrayref of possibly matching commands.

=head2 proto_command

 my $result = $meta->proto_command();

Returns the proto command command-line options.

=head2 proto_options

 my @getopt_options = $meta->proto_command($result_hashref);

Sets the GetOpt::Long options for the proto command

=cut