From 915d5ddac2d6f5742785d507984edf53126abad3 Mon Sep 17 00:00:00 2001 From: Tim Sheard Date: Wed, 21 Oct 2020 16:52:31 -0700 Subject: [PATCH] ormolise --- .../src/Cardano/Ledger/ShelleyMA/TxBody.hs | 30 ++++++++++--------- .../src/Shelley/Spec/Ledger/API/Types.hs | 4 +-- .../src/Shelley/Spec/Ledger/Tx.hs | 8 ++--- .../src/Shelley/Spec/Ledger/TxBody.hs | 30 +++++++++---------- .../src/Shelley/Spec/Ledger/UTxO.hs | 4 +-- 5 files changed, 39 insertions(+), 37 deletions(-) diff --git a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs index ba6262459f7..37369413d19 100644 --- a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs +++ b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/TxBody.hs @@ -27,11 +27,11 @@ module Cardano.Ledger.ShelleyMA.TxBody where import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..)) - -- \/ This is the type family Value -import Cardano.Ledger.Core (Value,Compactible(..),CompactForm(..)) +-- \/ This is the type family Value +import Cardano.Ledger.Core (CompactForm (..), Compactible (..), Value) import Cardano.Ledger.Era (Crypto, Era) import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..), decodeVI, encodeVI) -import Cardano.Ledger.Val(Val(..)) +import Cardano.Ledger.Val (Val (..)) import Control.DeepSeq (NFData) import Data.ByteString.Short (ShortByteString, fromShort, toShort) import Data.Coders @@ -60,12 +60,12 @@ import Shelley.Spec.Ledger.MetaData (MetaDataHash) import Shelley.Spec.Ledger.PParams (Update) import Shelley.Spec.Ledger.Serialization (encodeFoldable) import Shelley.Spec.Ledger.TxBody - ( DCert (..), - Wdrl (..), - TxInParam(TxIn), - TxIdParam(..), - TxOut(..), - ) + ( DCert (..), + TxIdParam (..), + TxInParam (TxIn), + TxOut (..), + Wdrl (..), + ) -- ================================================ -- There is a mutualy recursive cycle through the types @@ -101,7 +101,8 @@ deriving instance Generic (MaryBody' era) deriving instance NoThunks (Value era) => NoThunks (MaryBody' era) -instance (Era era,FromCBOR (CompactForm (Value era)),FromCBOR (Value era)) => +instance + (Era era, FromCBOR (CompactForm (Value era)), FromCBOR (Value era)) => FromCBOR (MaryBody' era) where fromCBOR = @@ -117,7 +118,8 @@ instance (Era era,FromCBOR (CompactForm (Value era)),FromCBOR (Value era)) => +instance + (Era era, FromCBOR (Value era), FromCBOR (CompactForm (Value era))) => FromCBOR (Annotator (MaryBody' era)) where fromCBOR = pure <$> fromCBOR @@ -128,7 +130,7 @@ instance (Era era, FromCBOR(Value era),FromCBOR (CompactForm (Value era))) => newtype MaryBody e = STxBody (MemoBytes (MaryBody' e)) deriving (Typeable) -deriving instance (Compactible (Value era), Eq(Value era)) => Eq (MaryBody era) +deriving instance (Compactible (Value era), Eq (Value era)) => Eq (MaryBody era) deriving instance (Era era, Compactible (Value era), Show (Value era)) => Show (MaryBody era) @@ -136,12 +138,12 @@ deriving instance Generic (MaryBody era) deriving newtype instance NoThunks (Value era) => NoThunks (MaryBody era) -deriving newtype instance (Typeable era, ToCBOR(Value era)) => ToCBOR (MaryBody era) +deriving newtype instance (Typeable era, ToCBOR (Value era)) => ToCBOR (MaryBody era) deriving via (Mem (MaryBody' era)) instance - (Era era, FromCBOR (CompactForm (Value era)), FromCBOR(Value era)) => + (Era era, FromCBOR (CompactForm (Value era)), FromCBOR (Value era)) => FromCBOR (Annotator (MaryBody era)) -- Make a Pattern so the newtype and the MemoBytes are hidden diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Types.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Types.hs index 7fff828f978..8f1c40c985c 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Types.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Types.hs @@ -159,8 +159,8 @@ import Shelley.Spec.Ledger.StabilityWindow as X import Shelley.Spec.Ledger.Tx as X ( Tx (..), TxBody (..), - TxInParam(TxIn,TxInCompact), TxIn, + TxInParam (TxIn, TxInCompact), TxOut (..), WitnessSet, ) @@ -174,8 +174,8 @@ import Shelley.Spec.Ledger.TxBody as X Ptr (..), StakeCreds (..), StakePoolRelay (..), - TxIdParam(TxId), TxId, + TxIdParam (TxId), Wdrl (..), WitVKey (..), ) diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Tx.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Tx.hs index c70faad2f73..24114426598 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Tx.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Tx.hs @@ -30,9 +30,9 @@ module Shelley.Spec.Ledger.Tx TxBody (..), TxOut (..), TxIn, - TxInParam(TxIn,TxInCompact), + TxInParam (TxIn, TxInCompact), TxId, - TxIdParam(TxId), + TxIdParam (TxId), decodeWits, segwitTx, -- witness data @@ -109,10 +109,10 @@ import Shelley.Spec.Ledger.Serialization ) import Shelley.Spec.Ledger.TxBody ( TxBody (..), - TxIdParam(TxId), TxId, - TxInParam(TxIn,TxInCompact), + TxIdParam (TxId), TxIn, + TxInParam (TxIn, TxInCompact), TxOut (..), WitVKey (..), witKeyHash, 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 index 567346dd2fd..20044060c78 100644 --- 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 @@ -50,10 +50,10 @@ module Shelley.Spec.Ledger.TxBody _mdHash, extraSize ), - TxIdParam(TxId), + TxIdParam (TxId), TxId, TxIn, - TxInParam(TxIn), + TxInParam (TxIn), EraIndependentTxBody, eraIndTxBodyHash, pattern TxInCompact, @@ -423,7 +423,6 @@ instance Era era => FromJSON (PoolParams era) where -- types in their own datatypes, if they then try and derive (Foo TheirDataType). -- ==================================================================================== - -- | A unique ID of a transaction, which is computable from the transaction. newtype TxIdParam body era = TxId {_unTxId :: Hash (Crypto era) body} deriving (Show, Eq, Ord, Generic) @@ -432,11 +431,11 @@ newtype TxIdParam body era = TxId {_unTxId :: Hash (Crypto era) body} type TxId era = TxIdParam (Core.TxBody era) era deriving newtype instance - (Era era, Typeable body) => -- weakest constraint + (Era era, Typeable body) => -- weakest constraint ToCBOR (TxIdParam body era) deriving newtype instance - (Era era, Typeable body) => -- weakest constraint + (Era era, Typeable body) => -- weakest constraint FromCBOR (TxIdParam body era) deriving newtype instance (Era era) => NFData (TxIdParam body era) @@ -480,14 +479,14 @@ data TxOut era !(Core.CompactForm (Core.Value era)) instance - (Show (Core.Value era), Era era, Core.Compactible (Core.Value era)) -- Use the weakest constraint possible here - => + (Show (Core.Value era), Era era, Core.Compactible (Core.Value era)) => -- Use the weakest constraint possible here Show (TxOut era) where show = show . viewCompactTxOut -deriving stock instance -- weakest constraint - (Eq (Core.Value era), Core.Compactible (Core.Value era)) => +deriving stock instance + -- weakest constraint + (Eq (Core.Value era), Core.Compactible (Core.Value era)) => Eq (TxOut era) instance NFData (TxOut era) where @@ -511,8 +510,7 @@ pattern TxOut addr vl <- viewCompactTxOut :: forall era. - (Era era, Core.Compactible (Core.Value era)) -- Use the weakest constraint possible here - => + (Era era, Core.Compactible (Core.Value era)) => -- Use the weakest constraint possible here TxOut era -> (Addr era, Core.Value era) viewCompactTxOut (TxOutCompact bs c) = (addr, val) @@ -892,8 +890,9 @@ instance b <- fromCBOR pure $ TxInCompact a b -instance -- use the weakest constraint necessary - (Era era,ToCBOR(Core.Value era),ToCBOR (Core.CompactForm (Core.Value era))) => +instance-- use the weakest constraint necessary + + (Era era, ToCBOR (Core.Value era), ToCBOR (Core.CompactForm (Core.Value era))) => ToCBOR (TxOut era) where toCBOR (TxOutCompact addr coin) = @@ -901,8 +900,9 @@ instance -- use the weakest constraint necessary <> toCBOR addr <> toCBOR coin -instance -- use the weakest constraint necessary - (Era era,FromCBOR (Core.Value era),FromCBOR (Core.CompactForm (Core.Value era))) => +instance-- use the weakest constraint necessary + + (Era era, FromCBOR (Core.Value era), FromCBOR (Core.CompactForm (Core.Value era))) => FromCBOR (TxOut era) where fromCBOR = decodeRecordNamed "TxOut" (const 2) $ do diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs index 7d3499f22c5..889c1e0dfbe 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/UTxO.hs @@ -97,10 +97,10 @@ import Shelley.Spec.Ledger.TxBody ( EraIndependentTxBody, PoolCert (..), PoolParams (..), - TxIdParam(..), TxId, - TxInParam(..), + TxIdParam (..), TxIn, + TxInParam (..), TxOut (..), Wdrl (..), WitVKey (..),