{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module PSGenerator.Common where

import Auth (AuthRole, AuthStatus)
import Cardano.Api.Shelley (Lovelace, NetworkId)
import Cardano.Node.Emulator.Params (Params)
import Cardano.Node.Emulator.TimeSlot (SlotConfig, SlotConversionError)
import Cardano.Slotting.Slot (EpochNo)
import Control.Applicative (empty, (<|>))
import Control.Lens (ix, (&), (.~), (^.))
import Control.Monad.Freer.Extras.Beam (BeamError, BeamLog)
import Control.Monad.Freer.Extras.Pagination (Page, PageQuery, PageSize)
import Control.Monad.Reader (MonadReader)
import Gist (Gist, GistFile, GistId, NewGist, NewGistFile, Owner)
import Language.PureScript.Bridge (BridgePart, DataConstructor (DataConstructor, _sigConstructor, _sigValues),
                                   DataConstructorArgs (Nullary, Record),
                                   Instance (Eq, Generic, GenericShow, Json, Ord), Language (Haskell), PSType,
                                   RecordEntry (RecordEntry), SumType (SumType),
                                   TypeInfo (TypeInfo, _typeModule, _typeName, _typePackage, _typeParameters), argonaut,
                                   equal, equal1, functor, genericShow, mkSumType, order, psTypeParameters, sumTypeInfo,
                                   typeModule, typeName, (^==))
import Language.PureScript.Bridge.Builder (BridgeData)
import Language.PureScript.Bridge.PSTypes (psInt, psNumber, psString)
import Language.PureScript.Bridge.SumType (sigConstructor, sigValues, sumTypeConstructors)
import Language.PureScript.Bridge.TypeParameters (A)
import Ledger (Address, BlockId, CardanoTx, Certificate, DatumFromQuery, DecoratedTxOut, OnChainTx, PaymentPubKey,
               PaymentPubKeyHash, PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, StakePubKey, StakePubKeyHash,
               Tx, TxId, TxIn, TxInType, TxInput, TxInputType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase,
               Withdrawal)
import Ledger.Ada (Ada)
import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
import Ledger.Credential (Credential, StakingCredential)
import Ledger.DCert (DCert)
import Ledger.Index (ExCPU, ExMemory, ValidationError)
import Ledger.Interval (Extended, Interval, LowerBound, UpperBound)
import Ledger.Scripts (ScriptError)
import Ledger.Slot (Slot)
import Ledger.Tx qualified as Tx (Language, Versioned)
import Ledger.Tx.CardanoAPI (FromCardanoError, ToCardanoError)
import Ledger.Value (AssetClass, CurrencySymbol, TokenName, Value)
import Ouroboros.Network.Magic (NetworkMagic)
import Playground.Types (ContractCall, FunctionSchema, KnownCurrency)
import Plutus.ChainIndex.Api (IsUtxoResponse, QueryResponse, TxosResponse, UtxosResponse)
import Plutus.ChainIndex.ChainIndexError (ChainIndexError)
import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog)
import Plutus.ChainIndex.Tx (ChainIndexTx, ChainIndexTxOutputs, ReferenceScript)
import Plutus.ChainIndex.Tx qualified as ChainIndex
import Plutus.ChainIndex.Types (BlockNumber, Depth, Point, RollbackState, Tip, TxOutState, TxValidity)
import Plutus.ChainIndex.UtxoState (InsertUtxoFailed, InsertUtxoPosition, RollbackFailed)
import Plutus.Contract.Checkpoint (CheckpointError)
import Plutus.Contract.Effects (ActiveEndpoint, BalanceTxResponse, ChainIndexQuery, ChainIndexResponse, PABReq, PABResp,
                                WriteBalancedTxResponse)
import Plutus.Contract.Error (AssertionError, ContractError, MatchingError)
import Plutus.Contract.Resumable (IterationID, Request, RequestID, Response)
import Plutus.Script.Utils.V1.Typed.Scripts (ConnectionError, WrongOutTypeError)
import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg, ContractInstanceTag, EmulatorRuntimeError,
                                    UserThreadMsg)
import Plutus.Trace.Scheduler (Priority, SchedulerLog, ThreadEvent, ThreadId)
import Plutus.Trace.Tag (Tag)
import Plutus.V1.Ledger.Api (DatumHash, MintingPolicy, StakeValidator, TxOut, Validator)
import Plutus.V2.Ledger.Tx qualified as PV2
import Schema (FormArgumentF, FormSchema)
import Wallet.API (WalletAPIError)
import Wallet.Emulator.Types qualified as EM
import Wallet.Rollup.Types (AnnotatedTx, BeneficialOwner, DereferencedInput, SequenceId, TxKey)
import Wallet.Types (ContractActivityStatus, ContractInstanceId, EndpointDescription, EndpointValue, Notification,
                     NotificationError)

psJson :: PSType
psJson :: PSType
psJson = Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"web-common" Text
"Data.RawJson" Text
"RawJson" []

psNonEmpty :: MonadReader BridgeData m => m PSType
psNonEmpty :: m PSType
psNonEmpty =
    Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"purescript-lists" Text
"Data.List.Types" Text
"NonEmptyList" ([PSType] -> PSType) -> m [PSType] -> m PSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    m [PSType]
forall (m :: * -> *). MonadReader BridgeData m => m [PSType]
psTypeParameters

psSet :: MonadReader BridgeData m => m PSType
psSet :: m PSType
psSet =
    Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"purescript-ordered-collections" Text
"Data.Set" Text
"Set" ([PSType] -> PSType) -> m [PSType] -> m PSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    m [PSType]
forall (m :: * -> *). MonadReader BridgeData m => m [PSType]
psTypeParameters

psUUID :: PSType
psUUID :: PSType
psUUID = Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"web-common" Text
"Data.UUID.Argonaut" Text
"UUID" []

uuidBridge :: BridgePart
uuidBridge :: BridgePart
uuidBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"UUID"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.UUID" BridgeBuilder () -> BridgeBuilder () -> BridgeBuilder ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.UUID.Types.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psUUID

aesonValueBridge :: BridgePart
aesonValueBridge :: BridgePart
aesonValueBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Value"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.Aeson.Types.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

aesonBridge :: BridgePart
aesonBridge :: BridgePart
aesonBridge =
    BridgePart
aesonValueBridge BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
uuidBridge

------------------------------------------------------------
nonEmptyBridge :: BridgePart
nonEmptyBridge :: BridgePart
nonEmptyBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"NonEmpty"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"GHC.Base"
    BridgePart
forall (m :: * -> *). MonadReader BridgeData m => m PSType
psNonEmpty

setBridge :: BridgePart
setBridge :: BridgePart
setBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Set"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.Set.Internal"
    BridgePart
forall (m :: * -> *). MonadReader BridgeData m => m PSType
psSet

containersBridge :: BridgePart
containersBridge :: BridgePart
containersBridge = BridgePart
nonEmptyBridge BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
setBridge

------------------------------------------------------------
psBigInteger :: PSType
psBigInteger :: PSType
psBigInteger = Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"web-common" Text
"Data.BigInt.Argonaut" Text
"BigInt" []

integerBridge :: BridgePart
integerBridge :: BridgePart
integerBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Integer"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psBigInteger

word32Bridge :: BridgePart
word32Bridge :: BridgePart
word32Bridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Word32"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"GHC.Word"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psInt

word64Bridge :: BridgePart
word64Bridge :: BridgePart
word64Bridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Word64"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"GHC.Word"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psBigInteger

digestBridge :: BridgePart
digestBridge :: BridgePart
digestBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Digest"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Crypto.Hash.Types"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

byteStringBridge :: BridgePart
byteStringBridge :: BridgePart
byteStringBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ByteString"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.ByteString.Lazy.Internal" BridgeBuilder () -> BridgeBuilder () -> BridgeBuilder ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.ByteString.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

bultinByteStringBridge :: BridgePart
bultinByteStringBridge :: BridgePart
bultinByteStringBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"BuiltinByteString"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"PlutusTx.Builtins.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

scientificBridge :: BridgePart
scientificBridge :: BridgePart
scientificBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Scientific"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.Scientific"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psNumber

naturalBridge :: BridgePart
naturalBridge :: BridgePart
naturalBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Natural"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"GHC.Natural"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psInt

satIntBridge :: BridgePart
satIntBridge :: BridgePart
satIntBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"SatInt"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.SatInt" BridgeBuilder () -> BridgeBuilder () -> BridgeBuilder ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Ledger.Index"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psInt

exBudgetBridge :: BridgePart
exBudgetBridge :: BridgePart
exBudgetBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ExBudget"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"PlutusCore.Evaluation.Machine.ExBudget"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

identityBridge :: BridgePart
identityBridge :: BridgePart
identityBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Identity"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Data.Functor.Identity"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson


someCardanoApiTxBridge :: BridgePart
someCardanoApiTxBridge :: BridgePart
someCardanoApiTxBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"SomeCardanoApiTx"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Ledger.Tx.CardanoAPI.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

cardanoBuildTxBridge :: BridgePart
cardanoBuildTxBridge :: BridgePart
cardanoBuildTxBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"CardanoBuildTx"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Ledger.Tx.CardanoAPI.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

alonzoEraBridge :: BridgePart
alonzoEraBridge :: BridgePart
alonzoEraBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"AlonzoEra"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Alonzo"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

babbageEraBridge :: BridgePart
babbageEraBridge :: BridgePart
babbageEraBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"BabbageEra"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Babbage"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

babbagePParamsEraBridge :: BridgePart
babbagePParamsEraBridge :: BridgePart
babbagePParamsEraBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"PParams'"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Babbage.PParams"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

standardCryptoBridge :: BridgePart
standardCryptoBridge :: BridgePart
standardCryptoBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"StandardCrypto"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Crypto"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

applyTxErrorBridge :: BridgePart
applyTxErrorBridge :: BridgePart
applyTxErrorBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ApplyTxError"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Shelley.API.Mempool"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

basicFailureBridge :: BridgePart
basicFailureBridge :: BridgePart
basicFailureBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"BasicFailure"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Alonzo.Tools"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

scriptFailureBridge :: BridgePart
scriptFailureBridge :: BridgePart
scriptFailureBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ScriptFailure"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Alonzo.Tools"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

utxosPredicateFailureBridge :: BridgePart
utxosPredicateFailureBridge :: BridgePart
utxosPredicateFailureBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"UtxosPredicateFailure"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Ledger.Alonzo.Rules.Utxos"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

exportTxBridge :: BridgePart
exportTxBridge :: BridgePart
exportTxBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ExportTx"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.Contract.Wallet"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

protocolParametersBridge :: BridgePart
protocolParametersBridge :: BridgePart
protocolParametersBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ProtocolParameters"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Cardano.Api.ProtocolParameters"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psJson

miscBridge :: BridgePart
miscBridge :: BridgePart
miscBridge =
        BridgePart
bultinByteStringBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
byteStringBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
integerBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word32Bridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
word64Bridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
scientificBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
digestBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
naturalBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
satIntBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
exBudgetBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
someCardanoApiTxBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
cardanoBuildTxBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
alonzoEraBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
babbageEraBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
babbagePParamsEraBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
standardCryptoBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
applyTxErrorBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
basicFailureBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
scriptFailureBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
utxosPredicateFailureBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
exportTxBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
protocolParametersBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
identityBridge

------------------------------------------------------------

psAssocMap :: MonadReader BridgeData m => m PSType
psAssocMap :: m PSType
psAssocMap =
    Text -> Text -> Text -> [PSType] -> PSType
forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo Text
"plutus-playground-client" Text
"PlutusTx.AssocMap" Text
"Map" ([PSType] -> PSType) -> m [PSType] -> m PSType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    m [PSType]
forall (m :: * -> *). MonadReader BridgeData m => m [PSType]
psTypeParameters

dataBridge :: BridgePart
dataBridge :: BridgePart
dataBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"BuiltinData"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"PlutusTx.Builtins.Internal"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

assocMapBridge :: BridgePart
assocMapBridge :: BridgePart
assocMapBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Map"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"PlutusTx.AssocMap"
    BridgePart
forall (m :: * -> *). MonadReader BridgeData m => m PSType
psAssocMap

languageBridge :: BridgePart
languageBridge :: BridgePart
languageBridge = BridgePart
dataBridge BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
assocMapBridge

------------------------------------------------------------
scriptHashBridge :: BridgePart
scriptHashBridge :: BridgePart
scriptHashBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ScriptHash"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

scriptBridge :: BridgePart
scriptBridge :: BridgePart
scriptBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Script"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

datumBridge :: BridgePart
datumBridge :: BridgePart
datumBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Datum"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

redeemerHashBridge :: BridgePart
redeemerHashBridge :: BridgePart
redeemerHashBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"RedeemerHash"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

redeemerBridge :: BridgePart
redeemerBridge :: BridgePart
redeemerBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Redeemer"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

validatorHashBridge :: BridgePart
validatorHashBridge :: BridgePart
validatorHashBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"ValidatorHash"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

mpsHashBridge :: BridgePart
mpsHashBridge :: BridgePart
mpsHashBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"MintingPolicyHash"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

stakeValidatorHashBridge :: BridgePart
stakeValidatorHashBridge :: BridgePart
stakeValidatorHashBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"StakeValidatorHash"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Scripts"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

ledgerBytesBridge :: BridgePart
ledgerBytesBridge :: BridgePart
ledgerBytesBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"LedgerBytes"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Plutus.V1.Ledger.Bytes"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

walletIdBridge :: BridgePart
walletIdBridge :: BridgePart
walletIdBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"WalletId"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Wallet.Emulator.Wallet"
    PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
psString

ledgerBridge :: BridgePart
ledgerBridge :: BridgePart
ledgerBridge =
        BridgePart
scriptBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
scriptHashBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
redeemerHashBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
redeemerBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
datumBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
validatorHashBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
mpsHashBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
stakeValidatorHashBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
ledgerBytesBridge
    BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
walletIdBridge

------------------------------------------------------------
headersBridge :: BridgePart
headersBridge :: BridgePart
headersBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Servant.API.ResponseHeaders"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Headers"
    -- Headers should have two parameters, the list of headers and the return type.
    BridgeBuilder [PSType]
forall (m :: * -> *). MonadReader BridgeData m => m [PSType]
psTypeParameters BridgeBuilder [PSType] -> ([PSType] -> BridgePart) -> BridgePart
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [PSType
_, PSType
returnType] -> PSType -> BridgePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSType
returnType
        [PSType]
_               -> BridgePart
forall (f :: * -> *) a. Alternative f => f a
empty

headerBridge :: BridgePart
headerBridge :: BridgePart
headerBridge = do
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeModule (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Servant.API.Header"
    forall (lang :: Language). Lens' (TypeInfo lang) Text
forall (f :: * -> *).
(Contravariant f, Functor f) =>
(Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell)
typeName (forall (f :: * -> *).
 (Contravariant f, Functor f) =>
 (Text -> f Text) -> TypeInfo 'Haskell -> f (TypeInfo 'Haskell))
-> Text -> BridgeBuilder ()
forall a.
Eq a =>
Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder ()
^== Text
"Header'"
    BridgePart
forall (f :: * -> *) a. Alternative f => f a
empty

servantBridge :: BridgePart
servantBridge :: BridgePart
servantBridge = BridgePart
headersBridge BridgePart -> BridgePart -> BridgePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BridgePart
headerBridge

-- TODO: implement a proper SumType, this is a stub to make purescript compile
scriptAnyLangType :: SumType 'Haskell
scriptAnyLangType :: SumType 'Haskell
scriptAnyLangType = TypeInfo 'Haskell
-> [DataConstructor 'Haskell]
-> [Instance 'Haskell]
-> SumType 'Haskell
forall (lang :: Language).
TypeInfo lang
-> [DataConstructor lang] -> [Instance lang] -> SumType lang
SumType (
      TypeInfo :: forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo {
        _typePackage :: Text
_typePackage = Text
"crdn-p-1.33.0-c62ffc00"
      , _typeModule :: Text
_typeModule = Text
"Cardano.Api.Script"
      , _typeName :: Text
_typeName = Text
"ScriptInAnyLang"
      , _typeParameters :: [TypeInfo 'Haskell]
_typeParameters = []
    }
  ) [
      DataConstructor :: forall (lang :: Language).
Text -> DataConstructorArgs lang -> DataConstructor lang
DataConstructor {_sigConstructor :: Text
_sigConstructor = Text
"SimpleScriptLanguageV1", _sigValues :: DataConstructorArgs 'Haskell
_sigValues = DataConstructorArgs 'Haskell
forall (lang :: Language). DataConstructorArgs lang
Nullary}
    , DataConstructor :: forall (lang :: Language).
Text -> DataConstructorArgs lang -> DataConstructor lang
DataConstructor {_sigConstructor :: Text
_sigConstructor = Text
"SimpleScriptLanguageV2", _sigValues :: DataConstructorArgs 'Haskell
_sigValues = DataConstructorArgs 'Haskell
forall (lang :: Language). DataConstructorArgs lang
Nullary}
    , DataConstructor :: forall (lang :: Language).
Text -> DataConstructorArgs lang -> DataConstructor lang
DataConstructor {_sigConstructor :: Text
_sigConstructor = Text
"PlutusScriptLanguageV1", _sigValues :: DataConstructorArgs 'Haskell
_sigValues = DataConstructorArgs 'Haskell
forall (lang :: Language). DataConstructorArgs lang
Nullary}
    , DataConstructor :: forall (lang :: Language).
Text -> DataConstructorArgs lang -> DataConstructor lang
DataConstructor {_sigConstructor :: Text
_sigConstructor = Text
"PlutusScriptLanguageV2", _sigValues :: DataConstructorArgs 'Haskell
_sigValues = DataConstructorArgs 'Haskell
forall (lang :: Language). DataConstructorArgs lang
Nullary}
  ] [Instance 'Haskell
forall (lang :: Language). Instance lang
Eq,Instance 'Haskell
forall (lang :: Language). Instance lang
GenericShow,Instance 'Haskell
forall (lang :: Language). Instance lang
Json,Instance 'Haskell
forall (lang :: Language). Instance lang
Ord,Instance 'Haskell
forall (lang :: Language). Instance lang
Generic]

plutusTxOut :: SumType 'Haskell
plutusTxOut :: SumType 'Haskell
plutusTxOut = SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxOut, Typeable TxOut, GDataConstructor (Rep TxOut)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Plutus.V1.Ledger.Api.TxOut

-- TODO: implement a proper SumType, this is a stub to make purescript compile
cardanoTxOut :: SumType 'Haskell
cardanoTxOut :: SumType 'Haskell
cardanoTxOut = SumType 'Haskell
plutusTxOut
   SumType 'Haskell
-> (SumType 'Haskell -> SumType 'Haskell) -> SumType 'Haskell
forall a b. a -> (a -> b) -> b
& (TypeInfo 'Haskell -> Identity (TypeInfo 'Haskell))
-> SumType 'Haskell -> Identity (SumType 'Haskell)
forall (f :: * -> *) (lang :: Language).
Functor f =>
(TypeInfo lang -> f (TypeInfo lang))
-> SumType lang -> f (SumType lang)
sumTypeInfo ((TypeInfo 'Haskell -> Identity (TypeInfo 'Haskell))
 -> SumType 'Haskell -> Identity (SumType 'Haskell))
-> TypeInfo 'Haskell -> SumType 'Haskell -> SumType 'Haskell
forall s t a b. ASetter s t a b -> b -> s -> t
.~
      TypeInfo :: forall (lang :: Language).
Text -> Text -> Text -> [TypeInfo lang] -> TypeInfo lang
TypeInfo {
        _typePackage :: Text
_typePackage = Text
"crdn-p-1.33.0-c62ffc00"
      , _typeModule :: Text
_typeModule = Text
"Cardano.Api.TxBody"
      , _typeName :: Text
_typeName = Text
"CardanoTxOut"
      , _typeParameters :: [TypeInfo 'Haskell]
_typeParameters = []
    }

txOut :: SumType 'Haskell
txOut :: SumType 'Haskell
txOut =
     SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxOut, Typeable TxOut, GDataConstructor (Rep TxOut)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Ledger.TxOut
       SumType 'Haskell
-> (SumType 'Haskell -> SumType 'Haskell) -> SumType 'Haskell
forall a b. a -> (a -> b) -> b
& ([DataConstructor 'Haskell] -> Identity [DataConstructor 'Haskell])
-> SumType 'Haskell -> Identity (SumType 'Haskell)
forall (f :: * -> *) (lang :: Language).
Functor f =>
([DataConstructor lang] -> f [DataConstructor lang])
-> SumType lang -> f (SumType lang)
sumTypeConstructors (([DataConstructor 'Haskell]
  -> Identity [DataConstructor 'Haskell])
 -> SumType 'Haskell -> Identity (SumType 'Haskell))
-> ((Text -> Identity Text)
    -> [DataConstructor 'Haskell]
    -> Identity [DataConstructor 'Haskell])
-> (Text -> Identity Text)
-> SumType 'Haskell
-> Identity (SumType 'Haskell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [DataConstructor 'Haskell]
-> Traversal'
     [DataConstructor 'Haskell] (IxValue [DataConstructor 'Haskell])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [DataConstructor 'Haskell]
0 ((DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell))
 -> [DataConstructor 'Haskell]
 -> Identity [DataConstructor 'Haskell])
-> ((Text -> Identity Text)
    -> DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell))
-> (Text -> Identity Text)
-> [DataConstructor 'Haskell]
-> Identity [DataConstructor 'Haskell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text)
-> DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell)
forall (lang :: Language). Lens' (DataConstructor lang) Text
sigConstructor ((Text -> Identity Text)
 -> SumType 'Haskell -> Identity (SumType 'Haskell))
-> Text -> SumType 'Haskell -> SumType 'Haskell
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"TxOut"
       SumType 'Haskell
-> (SumType 'Haskell -> SumType 'Haskell) -> SumType 'Haskell
forall a b. a -> (a -> b) -> b
& ([DataConstructor 'Haskell] -> Identity [DataConstructor 'Haskell])
-> SumType 'Haskell -> Identity (SumType 'Haskell)
forall (f :: * -> *) (lang :: Language).
Functor f =>
([DataConstructor lang] -> f [DataConstructor lang])
-> SumType lang -> f (SumType lang)
sumTypeConstructors (([DataConstructor 'Haskell]
  -> Identity [DataConstructor 'Haskell])
 -> SumType 'Haskell -> Identity (SumType 'Haskell))
-> ((DataConstructorArgs 'Haskell
     -> Identity (DataConstructorArgs 'Haskell))
    -> [DataConstructor 'Haskell]
    -> Identity [DataConstructor 'Haskell])
-> (DataConstructorArgs 'Haskell
    -> Identity (DataConstructorArgs 'Haskell))
-> SumType 'Haskell
-> Identity (SumType 'Haskell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [DataConstructor 'Haskell]
-> Traversal'
     [DataConstructor 'Haskell] (IxValue [DataConstructor 'Haskell])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [DataConstructor 'Haskell]
0 ((DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell))
 -> [DataConstructor 'Haskell]
 -> Identity [DataConstructor 'Haskell])
-> ((DataConstructorArgs 'Haskell
     -> Identity (DataConstructorArgs 'Haskell))
    -> DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell))
-> (DataConstructorArgs 'Haskell
    -> Identity (DataConstructorArgs 'Haskell))
-> [DataConstructor 'Haskell]
-> Identity [DataConstructor 'Haskell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataConstructorArgs 'Haskell
 -> Identity (DataConstructorArgs 'Haskell))
-> DataConstructor 'Haskell -> Identity (DataConstructor 'Haskell)
forall (lang1 :: Language) (lang2 :: Language).
Lens
  (DataConstructor lang1)
  (DataConstructor lang2)
  (DataConstructorArgs lang1)
  (DataConstructorArgs lang2)
sigValues ((DataConstructorArgs 'Haskell
  -> Identity (DataConstructorArgs 'Haskell))
 -> SumType 'Haskell -> Identity (SumType 'Haskell))
-> DataConstructorArgs 'Haskell
-> SumType 'Haskell
-> SumType 'Haskell
forall s t a b. ASetter s t a b -> b -> s -> t
.~
           NonEmpty (RecordEntry 'Haskell) -> DataConstructorArgs 'Haskell
forall (lang :: Language).
NonEmpty (RecordEntry lang) -> DataConstructorArgs lang
Record (RecordEntry 'Haskell -> NonEmpty (RecordEntry 'Haskell)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TypeInfo 'Haskell -> RecordEntry 'Haskell
forall (lang :: Language).
Text -> TypeInfo lang -> RecordEntry lang
RecordEntry Text
"getTxOut" (SumType 'Haskell
cardanoTxOut SumType 'Haskell
-> Getting
     (TypeInfo 'Haskell) (SumType 'Haskell) (TypeInfo 'Haskell)
-> TypeInfo 'Haskell
forall s a. s -> Getting a s a -> a
^. Getting (TypeInfo 'Haskell) (SumType 'Haskell) (TypeInfo 'Haskell)
forall (f :: * -> *) (lang :: Language).
Functor f =>
(TypeInfo lang -> f (TypeInfo lang))
-> SumType lang -> f (SumType lang)
sumTypeInfo)))


------------------------------------------------------------
ledgerTypes :: [SumType 'Haskell]
ledgerTypes :: [SumType 'Haskell]
ledgerTypes =
    [ SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Language, Typeable Language,
 GDataConstructor (Rep Language)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Tx.Language
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Versioned A), Typeable (Versioned A),
 GDataConstructor (Rep (Versioned A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Tx.Versioned A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Slot, Typeable Slot, GDataConstructor (Rep Slot)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Slot
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Ada, Typeable Ada, GDataConstructor (Rep Ada)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Ada
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Params, Typeable Params, GDataConstructor (Rep Params)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Params
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic NetworkId, Typeable NetworkId,
 GDataConstructor (Rep NetworkId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @NetworkId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic NetworkMagic, Typeable NetworkMagic,
 GDataConstructor (Rep NetworkMagic)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @NetworkMagic
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Lovelace, Typeable Lovelace,
 GDataConstructor (Rep Lovelace)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Lovelace
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic EpochNo, Typeable EpochNo,
 GDataConstructor (Rep EpochNo)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @EpochNo
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic SlotConfig, Typeable SlotConfig,
 GDataConstructor (Rep SlotConfig)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @SlotConfig
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic SlotConversionError, Typeable SlotConversionError,
 GDataConstructor (Rep SlotConversionError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @SlotConversionError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Certificate, Typeable Certificate,
 GDataConstructor (Rep Certificate)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Certificate
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Tx, Typeable Tx, GDataConstructor (Rep Tx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Tx
    , SumType 'Haskell
plutusTxOut
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic CardanoTx, Typeable CardanoTx,
 GDataConstructor (Rep CardanoTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @CardanoTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxId, Typeable TxId, GDataConstructor (Rep TxId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxIn, Typeable TxIn, GDataConstructor (Rep TxIn)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxIn
    , SumType 'Haskell
txOut
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxOutTx, Typeable TxOutTx,
 GDataConstructor (Rep TxOutTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxOutTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxOutRef, Typeable TxOutRef,
 GDataConstructor (Rep TxOutRef)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxOutRef
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic OnChainTx, Typeable OnChainTx,
 GDataConstructor (Rep OnChainTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @OnChainTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic UtxoIndex, Typeable UtxoIndex,
 GDataConstructor (Rep UtxoIndex)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @UtxoIndex
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Value, Typeable Value, GDataConstructor (Rep Value)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Value
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Withdrawal, Typeable Withdrawal,
 GDataConstructor (Rep Withdrawal)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Withdrawal
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic DatumFromQuery, Typeable DatumFromQuery,
 GDataConstructor (Rep DatumFromQuery)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @DatumFromQuery
    -- v2
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic OutputDatum, Typeable OutputDatum,
 GDataConstructor (Rep OutputDatum)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PV2.OutputDatum
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ReferenceScript, Typeable ReferenceScript,
 GDataConstructor (Rep ReferenceScript)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ReferenceScript
    , SumType 'Haskell
scriptAnyLangType
    , SumType 'Haskell
cardanoTxOut
    -- v2-end
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Extended A), Typeable (Extended A),
 GDataConstructor (Rep (Extended A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Extended A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Interval A), Typeable (Interval A),
 GDataConstructor (Rep (Interval A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Interval A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (LowerBound A), Typeable (LowerBound A),
 GDataConstructor (Rep (LowerBound A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(LowerBound A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (UpperBound A), Typeable (UpperBound A),
 GDataConstructor (Rep (UpperBound A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(UpperBound A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic CurrencySymbol, Typeable CurrencySymbol,
 GDataConstructor (Rep CurrencySymbol)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @CurrencySymbol
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic AssetClass, Typeable AssetClass,
 GDataConstructor (Rep AssetClass)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @AssetClass
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic MintingPolicy, Typeable MintingPolicy,
 GDataConstructor (Rep MintingPolicy)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @MintingPolicy
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic StakeValidator, Typeable StakeValidator,
 GDataConstructor (Rep StakeValidator)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @StakeValidator
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic RedeemerPtr, Typeable RedeemerPtr,
 GDataConstructor (Rep RedeemerPtr)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @RedeemerPtr
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ScriptTag, Typeable ScriptTag,
 GDataConstructor (Rep ScriptTag)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ScriptTag
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Signature, Typeable Signature,
 GDataConstructor (Rep Signature)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Signature
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TokenName, Typeable TokenName,
 GDataConstructor (Rep TokenName)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TokenName
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxInType, Typeable TxInType,
 GDataConstructor (Rep TxInType)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxInType
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxInputType, Typeable TxInputType,
 GDataConstructor (Rep TxInputType)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxInputType
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxInput, Typeable TxInput,
 GDataConstructor (Rep TxInput)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxInput
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Validator, Typeable Validator,
 GDataConstructor (Rep Validator)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Validator
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ScriptError, Typeable ScriptError,
 GDataConstructor (Rep ScriptError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ScriptError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ValidationError, Typeable ValidationError,
 GDataConstructor (Rep ValidationError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ValidationError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ValidationPhase, Typeable ValidationPhase,
 GDataConstructor (Rep ValidationPhase)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ValidationPhase
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Address, Typeable Address,
 GDataConstructor (Rep Address)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Address
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BlockId, Typeable BlockId,
 GDataConstructor (Rep BlockId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BlockId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic DatumHash, Typeable DatumHash,
 GDataConstructor (Rep DatumHash)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @DatumHash
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PubKey, Typeable PubKey, GDataConstructor (Rep PubKey)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PubKey
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PubKeyHash, Typeable PubKeyHash,
 GDataConstructor (Rep PubKeyHash)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PubKeyHash
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PaymentPubKey, Typeable PaymentPubKey,
 GDataConstructor (Rep PaymentPubKey)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PaymentPubKey
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PaymentPubKeyHash, Typeable PaymentPubKeyHash,
 GDataConstructor (Rep PaymentPubKeyHash)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PaymentPubKeyHash
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic StakePubKey, Typeable StakePubKey,
 GDataConstructor (Rep StakePubKey)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @StakePubKey
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic StakePubKeyHash, Typeable StakePubKeyHash,
 GDataConstructor (Rep StakePubKeyHash)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @StakePubKeyHash
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Credential, Typeable Credential,
 GDataConstructor (Rep Credential)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Credential
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic StakingCredential, Typeable StakingCredential,
 GDataConstructor (Rep StakingCredential)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @StakingCredential
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic DCert, Typeable DCert, GDataConstructor (Rep DCert)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @DCert
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic MkTxError, Typeable MkTxError,
 GDataConstructor (Rep MkTxError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @MkTxError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractError, Typeable ContractError,
 GDataConstructor (Rep ContractError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ConnectionError, Typeable ConnectionError,
 GDataConstructor (Rep ConnectionError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ConnectionError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic WrongOutTypeError, Typeable WrongOutTypeError,
 GDataConstructor (Rep WrongOutTypeError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @WrongOutTypeError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Notification, Typeable Notification,
 GDataConstructor (Rep Notification)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Notification
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic NotificationError, Typeable NotificationError,
 GDataConstructor (Rep NotificationError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @NotificationError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic MatchingError, Typeable MatchingError,
 GDataConstructor (Rep MatchingError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @MatchingError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic AssertionError, Typeable AssertionError,
 GDataConstructor (Rep AssertionError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @AssertionError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic CheckpointError, Typeable CheckpointError,
 GDataConstructor (Rep CheckpointError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @CheckpointError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractInstanceId, Typeable ContractInstanceId,
 GDataConstructor (Rep ContractInstanceId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractInstanceId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractActivityStatus, Typeable ContractActivityStatus,
 GDataConstructor (Rep ContractActivityStatus)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractActivityStatus
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractInstanceLog, Typeable ContractInstanceLog,
 GDataConstructor (Rep ContractInstanceLog)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractInstanceLog
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic UserThreadMsg, Typeable UserThreadMsg,
 GDataConstructor (Rep UserThreadMsg)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @UserThreadMsg
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic SchedulerLog, Typeable SchedulerLog,
 GDataConstructor (Rep SchedulerLog)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @SchedulerLog
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Tag, Typeable Tag, GDataConstructor (Rep Tag)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Tag
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractInstanceMsg, Typeable ContractInstanceMsg,
 GDataConstructor (Rep ContractInstanceMsg)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractInstanceMsg
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ContractInstanceTag, Typeable ContractInstanceTag,
 GDataConstructor (Rep ContractInstanceTag)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ContractInstanceTag
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic EmulatorRuntimeError, Typeable EmulatorRuntimeError,
 GDataConstructor (Rep EmulatorRuntimeError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @EmulatorRuntimeError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ThreadEvent, Typeable ThreadEvent,
 GDataConstructor (Rep ThreadEvent)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ThreadEvent
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ThreadId, Typeable ThreadId,
 GDataConstructor (Rep ThreadId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ThreadId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Request A), Typeable (Request A),
 GDataConstructor (Rep (Request A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Request A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Response A), Typeable (Response A),
 GDataConstructor (Rep (Response A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Response A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic RequestID, Typeable RequestID,
 GDataConstructor (Rep RequestID)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @RequestID
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Priority, Typeable Priority,
 GDataConstructor (Rep Priority)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Priority
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic IterationID, Typeable IterationID,
 GDataConstructor (Rep IterationID)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @IterationID
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ExCPU, Typeable ExCPU, GDataConstructor (Rep ExCPU)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ExCPU
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ExMemory, Typeable ExMemory,
 GDataConstructor (Rep ExMemory)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ExMemory
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PABReq, Typeable PABReq, GDataConstructor (Rep PABReq)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PABReq
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PABResp, Typeable PABResp,
 GDataConstructor (Rep PABResp)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PABResp
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexQuery, Typeable ChainIndexQuery,
 GDataConstructor (Rep ChainIndexQuery)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexQuery
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexResponse, Typeable ChainIndexResponse,
 GDataConstructor (Rep ChainIndexResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic IsUtxoResponse, Typeable IsUtxoResponse,
 GDataConstructor (Rep IsUtxoResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @IsUtxoResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (QueryResponse A), Typeable (QueryResponse A),
 GDataConstructor (Rep (QueryResponse A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(QueryResponse A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxosResponse, Typeable TxosResponse,
 GDataConstructor (Rep TxosResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxosResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic UtxosResponse, Typeable UtxosResponse,
 GDataConstructor (Rep UtxosResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @UtxosResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexTx, Typeable ChainIndexTx,
 GDataConstructor (Rep ChainIndexTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexTxOut, Typeable ChainIndexTxOut,
 GDataConstructor (Rep ChainIndexTxOut)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndex.ChainIndexTxOut
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexTxOutputs, Typeable ChainIndexTxOutputs,
 GDataConstructor (Rep ChainIndexTxOutputs)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexTxOutputs
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic DecoratedTxOut, Typeable DecoratedTxOut,
 GDataConstructor (Rep DecoratedTxOut)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @DecoratedTxOut
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexLog, Typeable ChainIndexLog,
 GDataConstructor (Rep ChainIndexLog)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexLog
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ChainIndexError, Typeable ChainIndexError,
 GDataConstructor (Rep ChainIndexError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ChainIndexError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BeamError, Typeable BeamError,
 GDataConstructor (Rep BeamError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BeamError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BeamLog, Typeable BeamLog,
 GDataConstructor (Rep BeamLog)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BeamLog
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic InsertUtxoPosition, Typeable InsertUtxoPosition,
 GDataConstructor (Rep InsertUtxoPosition)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @InsertUtxoPosition
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic InsertUtxoFailed, Typeable InsertUtxoFailed,
 GDataConstructor (Rep InsertUtxoFailed)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @InsertUtxoFailed
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic RollbackFailed, Typeable RollbackFailed,
 GDataConstructor (Rep RollbackFailed)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @RollbackFailed
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic FromCardanoError, Typeable FromCardanoError,
 GDataConstructor (Rep FromCardanoError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @FromCardanoError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (Page A), Typeable (Page A),
 GDataConstructor (Rep (Page A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(Page A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (PageQuery A), Typeable (PageQuery A),
 GDataConstructor (Rep (PageQuery A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(PageQuery A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic PageSize, Typeable PageSize,
 GDataConstructor (Rep PageSize)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @PageSize
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Tip, Typeable Tip, GDataConstructor (Rep Tip)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Tip
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Point, Typeable Point, GDataConstructor (Rep Point)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Point
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (EndpointValue A), Typeable (EndpointValue A),
 GDataConstructor (Rep (EndpointValue A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(EndpointValue A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BalanceTxResponse, Typeable BalanceTxResponse,
 GDataConstructor (Rep BalanceTxResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BalanceTxResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic WriteBalancedTxResponse, Typeable WriteBalancedTxResponse,
 GDataConstructor (Rep WriteBalancedTxResponse)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @WriteBalancedTxResponse
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ActiveEndpoint, Typeable ActiveEndpoint,
 GDataConstructor (Rep ActiveEndpoint)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ActiveEndpoint
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic UnbalancedTx, Typeable UnbalancedTx,
 GDataConstructor (Rep UnbalancedTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @UnbalancedTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxValidity, Typeable TxValidity,
 GDataConstructor (Rep TxValidity)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxValidity
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxOutState, Typeable TxOutState,
 GDataConstructor (Rep TxOutState)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxOutState
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (RollbackState A), Typeable (RollbackState A),
 GDataConstructor (Rep (RollbackState A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(RollbackState A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BlockNumber, Typeable BlockNumber,
 GDataConstructor (Rep BlockNumber)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BlockNumber
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Depth, Typeable Depth, GDataConstructor (Rep Depth)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Depth
    ]

walletTypes :: [SumType 'Haskell]
walletTypes :: [SumType 'Haskell]
walletTypes =
    [ SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic AnnotatedTx, Typeable AnnotatedTx,
 GDataConstructor (Rep AnnotatedTx)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @AnnotatedTx
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic DereferencedInput, Typeable DereferencedInput,
 GDataConstructor (Rep DereferencedInput)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @DereferencedInput
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Wallet, Typeable Wallet, GDataConstructor (Rep Wallet)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @EM.Wallet
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic WalletNumber, Typeable WalletNumber,
 GDataConstructor (Rep WalletNumber)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @EM.WalletNumber
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic WalletAPIError, Typeable WalletAPIError,
 GDataConstructor (Rep WalletAPIError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @WalletAPIError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic ToCardanoError, Typeable ToCardanoError,
 GDataConstructor (Rep ToCardanoError)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @ToCardanoError
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic BeneficialOwner, Typeable BeneficialOwner,
 GDataConstructor (Rep BeneficialOwner)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @BeneficialOwner
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic SequenceId, Typeable SequenceId,
 GDataConstructor (Rep SequenceId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @SequenceId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic TxKey, Typeable TxKey, GDataConstructor (Rep TxKey)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @TxKey
    ]

------------------------------------------------------------
playgroundTypes :: [SumType 'Haskell]
playgroundTypes :: [SumType 'Haskell]
playgroundTypes =
    [ SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic FormSchema, Typeable FormSchema,
 GDataConstructor (Rep FormSchema)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @FormSchema
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (FunctionSchema A), Typeable (FunctionSchema A),
 GDataConstructor (Rep (FunctionSchema A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(FunctionSchema A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
functor (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal1 (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (FormArgumentF A), Typeable (FormArgumentF A),
 GDataConstructor (Rep (FormArgumentF A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(FormArgumentF A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic EndpointDescription, Typeable EndpointDescription,
 GDataConstructor (Rep EndpointDescription)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @EndpointDescription
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic KnownCurrency, Typeable KnownCurrency,
 GDataConstructor (Rep KnownCurrency)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @KnownCurrency
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic (ContractCall A), Typeable (ContractCall A),
 GDataConstructor (Rep (ContractCall A))) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @(ContractCall A)
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic GistId, Typeable GistId, GDataConstructor (Rep GistId)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @GistId
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Gist, Typeable Gist, GDataConstructor (Rep Gist)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Gist
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic GistFile, Typeable GistFile,
 GDataConstructor (Rep GistFile)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @GistFile
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic NewGist, Typeable NewGist,
 GDataConstructor (Rep NewGist)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @NewGist
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic NewGistFile, Typeable NewGistFile,
 GDataConstructor (Rep NewGistFile)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @NewGistFile
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic Owner, Typeable Owner, GDataConstructor (Rep Owner)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @Owner
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic AuthStatus, Typeable AuthStatus,
 GDataConstructor (Rep AuthStatus)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @AuthStatus
    , SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
order (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
equal (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
genericShow (SumType 'Haskell -> SumType 'Haskell)
-> (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell
-> SumType 'Haskell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumType 'Haskell -> SumType 'Haskell
forall (t :: Language). SumType t -> SumType t
argonaut (SumType 'Haskell -> SumType 'Haskell)
-> SumType 'Haskell -> SumType 'Haskell
forall a b. (a -> b) -> a -> b
$ (Generic AuthRole, Typeable AuthRole,
 GDataConstructor (Rep AuthRole)) =>
SumType 'Haskell
forall t.
(Generic t, Typeable t, GDataConstructor (Rep t)) =>
SumType 'Haskell
mkSumType @AuthRole
    ]