From f66d22af08a1b73f5ddafa695051963f517209c6 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Thu, 9 May 2019 18:27:23 +0200
Subject: [PATCH] Implement outputing the matching path along with the label

---
 src/Transducer.hs | 29 ++++++++++++++++++++---------
 1 file changed, 20 insertions(+), 9 deletions(-)

diff --git a/src/Transducer.hs b/src/Transducer.hs
index 1d00a51..8645944 100644
--- a/src/Transducer.hs
+++ b/src/Transducer.hs
@@ -11,6 +11,13 @@ import Stream (Stream(..), merge)
 import qualified Stream (empty)
 
 type Transducer input output = Graph input [output]
+newtype Stack a = Stack [a]
+
+push :: a -> Stack a -> Stack a
+push a (Stack s) = Stack (a:s)
+
+content :: Stack a -> [a]
+content (Stack s) = reverse s
 
 empty :: Transducer input output
 empty = singleton []
@@ -40,13 +47,17 @@ fromList = foldl add empty
     add transducer (path, Left loopPath) = loop transducer (path, loopPath)
     add transducer (path, Right output) = entry transducer (path, output)
 
-run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream output
-run transducer (Stream inputs) = foldl (\outputsStream (input, stream) ->
-    case follow transducer input of
-      Nothing -> Stream.empty
-      Just newState@(Graph {vertices, focus}) ->
-        let emitted = Stream $ emit stream <$> label (vertices ! focus) in
-        emitted `merge` outputsStream `merge` run newState stream
-  ) Stream.empty inputs
+run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream ([input], output)
+run transducer = runWithStack initState
   where
-    emit stream output = (output, run (rewind transducer) stream)
+    initState = (transducer, Stack [])
+    emit stack stream output = ((content stack, output), runWithStack initState stream)
+    runWithStack (state, stack) (Stream inputs) = foldl (\outputsStream (input, stream) ->
+        case follow state input of
+          Nothing -> Stream.empty
+          Just newState@(Graph {vertices, focus}) ->
+            let newStack = push input stack in
+            let emitted = Stream $ emit newStack stream <$> label (vertices ! focus) in
+            let continue = runWithStack (newState, newStack) stream in
+            emitted `merge` continue `merge` outputsStream
+      ) Stream.empty inputs