Use new Tree module to print graphs (doesn't handle loops yet), switch type arguments and generalize the label setter into a label editor that takes a function

src/Graph.hs

@@ -1,35 +1,52 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DeriveFunctor #-}
 module Graph (
-    Graph(..)
+      Graph(..)
+    , editLabel
+    , open
+    , rewind
+    , singleton
+    , weave
   ) where
 
 import Data.Map (Map, (!?))
-import qualified Data.Map as Map (delete, empty, insert)
+import qualified Data.Map as Map (delete, empty, insert, toList)
+import Tree (Tree(..), Structure(..))
 
-data Vertex label edge = Vertex {
+data Vertex edge label = Vertex {
       label :: label
-    , edges :: Map edge (Vertex label edge)
-  } deriving Show
+    , edges :: Map edge (Vertex edge label)
+  } deriving (Functor, Show)
 
-singleton :: label -> Vertex label edge
+instance Show edge => Tree (Vertex edge) where
+  getStructure (Vertex {label, edges}) = Node [
+      ("(" ++ label ++ ")", Node $ recurseOnEdge <$> Map.toList edges)
+    ]
+    where
+      recurseOnEdge (edge, vertex) = (show edge, getStructure vertex)
+
+singleton :: label -> Vertex edge label
 singleton label = Vertex {label, edges = Map.empty}
 
-data Zipper label edge = Top | Zipper {
-      origin :: Zipper label edge
+data Zipper edge label = Top | Zipper {
+      origin :: Zipper edge label
     , from :: label
     , by :: edge
-    , siblingEdges :: Map edge (Vertex label edge)
-  } deriving Show
+    , siblingEdges :: Map edge (Vertex edge label)
+  } deriving (Functor, Show)
 
-data Graph label edge = Graph {
-      focus :: Vertex label edge
-    , context :: Zipper label edge
-  } deriving Show
+data Graph edge label = Graph {
+      focus :: Vertex edge label
+    , context :: Zipper edge label
+  } deriving (Functor, Show)
 
-open :: Vertex label edge -> Graph label edge
+instance (Ord edge, Show edge) => Tree (Graph edge) where
+  getStructure = getStructure . zipUp
+
+open :: Vertex edge label -> Graph edge label
 open focus = Graph {focus, context = Top}
 
-zipUp :: Ord edge => Graph label edge -> Vertex label edge
+zipUp :: Ord edge => Graph edge label -> Vertex edge label
 zipUp graph =
   case context graph of
     Top -> focus graph
@@ -41,10 +58,10 @@ zipUp graph =
           }
       }
 
-rewind :: Ord edge => Graph label edge -> Graph label edge
+rewind :: Ord edge => Graph edge label -> Graph edge label
 rewind = open . zipUp
 
-follow :: Ord edge => Graph label edge -> edge -> Maybe (Graph label edge)
+follow :: Ord edge => Graph edge label -> edge -> Maybe (Graph edge label)
 follow (Graph {focus, context}) edge =
   edges focus !? edge >>= \vertex -> Just $ Graph {
       focus = vertex
@@ -56,7 +73,7 @@ follow (Graph {focus, context}) edge =
       }
   }
 
-weave :: (Monoid label, Ord edge) => Graph label edge -> [edge] -> Graph label edge
+weave :: (Monoid label, Ord edge) => Graph edge label -> [edge] -> Graph edge label
 weave = foldl $ \graph edge ->
   case graph `follow` edge of
     Nothing -> Graph {
@@ -70,5 +87,6 @@ weave = foldl $ \graph edge ->
       }
     Just newGraph -> newGraph
 
-setLabel :: Graph label edge -> label -> Graph label edge
-setLabel graph newLabel = graph {focus = (focus graph) {label = newLabel}}
+editLabel :: Graph edge label -> (label -> label) -> Graph edge label
+editLabel graph@(Graph {focus}) labelEditor =
+  graph {focus = focus {label = labelEditor $ label focus}}