Implement outputing the matching path along with the label

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 :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream ([input], output)
-run transducer (Stream inputs) = foldl (\outputsStream (input, stream) ->
+run transducer = runWithStack initState
-    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
   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