module Getopt::Proccesor { class Getopt::Processor { has $argument_class = ::Getopt::Argument::Style; has $normalizer_role = ::Getopt::Argument::Normalizer::Null; has $coercer_role = ::Getopt::Argument::Coercer::Null; method bind ( Code &fun, Array of Str @args ) { $fun.assuming( *self.parse_arguments( @args ) ); } method parse_arguments ( Array of Str @args ) { collect_arguments( self.create_arguments( @args ) ); } my multi sub collect_arguments ([]) {} my multi sub collect_arguments ([ $args, *@args ]) { my $normalizer = $arg but $.normalizer_role; return $normalizer but $.coercer_role, collect_arguments( grep { not try { $normalizer.subsume( $_ ) } }, @args ); } method create_arguments ( @strings ) { $.argument_class.string_to_arguments( @strings ); } } class Getopt::Argument::Style { has $value; method ^string_to_arguments ( $string ) { return $?CLASS.new( $string ); } method accept ( $arg ) { } } role Getopt::Argument::Normalizer::Null { } role Getopt::Argument::Coercer::Null { } } module Getopt::Emitter::Perl { role Getopt::Argument::Normalizer::Perl { has Str $name; has Str $string; has Int $count = 0; has Array of Str @strings; method subsume ( Getopt::Argument $arg ) { $.append( $self.accept( $arg ) ); } method append ( Getopt::Argument $arg ) { $.append_name( $arg ); $.append_value( $arg ); $.count++; } method append_name ( $arg ) { $.name ||= $arg.name; push @.names, $arg.name; } method append_value ( $arg ) { $.string = $arg.value; push @.strings, $arg.value; } } role Getopt::Argument::Coercer::Perl { multi method as (--> Num) { defined($.string) ?? Num $.string !! $.count } multi method as (--> Str) { $.string } multi method as (--> Bool) { true } multi method as (--> Array) { @.strings } multi method as (--> Named) { $.name => self } } class Getopt::Argument::Style::Clustered is Getopt::Argument::Style { method ^string_to_arguments( $string ) { given $string { when /^-(\w)+/ { map { call("-$_") }, @/ } default { next METHOD } } } } }