feat(matches): its kinda working...

lib/Event.rakumod

@@ -1,64 +1,84 @@
 use QueryStorage;
-unit class Event is Any;
+unit class Event is Capture is Any;
 
 my QueryStorage $storage .= new;
 
 has Event        $.parent;
 has Str          $.rule     = 'TOP';
 has              @.pos;
 has UInt         $.index    = 0;
-has              $.hash-event;
+has              $.received-event;
 has QueryStorage $.storage = $storage;
 has              $.actions;
 has              $.made;
 has Capture      $.args;
 
-sub run(\match ( :$rule, :$args, | )) {
-  match."$rule"(|$args.Capture)
+my sub to-map(\match --> Map()) {
+  to-list match
+}
+my sub to-list(\match) {
+  match.^attributes.grep(*.has_accessor).map(-> $a {
+    $a.name.substr(2) => .<> with $a.get_value(match)
+  })
+}
+
+multi method raku(::?CLASS:U:) {self.^name}
+
+multi method raku(::?CLASS:D:) {
+  "{ self.^name }.new({ to-list(self).grep(*.key ne 'storage')>>.raku.join: ', ' })"
+}
+
+sub run(\match) {
+  my Str     $rule = match.rule // "TOP";
+  my Capture $args = match.args // \();
+  do with $args {
+    match."$rule"(|.Capture)
+  } else {
+    match."$rule"()
+  }
 }
 
 method parse(Supply $supply, Str :$rule = "TOP", |args) {
-  my $match := run self.new: :$rule, :args(args);
-  say $match;
+  my $match = run self.new: :$rule, :args(args), :pos[0], :0index;
+  say $?LINE;
   supply {
     whenever $supply -> $event {
       for $storage.search: $event -> \match {
-        say match;
-        run match;
+        run match.clone: :received-event($event);
       }
     }
   }
 }
 
 method clone(*%p) {
-  my sub to-map(\match --> Map()) {
-    match.^attributes.map(-> $a {
-      $a.name.substr(2) => .<> with $a.get_value(match)
-    })
-  }
-
   $.new: |to-map(self), |%p
 }
 
 use Pattern;
-my $pattern = Pattern.bless: :name<event>;
-$pattern.add-step: my method (*%pars) {
-    say 'step: 1';
+my $pattern = Pattern.bless: :name<event>, :source("event(...)");
+$pattern.add-step: sub add-query-to-storage($match, *%pars) {
     my %query is Map = %pars.kv.map: -> $key, $value {
       do if $value !~~ Associative {
         $key => %("==" => $value)
       } else {
         $key => $value
       }
     }
-    HandledReturn::AddToStorage.new: :match(self), :$!storage, :%query
+    my $storage = $match.storage;
+    HandledReturn::AddToStorage.new: :$storage, :%query
 }
 
-$pattern.add-step: my method (*%pars) {
-    say 'step: 2';
-    note "RUNNING: {self.gist}"
+$pattern.add-step: sub query-matched ($match, *%pars) {
+    HandledReturn::Next
 }
 ::?CLASS.^add_method: 'event', $pattern;
-say $pattern;
 
+multi method gist(::?CLASS:D:) {
+    [
+        "{$!rule}: ｢" ~ (.gist with $!received-event) ~ '｣' ~ " - ({ .subst(/\n/, "␤").subst(/\t/, "␉") with $.^find_method($!rule).?source })",
+        do for |@.list.kv, |%.hash.kv -> $i, $submatch {
+             "$i => $submatch.gist()"
+        }.indent: 4
+    ].join: "\n"
+}
 

lib/Pattern.rakumod

@@ -1,55 +1,101 @@
 class HandledReturn {}
-class HandledReturn::Next is HandledReturn {}
+class HandledReturn::Next is HandledReturn {
+    has $.match is required
+}
 class HandledReturn::End is HandledReturn {}
 class HandledReturn::AddToStorage {
     has $.storage is required;
     has %.query   is required;
-    has $.match   is required;
+}
+class HandledReturn::CallRule is HandledReturn {
+    has         $.rule-to-call is required;
+    has Capture $.args;
+}
+
+sub run(\match) {
+    my $rule    = match.rule;
+    my &pattern = match.^find_method: $rule;
+
+    &pattern.steps.run: match;
 }
 
-my role Nextable {
+my role Nextable is Method {
     method elems                    {...}
     method choose-callable(UInt $i) {...}
-    method run(\match ( :@pos, UInt :$index, | )) {
-        return $.run: match.clone(:pos(|@pos, 0)) unless $index + 1 <= @pos;
+    method run(Any:D \match) {
+        my @pos   = match.pos;
+        my $index = match.index;
+        # quietly say "run: {match.rule}: @pos[]; $index => @pos[$index]";
+        return run match.clone(:pos(|@pos, 0)) unless $index + 1 <= @pos;
         my $current = @pos[$index];
-        dd @pos;
-        dd $current;
         return HandledReturn::End unless $current + 1 <= $.elems;
-        my &callable = self.choose-callable: $current;
-        self.handle-return: match, callable match, |match.args.Capture
+        my &callable = $.choose-callable: $current;
+        $.handle-return: match, callable match, |match.args.Capture;
     }
-    multi method handle-return(\match ( :@pos, UInt :$index, | ), HandledReturn::Next) {
-        my $max     = $.elems - 1;
-        my $current = @pos[$index];
-        return HandledReturn::Next unless $current <= $max;
-        self.run: match.clone: :pos(@pos.&{ |.head($current), .[$current] + 1, |.tail: * - $current - 1 })
+    proto method handle-return(\match, |) {
+        my $response = {*};
+        do if $response ~~ Positional && $response.elems > 1 && $response[1] ~~ HandledReturn {
+            $.handle-return: |$response
+        } else {
+            $response
+        }
+    }
+    multi method handle-return(\match, HandledReturn::Next:D $next ( :$match )) {
+        $match, $next.WHAT
+    }
+    multi method handle-return(\match, HandledReturn::Next:U) {
+        my @pos        = match.pos;
+        my $index      = match.index;
+        my $current    = @pos[$index];
+        my $next-match = $.next-pos-match(match);
+        do with $next-match {
+            run $_
+        } orwith match.parent -> $match is copy {
+            $match .= clone: :parent(match);
+            $match, HandledReturn::Next.new: :$match;
+        } else {
+            match, HandledReturn::End
+        }
     }
     multi method handle-return(\match, HandledReturn::End) {
-        say "END: {match.gist}";
+        emit match
+    }
+    multi method handle-return(\match, HandledReturn::AddToStorage ( :$storage! is raw, :%query!, | )) {
+        $storage.add: %query, $.next-pos-match: match;
     }
-    multi method handle-return(\match, HandledReturn::AddToStorage ( :$match ( :$index, :@pos, | ), :$storage, :%query, | )) {
-        note "\$storage.add: %query<>, {$match.gist}";
-        $storage.add: %query, $match.clone: :pos(|$.next-pos: match)
+    multi method handle-return(\match, HandledReturn::CallRule ( :rule-to-call($rule), :$args, | )) {
+        match.new(:parent(match), :$rule, :$args)."$rule"(|$args.Capture)
     }
     multi method handle-return(@returns) {
         $.handle-return: $_ for @returns
     }
     multi method handle-return(|) { }
-    method next-pos(\match ( :$index, :@pos, | )) {
+    method next-pos-match(\match) {
+        my $new-pos = $.next-pos: match;
+        return Nil unless $new-pos;
+        match.clone: :pos(|$new-pos)
+    }
+    method next-pos(\match) {
+        my @pos     = match.pos;
+        my $index   = match.index;
         my $current = @pos[$index];
         Array[UInt].new: do if $current + 1 >= $.elems {
+            return Nil if $index == 0;
             @pos.head($index - 1), @pos[$index - 1] + 1
         } else {
             |@pos.head($index), $current + 1, |@pos.tail: * - $index - 1
         }
     }
 }
 
-my class Step does Nextable is Method {
+my class Step does Nextable {
     method name {'step'}
     has Callable @.steps handles <AT-POS elems>;
 
+    method list-steps {
+        |@!steps
+    }
+
     method choose-callable(UInt $i) {
         @!steps[$i]
     }
@@ -65,56 +111,80 @@ my class Step does Nextable is Method {
         self
     }
 
-    method CALL-ME(\match ( :@pos, UInt :$index, | ), |) {
-        say 'here!!!';
-        $.run: match
+    method add-rule-call(Str $rule-to-call, Capture $args, Bool :$store-positional = False, Str :$store-key) {
+        $.add-step: sub call-rule($match) {
+            HandledReturn::CallRule.new: :$rule-to-call, :$args
+        }
+        $.add-step: sub return-from-rule ($match is copy) {
+            my $parent = $match.parent;
+            my @list = $match.list;
+            my %hash = $match.hash;
+            if $store-positional {
+                @list.push: $parent;
+            }
+            with $store-key {
+                %hash{.Str} = $parent;
+            }
+
+            $match .= clone: :parent(Nil), :@list, :%hash;
+            HandledReturn::Next.new: :$match
+        }
+    }
+
+    method CALL-ME(\match, |) {
+        my @pos   = match.pos;
+        my $index = match.index;
+        run match
     }
 }
 
-my class Repeat is Method {
+my class Repeat does Nextable {
     method name {'repeat'}
     has Numeric  $.min = 1;
     has Numeric  $.max = 1;
+    has Step     $.steps handles <add-step>.= new;
 
     method elems { $!max }
-
-    method CALL-ME(\match ( :@pos, UInt :$index, | ), |) {
-        $.run: match
-    }
-}
-
-my class Or is Method {
-    method name {'or'}
-    has Step @.options;
-
-    multi method add-option($opt) {
-        my $step = Step.bless;
-        $step.add-step: $_ for |$opt;
-        @!options.push: $step;
-        self
-    }
-
-    multi method add-option(Step $opt) {
-        @!options.push: $opt;
-        self
-    }
+    method choose-callable($) { $!steps }
 
     method CALL-ME(\match, |) {
-        # FIXME: what happens if there is no rule as first step?
-        for @!options {
-            .(match, |match.args.Capture) # last if match
-        }
+        my @pos   = match.pos;
+        my $index = match.index;
+        run match
     }
 }
 
+# my class Or does Nextable {
+#     method name {'or'}
+#     has Step @.options;
+# 
+#     multi method add-option($opt) {
+#         my $step = Step.bless;
+#         $step.add-step: $_ for |$opt;
+#         @!options.push: $step;
+#         self
+#     }
+# 
+#     multi method add-option(Step $opt) {
+#         @!options.push: $opt;
+#         self
+#     }
+# 
+#     method CALL-ME(\match, |) {
+#         # FIXME: what happens if there is no rule as first step?
+#         for @!options {
+#             .(match, |match.args.Capture) # last if match
+#         }
+#     }
+# }
+
 class Pattern is Method {
     has Str  $.name;
     has Str  $.source;
-    has Step $.steps handles <add-step> .= bless;
+    has Step $.steps handles <add-step add-rule-call list-steps> .= bless;
 
     method CALL-ME(\match, |c) {
         my $m = match.clone: :args(c), :rule($.name);
-        say $m;
         $!steps($m)
     }
 }

lib/QueryStorage.rakumod

@@ -10,7 +10,7 @@ multi method add(%tests, \value) {
     # TODO: Fix, do not override.
     for %tests.pairs.sort.kv -> UInt $i, (:$key, :value($test)) {
         $value = $i + 1 == %tests ?? value !! ::?CLASS.new;
-        note "($key).add: $test.gist(), $value";
+        note "($key).add: $test.gist(), $value.raku()";
         %branches{$key} .= add: $test<>, $value;
         %branches := $value.branches if $value ~~ ::?CLASS
     }

lib/QueryStorage/Branch.rakumod

@@ -9,9 +9,9 @@ has %!map   = |@!types.map: { .op => $_ }
 
 method map($op) { %!map{$op}.new }
 
-multi method add(::?CLASS:U: Pair $test, $value) {
+multi method add(::?CLASS:U: %test, $value) {
     my ::?CLASS $obj .= new;
-    $obj.add: $test, $value;
+    $obj.add: %test.pairs.head, $value;
     $obj
 }
 multi method add(::?CLASS:D: (:$key, :$value), $value2) {

test-rewrite.raku

@@ -7,13 +7,19 @@ start {
     $supplier.emit: %(:type<t1>)
 }
 event Bla {
-    method TOP {
-        $.event: :type("==" => "t1")
-    }
+    use Pattern;
+    my $pattern = Pattern.bless: :name<TOP>, :source('<test=.event(:type<t1>)>');
+    $pattern.add-rule-call: 'event', \(:type<t1>), :store-key<test>;
+    ::?CLASS.^add_method: 'TOP', $pattern;
+    say $pattern.list-steps;
+
+    # method TOP {
+    #     $.event: :type<t1>
+    # }
 }
 
 react {
-    whenever Bla.parse($supplier.Supply) -> $event {
-        say '-' x 30, "> $event.gist()"
+    whenever Bla.parse($supplier.Supply) {
+        .say
     }
 }