connection-manager: use pretty-simple in cm test

IntersectMBO · Oct 20, 2021 · 8a77e54 · 8a77e54
1 parent 9989cf9
commit 8a77e54
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 19 deletions.
diff --git a/ouroboros-network-framework/ouroboros-network-framework.cabal b/ouroboros-network-framework/ouroboros-network-framework.cabal
@@ -132,7 +132,9 @@ test-suite test
                      , dns
                      , iproute
                      , network
+                     , pretty-simple
                      , serialise
+                     , text
                      , time
                      , quiet
 

diff --git a/ouroboros-network-framework/test/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network-framework/test/Test/Ouroboros/Network/ConnectionManager.hs
@@ -55,7 +55,9 @@ import           Data.Map (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Monoid (All (..), Any (..))
 import qualified Data.Set as Set
+import qualified Data.Text.Lazy as Text
 import           Data.Void (Void)
+import           Text.Pretty.Simple (pShowOpt, defaultOutputOptionsNoColor)
 import           Quiet
 
 import           Network.Mux.Types
@@ -1240,25 +1242,15 @@ prop_shrinker_RefinedSchedule a@(Schedule s) =
 --
 newtype ScheduleMap' addr extra =
         ScheduleMap { getScheduleMap :: Map addr (Schedule extra) }
-  deriving (Eq, Functor, Show)
-
-
-{-
-prettyScheduleMap :: (Show addr, Show extra)
-                  => ScheduleMap' addr extra -> String
-prettyScheduleMap (ScheduleMap schedule) =
-        concat
-      . map (\(addr, schedule') ->
-            concat
-              [ show addr
-              , "\n"
-              , intercalate "\n" (map (('\t' :) . show) schedule')
-              ])
-      . Map.assocs
-      . fmap getSchedule
-      $ schedule
--}
-
+  deriving (Eq, Functor)
+
+instance (Show addr, Show extra)
+      => Show (ScheduleMap' addr extra) where
+    show (ScheduleMap schedule) =
+      concat [ "ScheduleMap ( "
+             , Text.unpack (pShowOpt defaultOutputOptionsNoColor schedule)
+             , "\n  )"
+             ]
 
 instance Ord addr => Semigroup (ScheduleMap' addr extra) where
     ScheduleMap a <> ScheduleMap b = ScheduleMap (Map.unionWith f a b)