verify graph paths incl laws graph

Logic/Graph.hs

@@ -38,6 +38,8 @@ Just ["add","double","add","double","double","add"]
 
 data VerifyPathError vertex edge
   = NoSuchEdge vertex edge
+  | GoalNotReached [vertex]
+  deriving Show
 
 verifyPath
   :: (Eq vertex, Ord vertex, Eq edge)
@@ -45,11 +47,22 @@ verifyPath
   -> vertex
   -> vertex
   -> [edge]
-  -> Either (VerifyPathError vertex edge) Bool
+  -> Either (VerifyPathError vertex edge) [vertex]
 verifyPath getEdges goal start path =
-  case path of
-    [] -> Right $ start == goal
-    (thisEdge:nextEdges) ->
-      case map fst $ filter (\(next, realEdge) -> realEdge == thisEdge) $ getEdges start of
-        [] -> Left $ NoSuchEdge start thisEdge
-        (next:_) -> verifyPath getEdges goal next nextEdges
+  case aux start path of
+    Right (vertices, True) -> Right vertices
+    Right (vertices, False) -> Left $ GoalNotReached vertices
+    Left x -> Left x
+  where
+    aux vertex path' = cons vertex <$>
+      case path' of
+        [] -> Right $
+          if vertex == goal
+          then ([], True)
+          else ([], False)
+        (thisEdge:nextEdges) ->
+          case map fst $ filter (\(next, realEdge) -> realEdge == thisEdge) $ getEdges vertex of
+            [] -> Left $ NoSuchEdge vertex thisEdge
+            (next:_) -> aux next nextEdges
+
+    cons vertex (vertices, bool) = (vertex:vertices, bool)