Reduce CompactForm constraints

Moves constraints on CompactForm foo into superclass constraints on the Compactible class.
IntersectMBO · Jan 22, 2021 · 30800b6 · 30800b6
1 parent 0978904
commit 30800b6
Show file tree

Hide file tree

Showing 6 changed files with 26 additions and 29 deletions.
diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs
@@ -154,7 +154,7 @@ deriving instance
     Eq (Core.AuxiliaryData era),
     Eq (Core.Script era),
     Eq (Core.Value era),
-    Eq (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   Eq (TxRaw era)
 
@@ -163,8 +163,7 @@ deriving instance
     Compactible (Core.Value era),
     Show (Core.AuxiliaryData era),
     Show (Core.Script era),
-    Show (Core.Value era),
-    Show (CompactForm (Core.Value era))
+    Show (Core.Value era)
   ) =>
   Show (TxRaw era)
 
@@ -184,7 +183,7 @@ deriving newtype instance
     Eq (Core.AuxiliaryData era),
     Eq (Core.Script era),
     Eq (Core.Value era),
-    Eq (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   Eq (Tx era)
 
@@ -193,8 +192,7 @@ deriving newtype instance
     Compactible (Core.Value era),
     Show (Core.AuxiliaryData era),
     Show (Core.Script era),
-    Show (Core.Value era),
-    Show (CompactForm (Core.Value era))
+    Show (Core.Value era)
   ) =>
   Show (Tx era)
 
@@ -471,7 +469,7 @@ indexedRdmrs ::
   ( Era era,
     ToCBOR (Core.AuxiliaryData era),
     ToCBOR (Core.Script era),
-    ToCBOR (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   Tx era ->
   ScriptPurpose (Crypto era) ->
@@ -535,7 +533,7 @@ getData tx (UTxO m) sp = case sp of
 collectNNScriptInputs ::
   ( UsesTxOut era,
     ToCBOR (Core.Script era),
-    ToCBOR (CompactForm (Core.Value era)),
+    Compactible (Core.Value era),
     ToCBOR (Core.AuxiliaryData era),
     Core.Script era ~ AlonzoScript.Script era,
     HasField "datahash" (Core.TxOut era) (Maybe (DataHash (Crypto era)))
@@ -612,7 +610,7 @@ checkScriptData ::
   forall era.
   ( ToCBOR (Core.AuxiliaryData era),
     ValidateScript era,
-    ToCBOR (CompactForm (Core.Value era)),
+    Compactible (Core.Value era),
     UsesTxOut era,
     HasField "datahash" (Core.TxOut era) (Maybe (DataHash (Crypto era)))
   ) =>

diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs
@@ -105,13 +105,12 @@ data TxOut era
 
 deriving stock instance
   ( Eq (Core.Value era),
-    Eq (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   Eq (TxOut era)
 
 instance
-  ( Show (Core.Value era),
-    Show (CompactForm (Core.Value era))
+  ( Show (Core.Value era)
   ) =>
   Show (TxOut era)
   where
@@ -165,7 +164,7 @@ data TxBodyRaw era = TxBodyRaw
 deriving instance
   ( Eq (Core.Value era),
     CC.Crypto (Crypto era),
-    Eq (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   Eq (TxBodyRaw era)
 
@@ -174,15 +173,15 @@ instance
   NoThunks (TxBodyRaw era)
 
 deriving instance
-  (Era era, Show (Core.Value era), Show (CompactForm (Core.Value era))) =>
+  (Era era, Show (Core.Value era)) =>
   Show (TxBodyRaw era)
 
 newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era))
   deriving (ToCBOR)
 
 deriving newtype instance
   ( Eq (Core.Value era),
-    Eq (CompactForm (Core.Value era)),
+    Compactible (Core.Value era),
     CC.Crypto (Crypto era)
   ) =>
   Eq (TxBody era)
@@ -194,7 +193,6 @@ deriving instance
 deriving instance
   ( Era era,
     Compactible (Core.Value era),
-    Show (CompactForm (Core.Value era)),
     Show (Core.Value era)
   ) =>
   Show (TxBody era)
@@ -215,7 +213,7 @@ deriving via
 -- The Set of constraints necessary to use the TxBody pattern
 type AlonzoBody era =
   ( Era era,
-    ToCBOR (CompactForm (Core.Value era)),
+    Compactible (Core.Value era),
     ToCBOR (Core.Script era)
   )
 
@@ -314,7 +312,7 @@ instance Era era => HashAnnotated (TxBody era) era where
 
 instance
   ( Era era,
-    ToCBOR (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   ToCBOR (TxOut era)
   where
@@ -328,7 +326,8 @@ instance
 
 instance
   ( Era era,
-    DecodeNonNegative (CompactForm (Core.Value era)),
+    DecodeNonNegative (Core.Value era),
+    Show (Core.Value era),
     Compactible (Core.Value era)
   ) =>
   FromCBOR (TxOut era)
@@ -342,7 +341,7 @@ instance
 
 encodeTxBodyRaw ::
   ( Era era,
-    ToCBOR (CompactForm (Core.Value era))
+    Compactible (Core.Value era)
   ) =>
   TxBodyRaw era ->
   Encode ('Closed 'Sparse) (TxBodyRaw era)

diff --git a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs
@@ -114,7 +114,6 @@ type FamsFrom era =
     DecodeNonNegative (Value era),
     DecodeMint (Value era),
     Val (Value era), -- Arises because we use 'zero' as the 'mint' field in 'initial'
-    FromCBOR (CompactForm (Value era)), -- Arises because TxOut uses Compact form
     FromCBOR (Value era),
     FromCBOR (Annotator (Script era)) -- Arises becaause DCert memoizes its bytes
   )
@@ -124,7 +123,6 @@ type FamsTo era =
     ToCBOR (Value era),
     Compactible (Value era),
     EncodeMint (Value era),
-    ToCBOR (CompactForm (Value era)), -- Arises because TxOut uses Compact form
     ToCBOR (Script era),
     Typeable (Core.AuxiliaryData era)
   )

diff --git a/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Compactible.hs b/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Compactible.hs
@@ -10,6 +10,7 @@ module Cardano.Ledger.Compactible
   )
 where
 
+import Cardano.Binary (ToCBOR)
 import Data.Kind (Type)
 
 --------------------------------------------------------------------------------
@@ -21,8 +22,13 @@ import Data.Kind (Type)
 -- representation that allows for more efficient memory usage. In this case,
 -- one should make instances of the 'Compactible' class for them.
 --------------------------------------------------------------------------------
-
-class Compactible a where
+class
+  ( Show (CompactForm a),
+    Eq (CompactForm a),
+    ToCBOR (CompactForm a)
+  ) =>
+  Compactible a
+  where
   data CompactForm a :: Type
   toCompact :: a -> Maybe (CompactForm a)
   fromCompact :: CompactForm a -> a
diff --git a/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Shelley/Constraints.hs b/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Shelley/Constraints.hs
@@ -50,9 +50,7 @@ class
     Compactible (Value era),
     ChainData (Value era),
     ChainData (Delta (Value era)),
-    ChainData (CompactForm (Value era)),
     SerialisableData (Value era),
-    SerialisableData (CompactForm (Value era)),
     SerialisableData (Delta (Value era)),
     DecodeNonNegative (Value era),
     EncodeMint (Value era),
@@ -95,7 +93,6 @@ type TransValue (c :: Type -> Constraint) era =
     Compactible (Value era),
     Torsor (Value era),
     c (Value era),
-    c (CompactForm (Value era)),
     c (Delta (Value era))
   )
 

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/TxBody.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/TxBody.hs
@@ -479,7 +479,6 @@ data TxOut era
 
 type TransTxOut (c :: Type -> Constraint) era =
   ( c (Core.Value era),
-    c (CompactForm (Core.Value era)),
     Compactible (Core.Value era)
   )
 
@@ -1021,7 +1020,7 @@ instance-- use the weakest constraint necessary
 
 instance-- use the weakest constraint necessary
 
-  (Era era, TransTxOut DecodeNonNegative era) =>
+  (Era era, TransTxOut DecodeNonNegative era, Show (Core.Value era)) =>
   FromCBOR (TxOut era)
   where
   fromCBOR = decodeRecordNamed "TxOut" (const 2) $ do