Made TxBody a data family

Author: Soupstraw

eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs

@@ -16,10 +16,11 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
 module Cardano.Ledger.Allegra.TxBody (
   AllegraEraTxBody (..),
-  AllegraTxBody (
+  TxBody (
     MkAllegraTxBody,
     AllegraTxBody,
     atbAuxDataHash,
@@ -57,7 +58,6 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
  )
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.MemoBytes (
   EqRaw,
@@ -195,55 +195,39 @@ emptyAllegraTxBodyRaw =
 -- ===========================================================================
 -- Wrap it all up in a newtype, hiding the insides with a pattern construtor.
 
-newtype AllegraTxBody e = MkAllegraTxBody (MemoBytes (AllegraTxBodyRaw () e))
-  deriving newtype (SafeToHash, ToCBOR, DecCBOR)
+instance Memoized (TxBody AllegraEra) where
+  type RawType (TxBody AllegraEra) = AllegraTxBodyRaw () AllegraEra
 
-instance Memoized (AllegraTxBody era) where
-  type RawType (AllegraTxBody era) = AllegraTxBodyRaw () era
+deriving instance Eq (TxBody AllegraEra)
 
-deriving instance
-  (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) =>
-  Eq (AllegraTxBody era)
-
-deriving instance
-  (Era era, Show (TxOut era), Show (TxCert era), Compactible (Value era), Show (PParamsUpdate era)) =>
-  Show (AllegraTxBody era)
+deriving instance Show (TxBody AllegraEra)
 
-deriving instance Generic (AllegraTxBody era)
+deriving instance Generic (TxBody AllegraEra)
 
-deriving newtype instance
-  (Era era, NoThunks (TxOut era), NoThunks (TxCert era), NoThunks (PParamsUpdate era)) =>
-  NoThunks (AllegraTxBody era)
+deriving newtype instance NoThunks (TxBody AllegraEra)
 
-deriving newtype instance
-  ( NFData (TxOut era)
-  , NFData (TxCert era)
-  , NFData (PParamsUpdate era)
-  , Era era
-  ) =>
-  NFData (AllegraTxBody era)
+deriving newtype instance NFData (TxBody AllegraEra)
 
 -- | Encodes memoized bytes created upon construction.
-instance Era era => EncCBOR (AllegraTxBody era)
+instance EncCBOR (TxBody AllegraEra)
 
 type instance MemoHashIndex (AllegraTxBodyRaw c era) = EraIndependentTxBody
 
-instance Era era => HashAnnotated (AllegraTxBody era) EraIndependentTxBody where
+instance HashAnnotated (TxBody AllegraEra) EraIndependentTxBody where
   hashAnnotated = getMemoSafeHash
 
 -- | A pattern to keep the newtype and the MemoBytes hidden
 pattern AllegraTxBody ::
-  forall era.
-  (EraTxOut era, EraTxCert era) =>
+  (EraTxOut AllegraEra, EraTxCert AllegraEra) =>
   Set TxIn ->
-  StrictSeq (TxOut era) ->
-  StrictSeq (TxCert era) ->
+  StrictSeq (TxOut AllegraEra) ->
+  StrictSeq (TxCert AllegraEra) ->
   Withdrawals ->
   Coin ->
   ValidityInterval ->
-  StrictMaybe (Update era) ->
+  StrictMaybe (Update AllegraEra) ->
   StrictMaybe TxAuxDataHash ->
-  AllegraTxBody era
+  TxBody AllegraEra
 pattern AllegraTxBody
   { atbInputs
   , atbOutputs
@@ -276,7 +260,7 @@ pattern AllegraTxBody
       validityInterval
       update
       auxDataHash =
-        mkMemoizedEra @era $
+        mkMemoizedEra @AllegraEra $
           AllegraTxBodyRaw
             { atbrInputs = inputs
             , atbrOutputs = outputs
@@ -292,7 +276,8 @@ pattern AllegraTxBody
 {-# COMPLETE AllegraTxBody #-}
 
 instance EraTxBody AllegraEra where
-  type TxBody AllegraEra = AllegraTxBody AllegraEra
+  newtype TxBody AllegraEra = MkAllegraTxBody (MemoBytes (AllegraTxBodyRaw () AllegraEra))
+    deriving newtype (SafeToHash, ToCBOR, DecCBOR)
 
   mkBasicTxBody = mkMemoizedEra @AllegraEra emptyAllegraTxBodyRaw
 
@@ -365,6 +350,4 @@ instance AllegraEraTxBody AllegraEra where
       \txBodyRaw vldt -> txBodyRaw {atbrValidityInterval = vldt}
   {-# INLINEABLE vldtTxBodyL #-}
 
-instance
-  (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) =>
-  EqRaw (AllegraTxBody era)
+instance EqRaw (TxBody AllegraEra)

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Arbitrary.hs

@@ -28,11 +28,11 @@ import Cardano.Ledger.Shelley.Scripts (
   pattern RequireSignature,
  )
 
+import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
-import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (AllegraTxBody))
+import Cardano.Ledger.Allegra.TxBody (pattern AllegraTxBody)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.API (ShelleyTxAuxData (ShelleyTxAuxData))
-import Data.Maybe.Strict (StrictMaybe)
 import Data.Sequence.Strict (StrictSeq, fromList)
 import Generic.Random (genericArbitraryU)
 import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata', sizedNativeScriptGens)
@@ -102,15 +102,7 @@ instance
   where
   arbitrary = genericArbitraryU
 
-instance
-  ( EraTxOut era
-  , EraTxCert era
-  , Arbitrary (TxOut era)
-  , Arbitrary (PParamsHKD StrictMaybe era)
-  , Arbitrary (TxCert era)
-  ) =>
-  Arbitrary (AllegraTxBody era)
-  where
+instance Arbitrary (TxBody AllegraEra) where
   arbitrary =
     AllegraTxBody
       <$> arbitrary

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Annotator.hs

@@ -14,6 +14,7 @@ module Test.Cardano.Ledger.Allegra.Binary.Annotator (
   module Test.Cardano.Ledger.Shelley.Binary.Annotator,
 ) where
 
+import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Allegra.TxAuxData
 import Cardano.Ledger.Allegra.TxBody
@@ -76,6 +77,6 @@ instance
   decCBOR = pure <$> decCBOR
 
 deriving via
-  Mem (AllegraTxBodyRaw () era)
+  Mem (AllegraTxBodyRaw () AllegraEra)
   instance
-    AllegraEraTxBody era => DecCBOR (Annotator (AllegraTxBody era))
+    DecCBOR (Annotator (TxBody AllegraEra))

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/TreeDiff.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -8,6 +9,7 @@ module Test.Cardano.Ledger.Allegra.TreeDiff (
   module Test.Cardano.Ledger.Shelley.TreeDiff,
 ) where
 
+import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Allegra.Rules
 import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Allegra.TxAuxData
@@ -38,12 +40,7 @@ instance
   ) =>
   ToExpr (AllegraTxBodyRaw ma era)
 
-instance
-  ( ToExpr (TxOut era)
-  , ToExpr (TxCert era)
-  , ToExpr (Update era)
-  ) =>
-  ToExpr (AllegraTxBody era)
+instance ToExpr (TxBody AllegraEra)
 
 -- Rules/Utxo
 instance

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -11,7 +12,7 @@ module Cardano.Ledger.Alonzo (
   AlonzoEra,
   AlonzoTxOut,
   MaryValue,
-  AlonzoTxBody,
+  pattern AlonzoTxBody,
   AlonzoScript,
   AlonzoTxAuxData,
 )
@@ -27,7 +28,7 @@ import Cardano.Ledger.Alonzo.Transition ()
 import Cardano.Ledger.Alonzo.Translation ()
 import Cardano.Ledger.Alonzo.Tx ()
 import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
-import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody, AlonzoTxOut)
+import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut, TxBody (AlonzoTxBody))
 import Cardano.Ledger.Alonzo.TxWits ()
 import Cardano.Ledger.Alonzo.UTxO ()
 import Cardano.Ledger.Mary.Value (MaryValue)

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

@@ -10,6 +10,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -52,7 +53,7 @@ module Cardano.Ledger.Alonzo.Tx (
   txdats',
   txscripts',
   txrdmrs,
-  AlonzoTxBody (..),
+  TxBody (AlonzoTxBody),
   -- Figure 4
   totExUnits,
   alonzoMinFeeTx,
@@ -82,9 +83,9 @@ import Cardano.Ledger.Alonzo.Scripts (
  )
 import Cardano.Ledger.Alonzo.TxBody (
   AlonzoEraTxBody (..),
-  AlonzoTxBody (..),
   AlonzoTxBodyUpgradeError,
   ScriptIntegrityHash,
+  TxBody (AlonzoTxBody),
  )
 import Cardano.Ledger.Alonzo.TxWits (
   AlonzoEraTxWits (..),