move pretty trace code

IntersectMBO · Feb 24, 2022 · 626be16 · 626be16
1 parent 7fff1dc
commit 626be16
Show file tree

Hide file tree

Showing 7 changed files with 20 additions and 44 deletions.
diff --git a/eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal b/eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal
@@ -48,7 +48,6 @@ library
     Test.Cardano.Ledger.Alonzo.Serialisation.Generators
     Test.Cardano.Ledger.Alonzo.AlonzoEraGen
     Test.Cardano.Ledger.Alonzo.Scripts
-    Test.Cardano.Ledger.Alonzo.Trace
     Test.Cardano.Ledger.Alonzo.PlutusScripts
   build-depends:
     bytestring,

diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs
diff --git a/eras/babbage/test-suite/cardano-ledger-babbage-test.cabal b/eras/babbage/test-suite/cardano-ledger-babbage-test.cabal
@@ -39,7 +39,6 @@ library
 
   exposed-modules:
     Test.Cardano.Ledger.Babbage.Serialisation.Generators
-    Test.Cardano.Ledger.Babbage.Trace
   build-depends:
     bytestring,
     cardano-binary,

diff --git a/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Trace.hs b/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Trace.hs
diff --git a/hie.yaml b/hie.yaml
@@ -104,3 +104,6 @@ cradle:
 
     - path: "libs/set-algebra/test"
       component: "set-algebra:test:tests"
+
+    - path: "libs/cardano-ledger-pretty/src"
+      component: "lib:cardano-ledger-pretty"
diff --git a/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal b/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal
@@ -40,21 +40,22 @@ library
   build-depends:
     bech32,
     bytestring,
+    cardano-crypto-class,
     cardano-data,
     cardano-ledger-alonzo,
+    cardano-ledger-byron,
+    cardano-ledger-core,
     cardano-ledger-shelley,
     cardano-ledger-shelley-ma,
-    cardano-crypto-class,
-    cardano-ledger-byron,
     cardano-protocol-tpraos,
     cardano-slotting,
-    containers,
     compact-map,
+    containers,
+    hashable,
     iproute,
     mtl,
     plutus-ledger-api,
     prettyprinter,
     small-steps,
-    cardano-ledger-core,
     strict-containers,
     text,
diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs
@@ -180,6 +180,7 @@ import qualified Data.ByteString as Long (ByteString)
 import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
 import qualified Data.Compact.SplitMap as SplitMap
 import qualified Data.Compact.VMap as VMap
+import qualified Data.Hashable as Hashable
 import Data.IP (IPv4, IPv6)
 import qualified Data.Map.Strict as Map (Map, toList)
 import Data.MemoBytes (MemoBytes (..))
@@ -189,6 +190,7 @@ import Data.Set (Set, toList)
 import Data.Text (Text)
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32, Word64, Word8)
+import Debug.Trace (trace)
 import GHC.Natural (Natural)
 import GHC.Records
 import Prettyprinter
@@ -1661,3 +1663,13 @@ instance PrettyA Bool where
 
 instance PrettyA Int where
   prettyA = ppInt
+
+ptrace :: PrettyA t => String -> t -> a -> a
+ptrace x y z = trace ("\n" ++ show (prettyA y) ++ "\n" ++ show x) z
+
+instance (PrettyA x, PrettyA y) => PrettyA (Map.Map x y) where
+  prettyA m = ppMap prettyA prettyA m
+
+-- | turn on trace appromimately 1 in 'n' times it is called.
+occaisionally :: Hashable.Hashable a => a -> Int -> String -> String
+occaisionally x n s = if mod (Hashable.hash x) n == 0 then trace s s else s