57 / 57 lines covered (100.0%)
1unit module BDD::Behave::Matcher::Custom;23use BDD::Behave::Matcher;45class DefinedMatcher does Matcher is export {6 has Str $.name;7 has List $.args = ();8 has Map $.kwargs = Map.new;9 has &.match-block is required;10 has &.failure-message-block;11 has &.failure-message-negated-block;12 has &.description-block;13 has &.expected-value-block;1415 method !invoke(&block, *@extra) {16 if $!kwargs.elems {17 block(|@extra, |$!args, |$!kwargs);18 } else {19 block(|@extra, |$!args);20 }21 }2223 method matches($actual --> Bool) {24 ?self!invoke(&!match-block, $actual);25 }2627 method failure-message($actual --> Str) {28 return Str unless &!failure-message-block.defined;29 self!invoke(&!failure-message-block, $actual).Str;30 }3132 method failure-message-negated($actual --> Str) {33 return Str unless &!failure-message-negated-block.defined;34 self!invoke(&!failure-message-negated-block, $actual).Str;35 }3637 method expected-value(--> Mu) {38 if &!expected-value-block.defined {39 return self!invoke(&!expected-value-block);40 }41 return $!args[0] if $!args.elems == 1 && !$!kwargs.elems;42 return $!kwargs if !$!args.elems && $!kwargs.elems;43 $!args;44 }4546 method description(--> Str) {47 if &!description-block.defined {48 return self!invoke(&!description-block).Str;49 }50 $!name;51 }52}5354class CustomMatcherRegistry {55 has %.matchers;5657 method register(Str:D $name, %config --> Nil) {58 %config<match>:exists59 or die "define-matcher '$name': match block is required";60 %!matchers{$name} = %config;61 }6263 method exists(Str:D $name --> Bool) {64 %!matchers{$name}:exists;65 }6667 method lookup(Str:D $name) {68 %!matchers{$name}:exists69 or die "Unknown custom matcher: '$name'";70 %!matchers{$name};71 }7273 method names() {74 %!matchers.keys.sort.List;75 }7677 method clear() {78 %!matchers = ();79 }8081 method build(Str:D $name, |c) {82 my %config = self.lookup($name);83 my $args = c.list.List;84 my $kwargs = c.hash.Map;85 my %builder;86 %builder<name> = $name;87 %builder<args> = $args;88 %builder<kwargs> = $kwargs;89 %builder<match-block> = %config<match>;90 %builder<failure-message-block> = %config<failure-message> if %config<failure-message>:exists;91 %builder<failure-message-negated-block> = %config<failure-message-negated> if %config<failure-message-negated>:exists;92 %builder<description-block> = %config<description> if %config<description>:exists;93 %builder<expected-value-block> = %config<expected-value> if %config<expected-value>:exists;94 DefinedMatcher.new(|%builder);95 }96}9798my CustomMatcherRegistry $REGISTRY .= new;99100our sub registry() {101 $REGISTRY;102}103104our sub define-matcher(Str:D $name, *%blocks) {105 %blocks<match>:exists106 or die "define-matcher '$name': match block is required";107108 for %blocks.keys -> $key {109 next if $key (elem) set <match failure-message failure-message-negated description expected-value>;110 die "define-matcher '$name': unknown option ':$key' (allowed: match, failure-message, failure-message-negated, description, expected-value)";111 }112113 for %blocks.kv -> $key, $value {114 unless $value ~~ Callable {115 die "define-matcher '$name': ':$key' must be a Callable";116 }117 }118119 $REGISTRY.register($name, %blocks);120121 sub (|c) {122 $REGISTRY.build($name, |c);123 };124}125126our sub matcher(Str:D $name, |c) {127 $REGISTRY.build($name, |c);128}