Fix Show instances to insert parens (snowleopard#140)

pyrtsa · Nov 19, 2018 · d22c662 · d22c662
1 parent ba51378
commit d22c662
Show file tree

Hide file tree

Showing 8 changed files with 85 additions and 46 deletions.
diff --git a/src/Algebra/Graph/AdjacencyIntMap/Internal.hs b/src/Algebra/Graph/AdjacencyIntMap/Internal.hs
@@ -136,18 +136,21 @@ newtype AdjacencyIntMap = AM {
     adjacencyIntMap :: IntMap IntSet } deriving Eq
 
 instance Show AdjacencyIntMap where
-    show (AM m)
-        | null vs    = "empty"
-        | null es    = vshow vs
-        | vs == used = eshow es
-        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"
+    showsPrec p (AM m)
+        | null vs    = showString "empty"
+        | null es    = showParen (p > 10) $ vshow vs
+        | vs == used = showParen (p > 10) $ eshow es
+        | otherwise  = showParen (p > 10) $
+                           showString "overlay (" . vshow (vs \\ used) .
+                           showString ") (" . eshow es . showString ")"
       where
         vs             = IntSet.toAscList (keysSet m)
         es             = internalEdgeList m
-        vshow [x]      = "vertex "   ++ show x
-        vshow xs       = "vertices " ++ show xs
-        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y
-        eshow xs       = "edges "    ++ show xs
+        vshow [x]      = showString "vertex "   . showsPrec 11 x
+        vshow xs       = showString "vertices " . showsPrec 11 xs
+        eshow [(x, y)] = showString "edge "     . showsPrec 11 x .
+                         showString " "         . showsPrec 11 y
+        eshow xs       = showString "edges "    . showsPrec 11 xs
         used           = IntSet.toAscList (referredToVertexSet m)
 
 instance Ord AdjacencyIntMap where

diff --git a/src/Algebra/Graph/AdjacencyMap/Internal.hs b/src/Algebra/Graph/AdjacencyMap/Internal.hs
@@ -146,18 +146,21 @@ instance Ord a => Ord (AdjacencyMap a) where
         eNum = getSum . foldMap (Sum . Set.size)
 
 instance (Ord a, Show a) => Show (AdjacencyMap a) where
-    show (AM m)
-        | null vs    = "empty"
-        | null es    = vshow vs
-        | vs == used = eshow es
-        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"
+    showsPrec p (AM m)
+        | null vs    = showString "empty"
+        | null es    = showParen (p > 10) $ vshow vs
+        | vs == used = showParen (p > 10) $ eshow es
+        | otherwise  = showParen (p > 10) $
+                           showString "overlay (" . vshow (vs \\ used) .
+                           showString ") (" . eshow es . showString ")"
       where
         vs             = Set.toAscList (keysSet m)
         es             = internalEdgeList m
-        vshow [x]      = "vertex "   ++ show x
-        vshow xs       = "vertices " ++ show xs
-        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y
-        eshow xs       = "edges "    ++ show xs
+        vshow [x]      = showString "vertex "   . showsPrec 11 x
+        vshow xs       = showString "vertices " . showsPrec 11 xs
+        eshow [(x, y)] = showString "edge "     . showsPrec 11 x .
+                         showString " "         . showsPrec 11 y
+        eshow xs       = showString "edges "    . showsPrec 11 xs
         used           = Set.toAscList (referredToVertexSet m)
 
 -- | __Note:__ this does not satisfy the usual ring laws; see 'AdjacencyMap'

diff --git a/src/Algebra/Graph/Fold.hs b/src/Algebra/Graph/Fold.hs
@@ -174,7 +174,7 @@ x + y <= x * y@
 newtype Fold a = Fold { runFold :: forall b. b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> b }
 
 instance (Ord a, Show a) => Show (Fold a) where
-    show = show . foldg AM.empty AM.vertex AM.overlay AM.connect
+    showsPrec p = showsPrec p . foldg AM.empty AM.vertex AM.overlay AM.connect
 
 instance Ord a => Eq (Fold a) where
     x == y = T.toAdjacencyMap x == T.toAdjacencyMap y

diff --git a/src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs b/src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
@@ -37,21 +37,25 @@ newtype AdjacencyMap e a = AM {
     adjacencyMap :: Map a (Map a e) } deriving (Eq, NFData)
 
 instance (Ord a, Show a, Ord e, Show e) => Show (AdjacencyMap e a) where
-    show (AM m)
-        | Set.null vs = "empty"
-        | null es     = vshow vs
-        | vs == used  = eshow es
-        | otherwise   = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"
+    showsPrec p (AM m)
+        | Set.null vs = showString "empty"
+        | null es     = showParen (p > 10) $ vshow vs
+        | vs == used  = showParen (p > 10) $ eshow es
+        | otherwise   = showParen (p > 10) $
+                            showString "overlay (" . vshow (vs \\ used) .
+                            showString ") ("       . eshow es . showString ")"
       where
         vs   = Map.keysSet m
         es   = internalEdgeList m
         used = referredToVertexSet m
         vshow vs = case Set.toAscList vs of
-            [x] -> "vertex "   ++ show x
-            xs  -> "vertices " ++ show xs
+            [x] -> showString "vertex "   . showsPrec 11 x
+            xs  -> showString "vertices " . showsPrec 11 xs
         eshow es = case es of
-            [(e, x, y)] -> "edge "  ++ show e ++ " " ++ show x ++ " " ++ show y
-            xs          -> "edges " ++ show xs
+            [(e, x, y)] -> showString "edge "  . showsPrec 11 e .
+                           showString " "      . showsPrec 11 x .
+                           showString " "      . showsPrec 11 y
+            xs          -> showString "edges " . showsPrec 11 xs
 
 instance (Ord e, Monoid e, Ord a) => Ord (AdjacencyMap e a) where
     compare (AM x) (AM y) = mconcat

diff --git a/src/Algebra/Graph/NonEmpty/AdjacencyMap/Internal.hs b/src/Algebra/Graph/NonEmpty/AdjacencyMap/Internal.hs
@@ -128,18 +128,21 @@ instance (Ord a, Num a) => Num (AdjacencyMap a) where
     negate        = id
 
 instance (Ord a, Show a) => Show (AdjacencyMap a) where
-    show (NAM (AM.AM m))
+    showsPrec p (NAM (AM.AM m))
         | null vs    = error "NonEmpty.AdjacencyMap.Show: Graph is empty"
-        | null es    = vshow vs
-        | vs == used = eshow es
-        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"
+        | null es    = showParen (p > 10) $ vshow vs
+        | vs == used = showParen (p > 10) $ eshow es
+        | otherwise  = showParen (p > 10) $
+                           showString "overlay (" . vshow (vs \\ used) .
+                           showString ") (" . eshow es . showString ")"
       where
         vs             = Set.toAscList (Map.keysSet m)
         es             = AM.internalEdgeList m
-        vshow [x]      = "vertex "   ++ show x
-        vshow xs       = "vertices1 " ++ show xs
-        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y
-        eshow xs       = "edges1 "    ++ show xs
+        vshow [x]      = showString "vertex "    . showsPrec 11 x
+        vshow xs       = showString "vertices1 " . showsPrec 11 xs
+        eshow [(x, y)] = showString "edge "      . showsPrec 11 x .
+                         showString " "          . showsPrec 11 y
+        eshow xs       = showString "edges1 "    . showsPrec 11 xs
         used           = Set.toAscList (AM.referredToVertexSet m)
 
 -- | Check if the internal graph representation is consistent, i.e. that all

diff --git a/src/Algebra/Graph/Relation/Internal.hs b/src/Algebra/Graph/Relation/Internal.hs
@@ -126,17 +126,21 @@ data Relation a = Relation {
   } deriving Eq
 
 instance (Ord a, Show a) => Show (Relation a) where
-    show (Relation d r)
-        | Set.null d = "empty"
-        | Set.null r = vshow (Set.toAscList d)
-        | d == used  = eshow (Set.toAscList r)
-        | otherwise  = "overlay (" ++ vshow (Set.toAscList $ Set.difference d used)
-                    ++ ") (" ++ eshow (Set.toAscList r) ++ ")"
+    showsPrec p (Relation d r)
+        | Set.null d = showString "empty"
+        | Set.null r = showParen (p > 10) $ vshow (Set.toAscList d)
+        | d == used  = showParen (p > 10) $ eshow (Set.toAscList r)
+        | otherwise  = showParen (p > 10) $
+                           showString "overlay (" .
+                           vshow (Set.toAscList $ Set.difference d used) .
+                           showString ") (" . eshow (Set.toAscList r) .
+                           showString ")"
       where
-        vshow [x]      = "vertex "   ++ show x
-        vshow xs       = "vertices " ++ show xs
-        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y
-        eshow xs       = "edges "    ++ show xs
+        vshow [x]      = showString "vertex "   . showsPrec p x
+        vshow xs       = showString "vertices " . showsPrec p xs
+        eshow [(x, y)] = showString "edge "     . showsPrec p x .
+                         showString " "         . showsPrec p y
+        eshow xs       = showString "edges "    . showsPrec p xs
         used           = referredToVertexSet r
 
 instance Ord a => Ord (Relation a) where

diff --git a/test/Algebra/Graph/Test/Generic.hs b/test/Algebra/Graph/Test/Generic.hs
@@ -122,6 +122,22 @@ testShow (Testsuite prefix (%)) = do
     test "show (1 * 2 + 3) == \"overlay (vertex 3) (edge 1 2)\"" $
           show % (1 * 2 + 3) == "overlay (vertex 3) (edge 1 2)"
 
+    test "showsPrec 11 empty \"\" == \"empty\"" $
+          (showsPrec 11 % empty) "" == "empty"
+
+    test "showsPrec 11 1 \"\" == \"(vertex 1)\"" $
+          (showsPrec 11 % 1) "" == "(vertex 1)"
+
+    test "showsPrec 11 (1 * 2) \"\" == \"(edge 1 2)\"" $
+          (showsPrec 11 % (1 * 2)) "" == "(edge 1 2)"
+
+    test "showsPrec 11 (1 * 2 * 3) \"\" == \"(edges [(1,2),(1,3),(2,3)])\"" $
+          (showsPrec 11 % (1 * 2 * 3)) "" == "(edges [(1,2),(1,3),(2,3)])"
+
+    test "showsPrec 11 (1 * 2 + 3) \"\" == \"(overlay (vertex 3) (edge 1 2))\"" $
+          (showsPrec 11 % (1 * 2 + 3)) "" == "(overlay (vertex 3) (edge 1 2))"
+
+
 testOrd :: Testsuite -> IO ()
 testOrd (Testsuite prefix (%)) = do
     putStrLn $ "\n============ " ++ prefix ++ "Ord ============"

diff --git a/test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs b/test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs
@@ -100,6 +100,12 @@ testNonEmptyAdjacencyMap = do
     test "show (1 * 2 + 3 :: AdjacencyMap Int) == \"overlay (vertex 3) (edge 1 2)\"" $
           show (1 * 2 + 3 :: AdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"
 
+    test "show (vertex (vertex 1) :: AdjacencyMap (AdjacencyMap Int)) == \"vertex (vertex 1)\"" $
+          show (vertex (vertex 1) :: AdjacencyMap (AdjacencyMap Int)) == "vertex (vertex 1)"
+
+    test "show (edge (edge 1 2) (edge 1 2) :: AdjacencyMap (AdjacencyMap Int)) == \"edge (edge 1 2) (edge 1 2)\"" $
+          show (edge (edge 1 2) (edge 1 2) :: AdjacencyMap (AdjacencyMap Int)) == "edge (edge 1 2) (edge 1 2)"
+
     putStrLn $ "\n============ NonEmpty.AdjacencyMap.toNonEmpty ============"
     test "toNonEmpty empty              == Nothing" $
           toNonEmpty (AM.empty :: AM.AdjacencyMap Int) == Nothing