Started on refactoring pretty

libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal

@@ -56,6 +56,7 @@ library
     hashable,
     iproute,
     mtl,
+    microlens,
     plutus-ledger-api,
     prettyprinter,
     small-steps,

libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs

@@ -7,10 +7,10 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Cardano.Ledger.Pretty where
 
+import Lens.Micro
 import Cardano.Chain.Common
   ( AddrAttributes (..),
     Address (..),
@@ -50,7 +50,7 @@ import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import Cardano.Ledger.CompactAddress (CompactAddr (..), decompactAddr)
 import Cardano.Ledger.Compactible (Compactible (..))
-import Cardano.Ledger.Core (PParamsDelta)
+import Cardano.Ledger.Core hiding (Crypto)
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential
   ( Credential (KeyHashObj, ScriptHashObj),
@@ -97,7 +97,9 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.Metadata (Metadata (..), Metadatum (..))
 import Cardano.Ledger.Shelley.PParams
   ( PPUpdateEnv (..),
-    PParams' (..),
+    ShelleyPParams,
+    ShelleyPParamsHKD (..),
+    ShelleyPParamsUpdate,
     ProposedPPUpdates (..),
     Update (..),
   )
@@ -126,7 +128,7 @@ import Cardano.Ledger.Shelley.Rewards
   )
 import Cardano.Ledger.Shelley.Scripts (MultiSig (..), ScriptHash (..))
 import Cardano.Ledger.Shelley.Tx
-  ( Tx (..),
+  ( ShelleyTx (..),
     WitnessSetHKD,
     prettyWitnessSetParts,
   )
@@ -142,9 +144,9 @@ import Cardano.Ledger.Shelley.TxBody
     PoolMetadata (..),
     PoolParams (..),
     StakePoolRelay (..),
-    TxBody (..),
+    ShelleyTxBody (..),
     TxBodyRaw (..),
-    TxOut (..),
+    ShelleyTxOut (..),
     Wdrl (..),
     WitVKey (..),
   )
@@ -606,9 +608,9 @@ instance PrettyA (RewardUpdate crypto) where
 
 -- | Constraints needed to ensure that the ledger state can be pretty printed.
 type CanPrettyPrintLedgerState era =
-  ( PrettyA (Core.TxOut era),
-    PrettyA (Core.PParams era),
-    PrettyA (State (Core.EraRule "PPUP" era))
+  ( PrettyA (TxOut era),
+    PrettyA (PParams era),
+    PrettyA (State (EraRule "PPUP" era))
   )
 
 ppAccountState :: AccountState -> PDoc
@@ -893,13 +895,13 @@ instance PrettyA (SnapShots crypto) where
 -- Cardano.Ledger.Shelley.UTxO
 
 ppUTxO ::
-  PrettyA (Core.TxOut era) =>
+  PrettyA (TxOut era) =>
   UTxO era ->
   PDoc
 ppUTxO = ppAssocList (text "UTxO") ppTxIn prettyA . Map.toList . unUTxO
 
 instance
-  PrettyA (Core.TxOut era) =>
+  PrettyA (TxOut era) =>
   PrettyA (UTxO era)
   where
   prettyA = ppUTxO
@@ -935,18 +937,19 @@ instance PrettyA (Metadata era) where
 -- Cardano.Ledger.Shelley.Tx
 
 ppTx ::
-  ( PrettyA (Core.TxBody era),
-    PrettyA (Core.AuxiliaryData era),
-    PrettyA (Core.Witnesses era)
+  ( PrettyA (TxBody era),
+    PrettyA (AuxiliaryData era),
+    PrettyA (Witnesses era),
+    EraTx era
   ) =>
   Tx era ->
   PDoc
 ppTx tx =
   ppRecord
     "Tx"
-    [ ("body", prettyA $ getField @"body" tx),
-      ("witnessSet", prettyA $ getField @"wits" tx),
-      ("metadata", ppStrictMaybe prettyA $ getField @"auxiliaryData" tx)
+    [ ("body", prettyA $ tx ^. bodyTxL),
+      ("witnessSet", prettyA $ tx ^. witsTxL),
+      ("metadata", ppStrictMaybe prettyA $ tx ^. auxDataTxL)
     ]
 
 ppBootstrapWitness :: Crypto crypto => BootstrapWitness crypto -> PDoc
@@ -959,7 +962,7 @@ ppBootstrapWitness (BootstrapWitness key sig (ChainCode code) attr) =
       ("attributes", ppLong attr)
     ]
 
-ppWitnessSetHKD :: (Era era, PrettyA (Core.Script era)) => WitnessSetHKD Identity era -> PDoc
+ppWitnessSetHKD :: (Era era, PrettyA (Script era)) => WitnessSetHKD Identity era -> PDoc
 ppWitnessSetHKD x =
   let (addr, scr, boot) = prettyWitnessSetParts x
    in ppRecord
@@ -970,19 +973,19 @@ ppWitnessSetHKD x =
         ]
 
 instance
-  ( PrettyA (Core.TxBody era),
-    PrettyA (Core.AuxiliaryData era),
-    PrettyA (Core.Witnesses era),
-    Era era
+  ( PrettyA (TxBody era),
+    PrettyA (AuxiliaryData era),
+    PrettyA (Witnesses era),
+    EraTx era
   ) =>
-  PrettyA (Tx era)
+  PrettyA (ShelleyTx era)
   where
   prettyA = ppTx
 
 instance Crypto crypto => PrettyA (BootstrapWitness crypto) where
   prettyA = ppBootstrapWitness
 
-instance (Era era, PrettyA (Core.Script era)) => PrettyA (WitnessSetHKD Identity era) where
+instance (Era era, PrettyA (Script era)) => PrettyA (WitnessSetHKD Identity era) where
   prettyA = ppWitnessSetHKD
 
 -- ============================
@@ -1053,7 +1056,7 @@ ppTxId (TxId x) = ppSexp "TxId" [ppSafeHash x]
 ppTxIn :: TxIn c -> PDoc
 ppTxIn (TxIn txid index) = ppSexp "TxIn" [ppTxId txid, pretty (txIxToInt index)]
 
-ppTxOut :: (Era era, PrettyA (Core.Value era)) => TxOut era -> PDoc
+ppTxOut :: (Era era, PrettyA (Value era)) => TxOut era -> PDoc
 ppTxOut (TxOutCompact caddr cval) = ppSexp "TxOut" [ppCompactAddr caddr, ppCompactForm prettyA cval]
 
 ppDelegCert :: DelegCert c -> PDoc
@@ -1086,9 +1089,9 @@ ppDCert (DCertGenesis x) = ppSexp "DCertGenesis" [ppGenesisDelegCert x]
 ppDCert (DCertMir x) = ppSexp "DCertMir" [ppMIRCert x]
 
 ppTxBody ::
-  PrettyA (Core.TxOut era) =>
+  PrettyA (TxOut era) =>
   PrettyA (PParamsDelta era) =>
-  TxBody era ->
+  ShelleyTxBody era ->
   PDoc
 ppTxBody (TxBodyConstr (Memo (TxBodyRaw ins outs cs wdrls fee ttl upd mdh) _)) =
   ppRecord
@@ -1127,7 +1130,7 @@ instance PrettyA (TxId c) where
 instance PrettyA (TxIn c) where
   prettyA = ppTxIn
 
-instance (Era era, PrettyA (Core.Value era)) => PrettyA (TxOut era) where
+instance (Era era, PrettyA (Value era)) => PrettyA (ShelleyTxOut era) where
   prettyA = ppTxOut
 
 instance PrettyA (DelegCert c) where
@@ -1149,8 +1152,8 @@ instance PrettyA (DCert c) where
   prettyA = ppDCert
 
 instance
-  (PrettyA (Core.TxOut era), PrettyA (PParamsDelta era)) =>
-  PrettyA (TxBody era)
+  (PrettyA (TxOut era), PrettyA (PParamsUpdate era)) =>
+  PrettyA (ShelleyTxBody era)
   where
   prettyA = ppTxBody
 
@@ -1186,8 +1189,8 @@ instance Crypto c => PrettyA (CompactAddr c) where
 ppProtVer :: ProtVer -> PDoc
 ppProtVer (ProtVer maj mi) = ppRecord "Version" [("major", ppNatural maj), ("minor", ppNatural mi)]
 
-ppPParams :: PParams' Identity era -> PDoc
-ppPParams (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mutxo mpool) =
+ppPParams :: ShelleyPParams era -> PDoc
+ppPParams (ShelleyPParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mutxo mpool) =
   ppRecord
     "PParams"
     [ ("minfeeA", ppNatural feeA),
@@ -1209,8 +1212,8 @@ ppPParams (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mutxo mp
       ("minPoolCost", ppCoin mpool)
     ]
 
-ppPParamsUpdate :: PParams' StrictMaybe era -> PDoc
-ppPParamsUpdate (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mutxo mpool) =
+ppPParamsUpdate :: ShelleyPParamsUpdate era -> PDoc
+ppPParamsUpdate (ShelleyPParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mutxo mpool) =
   ppRecord
     "PParams"
     [ ("minfeeA", lift ppNatural feeA),
@@ -1258,10 +1261,10 @@ instance
 instance PrettyA (PParamsDelta e) => PrettyA (Update e) where
   prettyA = ppUpdate
 
-instance PrettyA (PParams' StrictMaybe e) where
+instance PrettyA (ShelleyPParamsUpdate e) where
   prettyA = ppPParamsUpdate
 
-instance PrettyA (PParams' Identity e) where
+instance PrettyA (ShelleyPParams e) where
   prettyA = ppPParams
 
 instance PrettyA ProtVer where