### ----------------------------------------------------
### -- Getopt::Long
### -- Licenses: Artistic-2.0
### -- Authors: Leon Timmermans
### -- File: lib/Getopt/Long.rakumod
### ----------------------------------------------------
### -- Chunk 1 of 2
use v6;
use fatal;

unit class Getopt::Long:ver<0.4.2>;

class Exception is CORE::Exception {
	has Str:D $.message is required;
	method new(Str $message) {
		return self.bless(:$message);
	}
}

role FormattableException is Exception {
	has Str:D $.format is required;
	method new(Str $format) {
		my $message = $format.sprintf('some');
		return self.bless(:$format, :$message);
	}
	method rethrow-with(Str $name) {
		die Exception.new($!format.sprintf($name));
	}
}

class ValueInvalid does FormattableException {
}

class ConverterInvalid does FormattableException {
}

sub convert(Any:D $value, Code:D $converter) {
	return $converter($value);
	CATCH {
		when X::Str::Numeric {
			die ValueInvalid.new(qq{Cannot convert %s argument "$value" to number: $_.reason()});
		}
		when X::Numeric::CannotConvert {
			die ValueInvalid.new("Cannot convert %s argument $_.source() to {$_.target // $_.target.perl}: $_.reason()");
		}
		when X::Temporal {
			die ValueInvalid.new(.message.subst(/'string ' ( \' .* \' ) <.before ';'> /, { "$0 given as %s argument" }));
		}
		when FormattableException {
			.rethrow;
		}
		default {
			die ValueInvalid.new("Can not convert %s argument \"$value\": {.message}");
		}
	}
}

sub convert-with(Any:D $value, Code:D $converter, Str:D $name) {
	CATCH { when ValueInvalid { .rethrow-with($name) } }
	return convert($value, $converter);
}

my role Store {
	has Str:D $.key is required;
	has Code:D $.converter = *.self;
	has Junction:D $.constraints = all();
	has Hash $.values is required;
	method check-constraints(Any:D $value) {
		die ValueInvalid.new(qq{Can't accept %s argument "$value" because it fails its constraints}) unless $value ~~ $!constraints;
	}
	method store-convert(Str:D $value) {
		self.store-direct(convert($value, $!converter));
	}
	method store-direct(Any:D $value) { ... }
}

my class ScalarStore does Store {
	method store-direct(Any:D $value) {
		self.check-constraints($value);
		$!values{$!key} = $value;
	}
}

my class CountStore does Store {
	method store-direct(Int:D $value) {
		$!values{$!key} += $value;
	}
}

my class ArrayStore does Store {
	has Any:U $.type = Str;
	method store-direct(Any:D $value) {
		self.check-constraints($value);
		$!values{$!key} //= $!type === Any ?? Array !! Array[$!type].new;
		$!values{$!key}.push($value);
	}
}

my class HashStore does Store {
	has Any:U $.type = Str;
	method store-convert(Any:D $pair) {
		my ($key, $value) = $pair.split('=', 2);
		my $converted-value = convert($value, $!converter);
		self.check-constraints($converted-value);
		$!values{$!key} //= $!type === Any ?? Hash !! Hash[$!type].new;
		$!values{$!key}{$key} = $converted-value;
	}
	method store-direct(Any:D $pair) {
		!!!
	}
}

my class Receiver {
	has Range:D $.arity is required;
	has Store:D $.store is required;
	has Any $.default;
	method store(Any:D $raw) {
		$!store.store-convert($raw);
	}
	method store-default() {
		$!store.store-direct($!default);
	}
}

sub get-converter(Any:U $type) {
	state %converter-for-type{Any:U} = (
		Pair.new(Int,      *.Int),
		Pair.new(Rat,      *.Rat),
		Pair.new(Num,      *.Num),
		Pair.new(Real,     *.Real),
		Pair.new(Numeric,  *.Numeric),
		Pair.new(Complex,  *.Complex),
		Pair.new(Str,      *.Str),
		Pair.new(IO::Path, *.IO),
		Pair.new(IO,       *.IO),
		Pair.new(DateTime, *.DateTime),
		Pair.new(Date,     *.Date),
		Pair.new(Version,  *.Version),
		Pair.new(Any,      &val),
	);

	state $coercion-how = try ::("Metamodel::CoercionHOW");
	if %converter-for-type{$type} -> &converter {
		return &converter;
	} elsif $type.HOW ~~ $coercion-how {
		my &primary = get-converter($type.^constraint_type());
		return %converter-for-type{$type} = sub coercion-converter(Any $input) {
			my $primary = primary($input);
			return $primary ~~ $type.^target_type ?? $primary !! $type.^coerce($primary);
		}
	} elsif $type.HOW ~~ Metamodel::EnumHOW {
		sub valid-values() {
			my @keys = $type.WHO.keys.sort({ $type.WHO{$^value} });
			my @pairs = @keys.map: { sprintf('%s(%s)', $^key, $type.WHO{$^key}.value) };
			return @pairs.join(', ');
		}
		return %converter-for-type{$type} = sub enum-converter(Any $value) {
			return $type.WHO{$value} // $type.^enum_from_value($value) // die ValueInvalid.new(qq{Can't convert %s argument "$value" to $type.^name(), valid values are: &valid-values()});
		}
	} else {
		die ConverterInvalid.new("No argument conversion known for %s argument (type {$type.^name})");
	}
}

role Argument {
	has Junction:D $.constraints = all();
}
multi get-transformer(Argument $) {
	return Nil;
}

role Argument::Valued does Argument {
	has Any:U $.type = Str;
	has Code:D $.converter = get-converter($!type);
}

class Argument::Boolean does Argument {
	has Bool:D $.negatable = False;
}
multi make-receivers(Argument::Boolean $arg, Str:D $key, @names, %values) {
	my $store = ScalarStore.new(:$key, :constraints($arg.constraints), :%values);
	gather for @names -> $name {
		take $name => Receiver.new(:$store, :arity(0..0), :default);
		if $arg.negatable {
			take "no$name" => Receiver.new(:$store, :arity(0..0), :!default);
			take "no-$name" => Receiver.new(:$store, :arity(0..0), :!default);
		}
	}
}

class Argument::Scalar does Argument::Valued {
	has Any $.default;
}
multi make-receivers(Argument::Scalar $arg, Str:D $key, @names, %values) {
	my $store = ScalarStore.new(:$key, :converter($arg.converter), :constraints($arg.constraints), :%values);
	my $arity = $arg.default.defined ?? 0..1 !! 1..1;
	return @names.map: { $^name => Receiver.new(:$store, :$arity, :default($arg.default)) }
}

role Argument::Composite does Argument::Valued {
	has Code $.transformer;
}
multi get-transformer(Argument::Composite $arg) {
	return $arg.transformer;
}

class Argument::Array does Argument::Composite {
	has Range:D $.arity = 1..1;
}
multi make-receivers(Argument::Array $arg, Str:D $key, @names, %values) {
	my $store = ArrayStore.new(:$key, :type($arg.type), :converter($arg.converter), :constraints($arg.constraints), :%values);
	return @names.map: { $^name => Receiver.new(:$store, :arity($arg.arity)) }
}


class Argument::Hash does Argument::Composite {
}
multi make-receivers(Argument::Hash $arg, Str:D $key, @names, %values) {
	my $store = HashStore.new(:$key, :type($arg.type), :converter($arg.converter), :constraints($arg.constraints), :%values);
	return @names.map: { $^name => Receiver.new(:$store, :arity(1..1)) }
}

class Argument::Counter does Argument {
	has Any:U $.type = Int;
	has Code:D $.converter = get-converter($!type);
	has Bool:D $.argumented = False;
}
multi make-receivers(Argument::Counter $arg, Str:D $key, @names, %values) {
	my $store = CountStore.new(:$key, :converter($arg.converter), :constraints($arg.constraints), :%values);
	my $arity = $arg.argumented ?? 0..1 !! 0..0;
	return @names.map: { $^name => Receiver.new(:$store, :$arity, :1default) }
}
multi get-transformer(Argument::Counter $arg) {
	return $arg.converter;
}

my rule name { [\w+]+ % '-' | '?' }

class Option {
	has Str @.names is required;
	has Str:D $.key is required;
	has Argument $.argument;
	has Str $.why;
	submethod TWEAK(:@names) {
		die Exception.new('No name given for option') if @names < 1;
		die Exception.new("Invalid name(s): @names[]") if any(@names) !~~ &name;
	}
	multi method new(:@names!, :$argument!, Str :$key = @names[0], Str :$why) {
		return self.bless(:@names, :$key, :$argument, :$why);
	}
	multi method new(:$name!, :$argument!, Str :$why) {
		return self.bless(:names[$name], :key($name), :$argument, :$why);
	}
}

class Ordered {
	has Str:D $.name = 'some';
	has Any:U $.type = Str;
	has Code:D $.converter = get-converter($!type);
	has Str $.why;
	method type-name() {
		$!type.^name
	}
}

has Option:D @.options is required;
has Ordered:D @.positionals;
has Str $.slurpy;

method new-from-objects(Getopt::Long:U: @options, @positionals?) {
	return self.bless(:@options, :@positionals);
}

my %argument-for = (
	'%' => Argument::Hash,
	'@' => Argument::Array,
	'$' => Argument::Scalar,
	''  => Argument::Scalar,
);

my sub type-for-format(Str:D $format) {
	state %type-for-format =
		i => Int,
		o => Int, # compatability with p5
		s => Str,
		f => Num,
		r => Rat,
		c => Complex,
		p => IO::Path,
		d => DateTime,
		a => Date,
		v => Version;
	die ConverterInvalid.new("No such format $format for %s") if not %type-for-format{$format}:exists;
	return %type-for-format{$format};
};

my grammar Parser {
	token TOP {
		<names> <argument>
		{ make Option.new(:names($<names>.ast), :argument($<argument>.ast)); }
	}

	token names {
		<name>+ % '|'
		{ make @<name>».Str.list }
	}

	token argument {
		[ <boolean> | <equals-more> | <equals> | <counter> | <colon-type> | <colon-int> | <colon-count> ]
		{ make $/.values[0].made }
	}

	token boolean {
		$<negatable>=['!'?]
		{ make Argument::Boolean.new(:negatable(?$<negatable>)) }
	}

	token counter {
		'+'
		{ make Argument::Counter.new }
	}

	token type {
		<alpha>
		{ make type-for-format(~$/) }
	}

	token equals {
		'=' <type> $<repeat>=[<[%@]>?]
		{ make %argument-for{~$<repeat>}.new(:type($<type>.ast)) }
	}

	rule range {
		| $<min=>=\d* ',' $<max>=\d*  { make ( +$<min> ) .. ($<max> ?? +$<max> !! *) }
		| $<num>=\d+                  { make $/.Int..$/.Int }
	}
	token equals-more {
		'=' <type> '{' <range>'}'
		{ make Argument::Array.new(:type($<type>.ast), :arity($<range>.ast)) }
	}

	token colon-type {
		':' <type>
		{ make Argument::Scalar.new(:type($<type>.ast), :default($<type>.ast.new)) }
	}

	token colon-int {
		':' $<num>=[<[0..9]>+]
		{ make Argument::Scalar.new(:type(Int), :default($<num>.Int)) }
	}

	token colon-count {
		':+'
		{ make Argument::Counter.new(:argumented) }
	}
}

our sub parse-option(Str $pattern) {
	CATCH { when ConverterInvalid { .rethrow-with("pattern $pattern") }}
	with Parser.parse($pattern) -> $match {
		return $match.ast;
	} else {
		die Exception.new("Couldn't parse argument specification '$pattern'");
	}
}

sub make-positional(Any:U $type, Str $name, Str $why) {
	CATCH { when ConverterInvalid { .rethrow-with($name); }}
	my $converter = get-converter($type);
	return Ordered.new(:$name, :$type, :$converter, :$why);
}

my Str @ordinals = <first second third fourth fifth sixth seventh eighth nineth tenth some some> ... *;

method new-from-patterns(Getopt::Long:U: @patterns, Str:D :$positionals = "") {
	my @options = @patterns.map(&parse-option);
	my @positional-types = $positionals.comb.map(&type-for-format);
	my @positionals = @positional-types Z[&make-positional] @ordinals;
	return self.bless(:@options, :@positionals);
}

my role Formatted::Named {
	has Argument $.argument is required;
}

multi sub trait_mod:<is>(Parameter $param, Argument :option($argument)!) is export(:DEFAULT, :traits) {
	return $param does Formatted::Named(:$argument);
}

our sub parse-argument(Str $pattern, Str $name) {
	CATCH { when ConverterInvalid { .rethrow-with("parameter {$name}") }}
	with Parser.parse($pattern, :rule('argument')) -> $match {
		return $match.ast;
	} else {
		die Exception.new("Couldn't parse parameter $name\'s argument specification '$pattern'");
	}
}

multi sub trait_mod:<is>(Parameter $param where $param.named, Str:D :getopt(:$option)!) is export(:DEFAULT, :traits) {
	my $argument = parse-argument($option, $param.named_names[0]);
	return $param does Formatted::Named(:$argument);
}

multi sub trait_mod:<is>(Parameter $param where $param.named, Code:D :$option!) is export(:DEFAULT, :traits) {
	my $element-type = $param.sigil eq '@'|'%' ?? $param.type.of !! $param.type;
	my $type = $element-type ~~ Any ?? $element-type !! Any;
	my $converter = sub ($value) { $option($value) orelse die ValueInvalid("Can't convert %s argument") };
	my $argument = %argument-for{$param.sigil}.new(:$type, :$converter);
	return $param does Formatted::Named(:$argument);
}

multi sub trait_mod:<is>(Parameter $param where $param.named, :%option!) is export(:DEFAULT, :traits) {
	%option<type> //= %option<default>.WHAT with %option<default>;
	my $argument = %argument-for{$param.sigil}.new(|%option);
	return $param does Formatted::Named(:$argument);
}

multi get-reason(Pod::Block::Declarator:D $declarator) {
	return $declarator.trailing // $declarator.leading;
}
multi get-reason(Any:U $declarator) {
	return Str;
}

my role Formatted::Positional {
	has Ordered $.argument is required;
}

multi sub trait_mod:<is>(Parameter $param where $param.positional, Ordered:D :$option!) is export(:DEFAULT, :traits) {
	return $param does Formatted::Positional($option);
}
multi sub trait_mod:<is>(Parameter $param where $param.positional, Str:D :$option!) is export(:DEFAULT, :traits) {
	CATCH { when ConverterInvalid { .rethrow-with("parameter $param.name()") }}
	my $argument = Ordered.new(:name($param.usage-name), :type(type-for-format($option)), :why(get-reason($param.WHY)));
	return $param does Formatted::Positional($argument);
}
multi sub trait_mod:<is>(Parameter $param where $param.positional, Code:D :$option!) is export(:DEFAULT, :traits) {
	my $converter = sub ($value) { $option($value) orelse die ValueInvalid("Can't convert %s argument") };
	my $argument = Ordered.new(:name($param.usage-name), :type($param.type), :$converter, :why(get-reason($param.WHY)));
	return $param does Formatted::Positional($argument);
}

role Custom {
	method get-argument-for(Parameter $param) { ... }
}

multi get-argument(Parameter $param) {
	if $param.sigil eq '$' {
		my $type = $param.type;
		my $constraints = $param.constraints;
		if $type === Bool {
			return Argument::Boolean.new(:$constraints, :negatable(?$param.default));
		} elsif $type ~~ Custom {
			return $type.get-argument-for($param);
		} else {
			return Argument::Scalar.new(:$type, :$constraints);
		}
	} else {
		my $type = $param.type.of ~~ Any ?? $param.type.of !! Any;
		return %argument-for{$param.sigil}.new(:$type);
	}
	CATCH { when ConverterInvalid {
		.rethrow-with("parameter {$param.name}");
	}}
}
multi get-argument(Parameter $param where Formatted::Named) {
	return $param.argument;
}

sub make-option(Parameter $param) {
	return Option.new(:names($param.named_names), :argument(get-argument($param)), :why(get-reason($param.WHY)));
}

multi get-positional-object(Parameter $parameter) {
	return make-positional($parameter.type, $parameter.usage-name, get-reason($parameter.WHY));
}
multi get-positional-object(Parameter $param where Formatted::Positional) {
	return $param.argument;
}

my role Parsed {
	has Getopt::Long:D $.getopt is required;
}

multi get-from-sub(&candidate) {
	my @params = &candidate.signature.params;
	my @options = @params.grep(*.named).map(&make-option);
	my @positionals = @params.grep(*.positional).map(&get-positional-object);
	my ($slurpy) = @params.grep({ $^param.slurpy and not $^param.named }).map(*.usage-name)[0] // Str;
	return Getopt::Long.bless(:@options, :@positionals, :$slurpy);
}
multi get-from-sub(&candidate where Parsed) {
	return &candidate.getopt;
}

multi sub trait_mod:<is>(Sub $sub, Bool :$getopt!) is export(:DEFAULT, :traits) {
	return $sub does Parsed(get-from-sub($sub));
}
multi sub trait_mod:<is>(Sub $sub, :@getopt!) is export(:DEFAULT, :traits) {
	return $sub does Parsed(Getopt::Long.new-from-patterns(@getopt));
}
multi sub trait_mod:<is>(Sub $sub, Getopt::Long:D :$getopt!) is export(:DEFAULT, :traits) {
	return $sub does Parsed($getopt);
}

sub merge-named-objects(@options-for) {
	my %unique;
	for @options-for -> @option-set {
		for @option-set -> $option {
			for $option.names -> $name {
				die "Can't merge unequal options for --$name" if %unique{$name}:exists and %unique{$name} !eqv $option;
				%unique{$name} = $option;
			}
		}
	}
	return %unique.values;
}

sub merge-positional-object(@positionals-for, $elems) {
	my @positionals = @positionals-for.grep(* > $elems)»[$elems];
	die Exception.new("@ordinals[$elems].tc() arguments are of different types: { @positionals».type-name.join(', ') }") unless [eqv] @positionals».converter;
	return @positionals[0];
}

sub merge-positional-objects(@positionals-for) {
	my $elem-max = @positionals-for».elems.max;
	return (^$elem-max).map: { merge-positional-object(@positionals-for, $^elem) };
}

sub merge-parsers(Getopt::Long @parsers) {
	my @options = merge-named-objects(@parsers».options);
	my @positionals = merge-positional-objects(@parsers».positionals);
	return Getopt::Long.bless(:@options, :@positionals);
}

method new-from-sub(Getopt::Long:U: Sub $main) {
	my Getopt::Long @parsers = $main.candidates.map(&get-from-sub);
	return @parsers > 1 ?? merge-parsers(@parsers) !! @parsers[0];
}

method get-options(Getopt::Long:D: @args is copy, :%hash, :$auto-abbreviate = False, :$compat-builtin = False, :named-anywhere(:$permute) = !$compat-builtin, :$bundling = !$compat-builtin, :$compat-singles = $compat-builtin, :$compat-negation = $compat-builtin, :$compat-positional = $compat-builtin, :$compat-space = $compat-builtin, :$auto-help = $compat-builtin, :$write-args) {
	my @list;

	sub to-receivers(Option $option) {
		CATCH { when ConverterInvalid { .rethrow-with("--{$option.names[0]}") }}
		return make-receivers($option.argument, $option.key, $option.names, %hash);
	}
	my %receivers = @!options.flatmap(&to-receivers);

	while @args {
		my $head = @args.shift;

		my $consumed = 0;

		sub get-receiver(Str:D $key, Str:D $name) {
			with %receivers{$key} -> $option {
				return $option;
			} elsif $key eq 'help' && $auto-help {
				return Receiver.new(:store(ScalarStore.new(:key<help>, :values(%hash))), :arity(0..0), :default);
			} elsif $auto-abbreviate {
				my @names = %receivers.keys.grep(*.starts-with($key));
				if @names == 1 {
					return %receivers{ @names[0] };
				} elsif @names > 1 {
					die Exception.new("Ambiguous partial option $name, possible interpretations: @names[]");
				} else {
					die Exception.new("Unknown option $name");
				}
			} else {
				die Exception.new("Unknown option $name");
			}
		}

		sub take-value(Receiver:D $receiver, Str:D $value, Str:D $name) {
			CATCH { when ValueInvalid { .rethrow-with($name) } }
			$receiver.store($value);
			$consumed++;
		}
		sub take-args(Receiver:D $receiver, Str:D $name) {
			while @args && $consumed < $receiver.arity.min {
				take-value($receiver, @args.shift, $name);
			}

			while !$compat-space && @args && $consumed < $receiver.arity.max && !@args[0].starts-with('--') {
				take-value($receiver, @args.shift, $name);
			}

			if $consumed == 0 && $receiver.arity.min == 0 {
				$receiver.store-default();
			} elsif $consumed < $receiver.arity.min {
				die Exception.new("The option $name requires a value but none was specified");
			}
		}

		if $bundling && $head ~~ / ^ '-' $<values>=[\w .* ] $ / -> $/ {
			my @values = $<values>.Str.comb;
			for @values.keys -> $index {
				my $value = @values[$index];
				my $receiver = get-receiver($value, "-$value");
				if $receiver.arity.max > 0 && $index + 1 < @values.elems {
					my $offset = $compat-singles && @values[$index + 1] eq '=' ?? 2 !! 1;
					take-value($receiver, $<values>.substr($index + $offset), "-$value");
				}

				take-args($receiver, "-$value");
				last if $consumed;
			}
		}
		elsif $compat-singles && $head ~~ / ^ '-' <name> '=' $<value>=[.*] / -> $/ {
			my $receiver = get-receiver(~$<name>, "-$<name>");
			die Exception.new("Option -$<name> doesn't take an argument") if $receiver.arity.max != 1;
			take-value($receiver, ~$<value>, "-$<name>");
		}
		elsif $head eq '--' {
			@list.append: |@args;
			last;
		}
		elsif $head ~~ / ^ '-' ** 1..2 <name> $ / -> $/ {
			take-args(get-receiver(~$<name>, ~$/), ~$/);
		}
		elsif $head ~~ / ^ $<full-name>=[ '--' <name> ] '=' $<value>=[.*] / -> $/ {
			my $receiver = get-receiver(~$<name>, ~$<full-name>);
			die Exception.new("Option $<full-name> doesn't take arguments") if $receiver.arity.max == 0;
			take-value($receiver, ~$<value>, ~$<full-name>);
			take-args($receiver, ~$<full-name>);
		}
		elsif $compat-negation && $head ~~ / ^ $<full-name>=[ '-' ** 1..2 '/' <name> ] ['=' $<value>=[.*]]?  $ / {
			if $<value> {
				my $receiver = get-receiver(~$<name>, ~$<full-name>);
				die Exception.new("Option $<full-name> doesn't take an argument") if $receiver.arity.max != 1;
				take-value($receiver, ~$<value> but False, ~$<full-name>);
			} else {
				take-args(get-receiver('no-' ~ $<name>, ~$<full-name>), ~$<full-name>);
			}
		} else {
			if $permute {
				@list.push: $head;
			} else {
				@list.append: $head, |@args;
				last;
			}
		}
	}

	for @!options -> $option {
		with get-transformer($option.argument) -> $transformer {
			my $key = $option.key;
			%hash{$key} = convert-with(%hash{$key}, $transformer, "--$key") if %hash{$key}:exists;
		}
	}

	my &fallback-converter = $compat-positional ?? &val !! *.self;
	my @positionals = @list.kv.map: -> $index, $value {
		with @!positionals[$index] -> $positional {
			convert-with($value, $positional.converter, $positional.name);
		} else {
			convert-with($value, &fallback-converter, @ordinals[$index]);
		}
	};

	@$write-args = @list if $write-args;
	return \(|@positionals, |%hash);
}

our sub get-options-from(@args, *@elements, :$overwrite, *%config) is export(:DEFAULT, :functions) {
	my %hash := @elements && @elements[0] ~~ Hash ?? @elements.shift !! {};
	my @options;
	for @elements {
		when Str {
			@options.push: parse-option($_);
		}
		when Pair {
			my $key = .key;
			my ($name) = .key ~~ / ^ (\w+) /[0];
			%hash{$name} := .value;
			given .value {
				when Positional {
					$key ~= '@' unless $key.ends-with('@'|'}');
				}
				when Associative {
					$key ~= '%' unless $key.ends-with('%');
				}
			}
			@options.push: parse-option($key);
		}
		when Option {
			@options.push: $_;
		}
		default {
			die Exception.new("Unknown element type: " ~ .perl);
		}
	}
	my $getopt = Getopt::Long.new-from-objects(@options);
	return $getopt.get-options(@args, |%config, :%hash, :write-args($overwrite ?? @args !! Any));
}

our sub get-options(|args) is export(:DEFAULT, :functions) {
	return get-options-from(@*ARGS, :overwrite, |args);
}

our sub call-with-getopt(&func, @args, %options = %*SUB-MAIN-OPTS // {}) is export(:DEFAULT, :functions) {
	my $capture = Getopt::Long.new-from-sub(&func).get-options(@args, |%options);
	return func(|$capture);
}

our sub ARGS-TO-CAPTURE(Sub $func, @args) is export(:DEFAULT, :MAIN) {
	my %options = %*SUB-MAIN-OPTS // {};
	return Getopt::Long.new-from-sub($func).get-options(@args, |%options);
	CATCH { when Exception { note .message; &*EXIT(2) } };
}

sub usage-name(@names) {
	if @names == 1 and @names[0].chars == 1 {
		return "-@names[0]";
	} else {
		return '--' ~ @names.join('|');
	}
}

sub describe-type(Any:U $type) {
	my $result = $type.^name;
	if $type.HOW ~~ Metamodel::EnumHOW {
		my $options = $type.^enum_values.keys.sort.Str;
		$result ~= $options.chars > 50 ?? ' (' ~ substr($options,0,50) ~ '...' !! " ($options)"
	}
	return $result;
}

multi description-for-argument(Argument::Scalar $argument) {
	with $argument.default {
		return "[&describe-type($argument.type)]";
	} else {
		return describe-type($argument.type);
	}
}

multi description-for-argument(Argument::Boolean $argument) {
	return Str;
}
multi description-for-argument(Argument::Counter $argument) {
	return Str;
}

multi description-for-argument(Argument::Array $argument) {
	return describe-type($argument.type) ~ '...';
}

multi description-for-argument(Argument::Hash $argument) {
	return "<key>=" ~ describe-type($argument.type) ~ '...';
}

sub usage-for-named(Option $option) {
	my $name = usage-name($option.names.reverse);
	my $description = description-for-argument($option.argument);

	return $description.defined ?? "$name $description" !! $name;
}

multi describe-options(@options) {
	if any(@options).why {
		my @pairs = gather for @options -> $option {
			my $lead = usage-for-named($option);
			my $reason = $option.why // '';
			take ($lead, $reason);
		}
		my $width = max(@pairs.map(*.[0].chars));

		return @pairs.map: -> ($left, $right) { sprintf '%-*s %s', $width + 1, $left, $right };
	} else {
		return @options.map(&usage-for-named);
	}
}

our sub generate-usage(&main, :$program-name = $*PROGRAM.basename) is export(:usage, :functions) {
	my $getopt = Getopt::Long.new-from-sub(&main);
	my @positionals = $getopt.positionals;
	my @positional-descs = $getopt.positionals.map({ "<$^positional.name()>" });
	@positional-descs.push: "<$getopt.slurpy()>..." with $getopt.slurpy;

	my @options = $getopt.options;
	my @option-descs = describe-options($getopt.options);

	if $program-name.chars + @option-descs.join(' ').chars > 72 or any(@options).why {
		my @lines = flat "Usage:", ('', $program-name, '[options...]', |@positional-descs).join(' '), '', @option-descs.map(*.indent(4));
		return @lines.join("\n");
	} else {
		my @main = ('', $program-name, |@option-descs.map({ "[$^option]" }), |@positional-descs);
		return "Usage:\n" ~ @main.join(' ');
	}
}

our sub GENERATE-USAGE(&main, |capture) is export(:usage) {
	return generate-usage(&main);
}

=begin pod

=head1 NAME

Getopt::Long

=head1 SYNOPSIS

  use Getopt::Long;
  get-options("length=i" => my $length, # numeric
              "file=s"   => my $file,   # string
              "verbose"  => my $verbose); # flag

  use Getopt::Long;
  my $options = get-options("length=i", # numeric
                            "file=s",   # string
                            "verbose"); # flag

or

 use Getopt::Long;
 sub MAIN(Int :$length, Str :$file, Bool :$verbose) { ... }

=head1 DESCRIPTION

The Getopt::Long module implements extended getopt functions called
C<get-options()> and C<get-options-from>, as well as automatic argument
parsing for a C<MAIN> sub.

This function adheres to the POSIX syntax for command
line options, with GNU extensions. In general, this means that options
have long names instead of single letters, and are introduced with a
double dash "--". Support for bundling of command line options, as was
the case with the more traditional single-letter approach, is also
provided.

=head1 Command Line Options, an Introduction

Command line operated programs traditionally take their arguments from
the command line, for example filenames or other information that the
program needs to know. Besides arguments, these programs often take
command line I<options> as well. Options are not necessary for the
program to work, hence the name 'option', but are used to modify its
default behaviour. For example, a program could do its job quietly,
but with a suitable option it could provide verbose information about
what it did.

Command line options come in several flavours. Historically, they are
preceded by a single dash C<->, and consist of a single letter.

    -l -a -c

Usually, these single-character options can be bundled:

    -lac

Options can have values, the value is placed after the option
character. Sometimes with whitespace in between, sometimes not:

    -s 24 -s24

Due to the very cryptic nature of these options, another style was
developed that used long names. So instead of a cryptic C<-l> one
could use the more descriptive C<--long>. To distinguish between a
bundle of single-character options and a long one, two dashes are used
to precede the option name. Also, option values could be specified
either like

    --size=24

or

    --size 24

=head1 Getting Started with Getopt::Long

To use Getopt::Long from a Raku program, you must include the
following line in your program:

    use Getopt::Long;

This will load the core of the Getopt::Long module and prepare your
program for using it.

=head2 Getopt::Long as a MAIN wrapper

Getopt::Long can be used as a argument parsing MAIN wrapper, replacing
the builtin argument parsing. It will by default offer a Unix-typical
command line interface, but various options allow it to be more similar
to Raku's ideosyncratic parsing.

It supports the following types for named and positional arguments:

=item Bool
=item Any
=item Str
=item Int
=item Rat
=item Num
=item Real
=item Numeric
=item Complex
=item IO::Path
=item DateTime
=item Date
=item Version

It also supports any enum type, and any coercion type that uses any of
