use v6;
unit class Getopt::Tiny;

use Pod::To::Text;

has $.pass-through;

my class X::Usage is Exception {
    has $.message;
    method new(Str $message) {
        self.bless(message => $message)
    }
}

my class IntOption {
    has $.short;
    has $.long;
    has $.callback;

    method usage() {
        if $.short.defined {
            return "-{$.short}


    method match($a) {
        if $.short.defined {
            return True if self!match-short($a);
        }
        if $.long.defined {
            return True if self!match-long($a);
        }
        return False;
    }

    method !match-long($a) {
        my $opt = $.long;

        my $val = do {
            if $a[0] eq "--$opt" {
                $a.shift;
                if $a.elems == 0 {
                    X::Usage.new("--$opt requires integer parameter").throw;
                }
                $a.shift;
            } elsif $a[0] ~~ /^\-\-$opt\=(.*)$/ { # -h=3
                my $val = $/[0].Str;
                $a.shift;
                $val;
            } else {
                return False;
            }
        };

        unless $val ~~ /^<[0..9]>+$/ {
            X::Usage.new("-$opt requires int parameter, but got $val").throw;
        }
        $.callback()($val.Int);
        True
    }

    method !match-short($a) {
        my $opt = $.short;

        my $val = do {
            if $a[0] eq "-$opt" {
                $a.shift;
                if $a.elems == 0 {
                    X::Usage.new("-$opt requires int parameter").throw;
                }
                $a.shift;
            } elsif $a[0] ~~ /^\-$opt(.*)$/ { # -h=3
                my $val = $/[0].Str;
                $a.shift;
                $val;
            } else {
                return False;
            }
        };

        unless $val ~~ /^<[0..9]>+$/ {
            X::Usage.new("-$opt requires int parameter, but got $val").throw;
        }
        $.callback()($val.Int);
        True
    }
}

my class StrOption {
    has $.short;
    has $.long;
    has $.callback;

    method usage() {
        if $.short.defined {
            return "-{$.short}


    method match($a) {
        if $.short.defined {
            return True if self!match-short($a);
        }
        if $.long.defined {
            return True if self!match-long($a);
        }
        return False;
    }

    method !match-long($a) {
        my $opt = $.long;

        my $val = do {
            if $a[0] eq "--$opt" {
                $a.shift;
                if $a.elems == 0 {
                    X::Usage.new("--$opt requires string parameter").throw;
                }
                $a.shift;
            } elsif $a[0] ~~ /^\-\-$opt\=(.*)$/ { # -h=3
                my $val = $/[0].Str;
                $a.shift;
                $val;
            } else {
                return False;
            }
        };

        $.callback()($val);
        True
    }

    method !match-short($a) {
        my $opt = $.short;

        my $val = do {
            if $a[0] eq "-$opt" {
                $a.shift;
                if $a.elems == 0 {
                    X::Usage.new("-$opt requires string parameter").throw;
                }
                $a.shift;
            } elsif $a[0] ~~ /^\-$opt(.*)$/ { # -h=3
                my $val = $/[0].Str;
                $a.shift;
                $val;
            } else {
                return False;
            }
        };

        $.callback()($val);
        True
    }
}

my class BoolOption {
    has $.short;
    has $.long;
    has $.callback;

    method usage() {
        if $.short.defined {
            return "-{$.short}"
        }
        if $.long.defined {
            return "--{$.long}"
        }
        return '';
    }

    method match($a) {
        if $.short.defined {
            return True if self!match-short($a);
        }
        if $.long.defined {
            return True if self!match-long($a);
        }
        return False;
    }

    method !match-long($a) {
        my $opt = $.long;

        if $a[0] eq "--$opt" {
            $a.shift;
            $.callback()(True);
            True;
        } elsif $a[0] eq "--no-$opt" {
            $a.shift;
            $.callback()(False);
            True;
        } else {
            return False;
        }
    }

    method !match-short($a) {
        my $opt = $.short;

        if $a[0] eq "-$opt" {
            $a.shift;
            $.callback()(True);
            True
        } else {
            return False;
        }
    }
}

has $!options = [];

multi method str(Str $opt, $callback) {
    my $type = $opt.chars == 1 ?? 'short' !! 'long';
    $!options.append: StrOption.new(
        |($type    => $opt),
        callback => $callback,
    );
    self;
}

multi method str($short, $long, $callback) {
    $!options.append: StrOption.new(
        short    => $short,
        long     => $long,
        callback => $callback,
    );
    self;
}

multi method bool(Str $opt, $callback) {
    my $type = $opt.chars == 1 ?? 'short' !! 'long';
    $!options.append: BoolOption.new(
        |($type    => $opt),
        callback => $callback,
    );
    self;
}

multi method bool($short, $long, $callback) {
    $!options.append: BoolOption.new(
        short    => $short,
        long     => $long,
        callback => $callback,
    );
    self;
}

multi method int(Str $opt, $callback) {
    my $type = $opt.chars == 1 ?? 'short' !! 'long';
    $!options.append: IntOption.new(
        |($type    => $opt),
        callback => $callback,
    );
    self;
}

multi method int($short, $long, $callback) {
    if $short.defined {
        $!options.append: IntOption.new(
            short    => $short,
            callback => $callback,
        );
    }
    if $long.defined {
        $!options.append: IntOption.new(
            long     => $long,
            callback => $callback,
        );
    }
    self;
}

my sub pod2usage($pod) {
    given $pod {
        when Pod::Block::Named {
            for 0..^$pod.contents.elems-1 -> $i {
                if $pod.contents[$i] ~~ Pod::Heading && pod2text($pod.contents[$i].contents) eq 'SYNOPSIS' {
                    return pod2text($pod.contents[$i+1]);
                }
            }
        }
        when Array {
            for @$_ {
                my $got = pod2usage($_);
                return $got if $got;
            }
        }
    }
}

method !print-usage(Str $msg='') {
    say "$msg\n" if $msg;

    my $pod = callframe(callframe().level).my<$

>;
    my $usage = pod2usage($pod);
    if $usage {
        say "\nUsage:\n$usage\n";
        exit 1;
    }



    my $prog-name = $*PROGRAM-NAME eq '-e'
        ?? '-e "..."'
        !! $*PROGRAM-NAME;

    # I want to show more verbose usage message. patches welcome.
    say("Usage: $prog-name " ~ @$!options.map({ .usage }).join(" "));

    exit 1
}

method parse($args is copy) {
    my @positional;

    LOOP: while +@$args {
        if $args[0] eq '--' {
            $args.shift;
            @positional.append: @$args;
            last;
        }

        for @$!options -> $opt {
            if $opt.match($args) {
                next LOOP
            }
        }
        CATCH {
            when X::Usage {
                self!print-usage($_.message);
            }
        }

        if $args[0] eq '-h' || $args[0] eq '--help' {
            self!print-usage();
        }

        if $args[0] ~~ /^\-/ && !$.pass-through {
            self!print-usage("Unknown option '$args[0]'");
        }

        @positional.push: $args.shift;
    }

    return @positional;
}


my grammar GetoptionsGrammar {
    token TOP { <key> '=' <type> }
    token key { <short> [ '|' <long> ]?  | <long> }

    token short { <[a..z A..Z]> }
    token long { <[a..z A..Z]> <[a..z A..Z 0..9]>+ }

    token type {
        's'  | # str
        's@' | # array of string
        '!'  | # bool
        'i'    # int
    }
};

my class GetoptionsAction {
    method type($/)  { $/.make: ~$/ }
    method short($/) { $/.make: ~$/ }
    method long($/)  { $/.make: ~$/ }
    method key($/)   { $/.make: ($<short>.made, $<long>.made) }
    method TOP($/)   { $/.make: (|$<key>.made, $<type>.made) }
}

sub get-options($opts is rw, $defs, $args=[@*ARGS], Bool :$pass-through

False


    @*ARGS = $getopt.parse($args);
    $PROCESS::ARGFILES = IO::ArgFiles.new(:args(@*ARGS));

    Nil;
}



head

Getopt::Tiny - Tiny option parser for Perl6


my $opts = { host => '127.0.0.1', port => 5000 };


get-options($opts, <
    e=s
    I=s@
    p=i
    h|host=s
>);


Getopt::Tiny is tiny command line option parser library for Perl6.


item

Perl6 has a great built-in command line option parser. But it's not flexible.
It's not perfect for all cases.


C<get-options(Hash $opts, Array[Str] $definitions, Bool :$pass-through=False)>


get-options($args, <
    e=s
    I=s@
    p=i
    h|host=s
>);


token TOP { <key> '=' <type> }
token key { <short> [ '|' <long> ]?  | <long> }


token short { <[a..z A..Z]> }
token long { <[a..z A..Z]> <[a..z A..Z 0..9]>+ }


token type {
    's'  | # str
    's@' | # array of string
    '!'  | # bool
    'i'    # int
}


C<$opts> should be Hash. This function writes result to C<$opts>.


C<$definitions> should be one of following style.


If you want to pass-through unknown option, you can pass C<:pass-through> as a named argument like following:


This function modifies C<@*ARGS> and C<$PROCESS::ARGFILES>.


If C<$opt> has 1 char, it's equivalent to C<$opt.str($opt, Nil, $callback)>,
C<$opt.str(Nil, $opt, $callback)> otherwise.


C<$short> accepts C<-Ilib> or C<-I lib> form.
C<$long> accepts C<--host=lib> or C<--host lib> form.


If C<$opt> has 1 char, it's equivalent to C<$opt.int($opt, Nil, $callback)>,
C<$opt.int(Nil, $opt, $callback)> otherwise.


C<$short> accepts C<-I3> or C<-I 3> form.
C<$long> accepts C<--port=5963> or C<--port 5963> form.


If C<$opt> has 1 char, it's equivalent to C<$opt.bool($opt, Nil, $callback)>,
C<$opt.bool(Nil, $opt, $callback)> otherwise.


C<$short> accepts C<-x> form.
C<$long> accepts C<--man-pages> or C<--no-man-pages> form.


root

README

synopsis

React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


Tiny

NAME

SYNOPSIS

DESCRIPTION

FEATURES

MOTIVATION

Function interface

`get-options(Hash $opts, Array[Str] $definitions, Bool :$pass-through=False)`

OO Interface

METHODS

`my $opt = Getopt::Tiny.new()`

`$opt.str($opt, $callback)`

`$opt.str($short, $long, $callback)`

`$opt.int($opt, $callback)`

`$opt.int($short, $long, $callback)`

`$opt.bool($opt, $callback)`

`$opt.bool($short, $long, $callback)`

`$opt.parse(@args)`

pod2usage

COPYRIGHT AND LICENSE