New functions anyShelleyBasedEra, inAnyCardanoEra and inAnyShelleyBas…

…edEra
IntersectMBO · Oct 18, 2023 · d1d6341 · d1d6341
1 parent 99f27e8
commit d1d6341
Show file tree

Hide file tree

Showing 5 changed files with 38 additions and 13 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs
@@ -96,7 +96,7 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
     & onNothing (left ByronEraNotSupported)
 
   qeInMode <- pure (toEraInMode era CardanoMode)
-    & onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (cardanoEraConstraints era $ AnyCardanoEra era)))
+    & onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era)))
 
   let stakeCreds = Set.fromList $ mapMaybe filterUnRegCreds certs
       drepCreds  = Set.fromList $ mapMaybe filterUnRegDRepCreds certs
@@ -175,9 +175,7 @@ executeQueryAnyMode era localNodeConnInfo q = runExceptT $ do
   let cMode = consensusModeOnly $ localConsensusModeParams localNodeConnInfo
 
   eraInMode <- pure (toEraInMode era cMode)
-    & onNothing (left $ EraConsensusModeMismatch
-        (AnyConsensusMode CardanoMode)
-        (cardanoEraConstraints era $ AnyCardanoEra era))
+    & onNothing (left $ EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era))
 
   case eraInMode of
     ByronEraInByronMode -> left ByronEraNotSupported

diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs
@@ -14,7 +14,9 @@ module Cardano.Api.Eon.ShelleyBasedEra
     ShelleyBasedEra(..)
   , IsShelleyBasedEra(..)
   , AnyShelleyBasedEra(..)
+  , anyShelleyBasedEra
   , InAnyShelleyBasedEra(..)
+  , inAnyShelleyBasedEra
   , shelleyBasedToCardanoEra
   , inEonForShelleyBasedEra
   , inEonForShelleyBasedEraMaybe
@@ -281,6 +283,11 @@ instance FromJSON AnyShelleyBasedEra where
         "Conway" -> pure $ AnyShelleyBasedEra ShelleyBasedEraConway
         wrong -> fail $ "Failed to parse unknown shelley-based era: " <> Text.unpack wrong
 
+anyShelleyBasedEra :: ()
+  => ShelleyBasedEra era
+  -> AnyShelleyBasedEra
+anyShelleyBasedEra sbe =
+  shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe
 
 -- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that
 -- tells us what era it is, but hides the era type. This is useful when the era
@@ -292,6 +299,12 @@ data InAnyShelleyBasedEra thing where
                           -> thing era
                           -> InAnyShelleyBasedEra thing
 
+inAnyShelleyBasedEra :: ()
+  => ShelleyBasedEra era
+  -> thing era
+  -> InAnyShelleyBasedEra thing
+inAnyShelleyBasedEra sbe a =
+  shelleyBasedEraConstraints sbe $ InAnyShelleyBasedEra sbe a
 
 -- | Converts a 'ShelleyBasedEra' to the broader 'CardanoEra'.
 shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era

diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs
@@ -15,8 +15,9 @@ module Cardano.Api.Eras
   , IsCardanoEra(..)
   , AnyCardanoEra(..)
   , anyCardanoEra
-  , cardanoEraConstraints
   , InAnyCardanoEra(..)
+  , inAnyCardanoEra
+  , cardanoEraConstraints
   , CardanoLedgerEra
   , ToCardanoEra(..)
 

diff --git a/cardano-api/internal/Cardano/Api/Eras/Core.hs b/cardano-api/internal/Cardano/Api/Eras/Core.hs
@@ -26,6 +26,7 @@ module Cardano.Api.Eras.Core
   , AnyCardanoEra(..)
   , anyCardanoEra
   , InAnyCardanoEra(..)
+  , inAnyCardanoEra
   , CardanoLedgerEra
   , ToCardanoEra(..)
 
@@ -292,9 +293,10 @@ cardanoEraConstraints = \case
   ConwayEra  -> id
 
 data AnyCardanoEra where
-     AnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
-                   => CardanoEra era    -- and explicit value.
-                   -> AnyCardanoEra
+  AnyCardanoEra
+    :: IsCardanoEra era
+    => CardanoEra era
+    -> AnyCardanoEra
 
 deriving instance Show AnyCardanoEra
 
@@ -368,10 +370,18 @@ anyCardanoEra = \case
 -- not statically known, for example when deserialising from a file.
 --
 data InAnyCardanoEra thing where
-     InAnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
-                     => CardanoEra era    -- and explicit value.
-                     -> thing era
-                     -> InAnyCardanoEra thing
+  InAnyCardanoEra
+    :: IsCardanoEra era
+    => CardanoEra era
+    -> thing era
+    -> InAnyCardanoEra thing
+
+inAnyCardanoEra :: ()
+  => CardanoEra era
+  -> thing era
+  -> InAnyCardanoEra thing
+inAnyCardanoEra era a =
+  cardanoEraConstraints era $ InAnyCardanoEra era a
 
 -- ----------------------------------------------------------------------------
 -- Conversion to ledger library types

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -23,8 +23,9 @@ module Cardano.Api (
     IsCardanoEra(..),
     AnyCardanoEra(..),
     anyCardanoEra,
-    cardanoEraConstraints,
     InAnyCardanoEra(..),
+    inAnyCardanoEra,
+    cardanoEraConstraints,
     ToCardanoEra(..),
 
     -- * Eon support
@@ -101,7 +102,9 @@ module Cardano.Api (
     ShelleyBasedEra(..),
     IsShelleyBasedEra(..),
     AnyShelleyBasedEra(..),
+    anyShelleyBasedEra,
     InAnyShelleyBasedEra(..),
+    inAnyShelleyBasedEra,
     CardanoEraStyle(..),
     cardanoEraStyle,
     shelleyBasedToCardanoEra,