move pretty printers to separate package

cabal.project

@@ -15,6 +15,7 @@ packages:
   eras/shelley-ma/test-suite
   libs/cardano-ledger-core
   libs/cardano-ledger-example-shelley
+  libs/cardano-ledger-pretty
   libs/cardano-ledger-test
   libs/cardano-protocol-tpraos
   libs/plutus-preprocessor
@@ -162,6 +163,9 @@ package cardano-ledger-core
 package cardano-ledger-example-shelley
   ghc-options: -Werror
 
+package cardano-ledger-pretty
+  ghc-options: -Werror
+
 package cardano-ledger-test
   ghc-options: -Werror
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs

@@ -24,12 +24,8 @@ module Cardano.Ledger.Alonzo.Data
     getPlutusData,
     dataHashSize,
     -- $
-    AuxiliaryData (AuxiliaryData, scripts, txMD),
+    AuxiliaryData (AuxiliaryData, AuxiliaryData', scripts, txMD),
     AuxiliaryDataHash (..),
-    -- $
-    ppPlutusData,
-    ppData,
-    ppAuxiliaryData,
   )
 where
 
@@ -45,19 +41,6 @@ import Cardano.Ledger.Hashes
   ( EraIndependentAuxiliaryData,
     EraIndependentData,
   )
-import Cardano.Ledger.Pretty
-  ( PDoc,
-    PrettyA (..),
-    ppInteger,
-    ppList,
-    ppLong,
-    ppMap,
-    ppMetadatum,
-    ppPair,
-    ppSexp,
-    ppStrictSeq,
-    ppWord64,
-  )
 import Cardano.Ledger.SafeHash
   ( HashAnnotated,
     SafeHash,
@@ -121,6 +104,8 @@ pattern Data p <-
   where
     Data p = DataConstr (memoBytes (To p))
 
+{-# COMPLETE Data #-}
+
 getPlutusData :: Data era -> Plutus.Data
 getPlutusData (DataConstr (Memo d _)) = d
 
@@ -297,24 +282,11 @@ pattern AuxiliaryData {txMD, scripts} <-
 
 {-# COMPLETE AuxiliaryData #-}
 
--- =======================================================
-
-ppPlutusData :: Plutus.Data -> PDoc
-ppPlutusData (Plutus.Constr tag args) = ppSexp "Constr" [ppInteger tag, ppList ppPlutusData args]
-ppPlutusData (Plutus.Map pairs) = ppSexp "Map" [ppList (ppPair ppPlutusData ppPlutusData) pairs]
-ppPlutusData (Plutus.List xs) = ppSexp "List" [ppList ppPlutusData xs]
-ppPlutusData (Plutus.I i) = ppSexp "I" [ppInteger i]
-ppPlutusData (Plutus.B bytes) = ppSexp "B" [ppLong bytes]
-
-instance PrettyA Plutus.Data where prettyA = ppPlutusData
-
-ppData :: Data era -> PDoc
-ppData (DataConstr (Memo x _)) = ppSexp "Data" [ppPlutusData x]
-
-instance PrettyA (Data era) where prettyA = ppData
-
-ppAuxiliaryData :: (PrettyA (Core.Script era)) => AuxiliaryData era -> PDoc
-ppAuxiliaryData (AuxiliaryDataConstr (Memo (AuxiliaryDataRaw m s) _)) =
-  ppSexp "AuxiliaryData" [ppMap ppWord64 ppMetadatum m, ppStrictSeq prettyA s]
+pattern AuxiliaryData' ::
+  Map Word64 Metadatum ->
+  StrictSeq (Core.Script era) ->
+  AuxiliaryData era
+pattern AuxiliaryData' txMD_ scripts_ <-
+  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD_ scripts_) _)
 
-instance (PrettyA (Core.Script era)) => PrettyA (AuxiliaryData era) where prettyA = ppAuxiliaryData
+{-# COMPLETE AuxiliaryData' #-}

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Language.hs

@@ -6,7 +6,6 @@
 module Cardano.Ledger.Alonzo.Language where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeWord64)
-import Cardano.Ledger.Pretty (PDoc, PrettyA (..), ppString)
 import Control.DeepSeq (NFData (..))
 import Data.Ix (Ix)
 import qualified Data.Set as Set
@@ -40,11 +39,3 @@ instance FromCBOR Language where
 
 nonNativeLanguages :: Set.Set Language
 nonNativeLanguages = Set.fromList [minBound .. maxBound]
-
--- ==================================
-
-ppLanguage :: Language -> PDoc
-ppLanguage PlutusV1 = ppString "PlutusV1"
-ppLanguage PlutusV2 = ppString "PlutusV2"
-
-instance PrettyA Language where prettyA = ppLanguage

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -27,8 +27,6 @@ module Cardano.Ledger.Alonzo.PParams
     encodeLangViews,
     retractPP,
     extendPP,
-    ppPParams,
-    ppPParamsUpdate,
     -- Deprecated
     ProtVer,
     pvMajor,
@@ -44,19 +42,15 @@ import Cardano.Binary
     serialize',
     serializeEncoding',
   )
-import Cardano.Ledger.Alonzo.Language (Language (..), ppLanguage)
+import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts
   ( CostModel,
     ExUnits (..),
     Prices (..),
     decodeCostModelMap,
-    ppCostModel,
-    ppExUnits,
-    ppPrices,
   )
 import Cardano.Ledger.BaseTypes
-  ( BoundedRational (unboundRational),
-    NonNegativeInterval,
+  ( NonNegativeInterval,
     Nonce (NeutralNonce),
     StrictMaybe (..),
     UnitInterval,
@@ -66,20 +60,6 @@ import Cardano.Ledger.BaseTypes
 import qualified Cardano.Ledger.BaseTypes as BT (ProtVer (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Era
-import Cardano.Ledger.Pretty
-  ( PDoc,
-    PrettyA (prettyA),
-    ppCoin,
-    ppEpochNo,
-    ppMap,
-    ppNatural,
-    ppNonce,
-    ppProtVer,
-    ppRational,
-    ppRecord,
-    ppStrictMaybe,
-    ppUnitInterval,
-  )
 import Cardano.Ledger.Serialization
   ( FromCBORGroup (..),
     ToCBORGroup (..),
@@ -563,77 +543,6 @@ extendPP
   mxCol =
     PParams ma mb mxBB mxT mxBH kd pd emx a n rho tau d eE pv mnP ada cost price mxTx mxBl mxV col mxCol
 
--- ======================================================
--- Pretty instances
-
-ppPParams :: PParams' Identity era -> PDoc
-ppPParams (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mpool ada cost prices mxEx mxBEx mxV c mxC) =
-  ppRecord
-    "PParams"
-    [ ("minfeeA", ppNatural feeA),
-      ("minfeeB", ppNatural feeB),
-      ("maxBBSize", ppNatural mbb),
-      ("maxTxSize", ppNatural mtx),
-      ("maxBHSize", ppNatural mbh),
-      ("keyDeposit", ppCoin kd),
-      ("poolDeposit", ppCoin pd),
-      ("eMax", ppEpochNo em),
-      ("nOpt", ppNatural no),
-      ("a0", ppRational (unboundRational a0)),
-      ("rho", ppUnitInterval rho),
-      ("tau", ppUnitInterval tau),
-      ("d", ppUnitInterval d),
-      ("extraEntropy", ppNonce ex),
-      ("protocolVersion", ppProtVer pv),
-      ("minPoolCost", ppCoin mpool),
-      ("adaPerWord", ppCoin ada),
-      ("costmdls", ppMap ppLanguage ppCostModel cost),
-      ("prices", ppPrices prices),
-      ("maxTxExUnits", ppExUnits mxEx),
-      ("maxBlockExUnits", ppExUnits mxBEx),
-      ("maxValSize", ppNatural mxV),
-      ("collateral%", ppNatural c),
-      ("maxCollateralInputs", ppNatural mxC)
-    ]
-
-instance PrettyA (PParams' Identity era) where
-  prettyA = ppPParams
-
-ppPParamsUpdate :: PParams' StrictMaybe era -> PDoc
-ppPParamsUpdate (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mpool ada cost prices mxEx mxBEx mxV c mxC) =
-  ppRecord
-    "PParams"
-    [ ("minfeeA", lift ppNatural feeA),
-      ("minfeeB", lift ppNatural feeB),
-      ("maxBBSize", lift ppNatural mbb),
-      ("maxTxSize", lift ppNatural mtx),
-      ("maxBHSize", lift ppNatural mbh),
-      ("keyDeposit", lift ppCoin kd),
-      ("poolDeposit", lift ppCoin pd),
-      ("eMax", lift ppEpochNo em),
-      ("nOpt", lift ppNatural no),
-      ("a0", lift (ppRational . unboundRational) a0),
-      ("rho", lift ppUnitInterval rho),
-      ("tau", lift ppUnitInterval tau),
-      ("d", lift ppUnitInterval d),
-      ("extraEntropy", lift ppNonce ex),
-      ("protocolVersion", lift ppProtVer pv),
-      ("minPoolCost", lift ppCoin mpool),
-      ("adaPerWord", lift ppCoin ada),
-      ("costmdls", lift (ppMap ppLanguage ppCostModel) cost),
-      ("prices", lift ppPrices prices),
-      ("maxTxExUnits", lift ppExUnits mxEx),
-      ("maxBlockExUnits", lift ppExUnits mxBEx),
-      ("maxValSize", lift ppNatural mxV),
-      ("collateral%", lift ppNatural c),
-      ("maxCollateralInputs", lift ppNatural mxC)
-    ]
-  where
-    lift pp x = ppStrictMaybe pp x
-
-instance PrettyA (PParams' StrictMaybe era) where
-  prettyA = ppPParamsUpdate
-
 {-# DEPRECATED ProtVer "Import from Cardano.Ledger.BaseTypes instead" #-}
 
 type ProtVer = BT.ProtVer

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs

@@ -22,8 +22,6 @@ module Cardano.Ledger.Alonzo.Scripts
   ( Tag (..),
     Script (TimelockScript, PlutusScript),
     txscriptfee,
-    ppTag,
-    ppScript,
     isPlutusScript,
     pointWiseExUnits,
 
@@ -33,9 +31,6 @@ module Cardano.Ledger.Alonzo.Scripts
     Prices (..),
     hashCostModel,
     validateCostModelParams,
-    ppExUnits,
-    ppCostModel,
-    ppPrices,
     decodeCostModelMap,
     decodeCostModel,
 
@@ -53,19 +48,6 @@ import Cardano.Ledger.Coin (Coin (..))
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Era (Crypto), ValidateScript (hashScript))
-import Cardano.Ledger.Pretty
-  ( PDoc,
-    PrettyA (..),
-    ppInteger,
-    ppMap,
-    ppNatural,
-    ppRational,
-    ppRecord,
-    ppScriptHash,
-    ppSexp,
-    ppString,
-    text,
-  )
 import Cardano.Ledger.SafeHash
   ( HashWithCrypto (..),
     SafeHash,
@@ -95,7 +77,6 @@ import qualified Plutus.V1.Ledger.Examples as Plutus
     alwaysSucceedingNAryFunction,
   )
 import Plutus.V2.Ledger.Api as PV2 hiding (Map, Script)
-import qualified Prettyprinter as PP
 
 -- | Marker indicating the part of a transaction for which this script is acting
 -- as a validator.
@@ -370,39 +351,3 @@ instance
       decodeScript 1 = Ann (SumD $ PlutusScript PlutusV1) <*! Ann From
       decodeScript 2 = Ann (SumD $ PlutusScript PlutusV2) <*! Ann From
       decodeScript n = Invalid n
-
--- ============================================================
--- Pretty printing versions
-
-ppTag :: Tag -> PDoc
-ppTag x = ppString (show x)
-
-instance PrettyA Tag where prettyA = ppTag
-
-ppScript :: forall era. (ValidateScript era, Core.Script era ~ Script era) => Script era -> PDoc
-ppScript s@(PlutusScript v _) = ppString ("PlutusScript " <> show v <> " ") PP.<+> ppScriptHash (hashScript @era s)
-ppScript (TimelockScript x) = ppTimelock x
-
-instance (ValidateScript era, Core.Script era ~ Script era) => PrettyA (Script era) where prettyA = ppScript
-
-ppExUnits :: ExUnits -> PDoc
-ppExUnits (ExUnits mem step) =
-  ppRecord "ExUnits" [("memory", ppNatural mem), ("steps", ppNatural step)]
-
-instance PrettyA ExUnits where prettyA = ppExUnits
-
-ppCostModel :: CostModel -> PDoc
-ppCostModel (CostModel m) =
-  ppSexp "CostModel" [ppMap text ppInteger m]
-
-instance PrettyA CostModel where prettyA = ppCostModel
-
-ppPrices :: Prices -> PDoc
-ppPrices Prices {prMem, prSteps} =
-  ppRecord
-    "Prices"
-    [ ("prMem", ppRational $ unboundRational prMem),
-      ("prSteps", ppRational $ unboundRational prSteps)
-    ]
-
-instance PrettyA Prices where prettyA = ppPrices