Merge pull request #287 from input-output-hk/mgalazyn/feature/paramet…

…ereize-anyeraineon Parameterize `AnyEraInEon`. Add `AnyEon`
IntersectMBO · Sep 30, 2023 · 7d3cab6 · 7d3cab6
2 parents 904e04f + 9e4560b
commit 7d3cab6
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 7 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs
@@ -22,12 +22,14 @@ module Cardano.Api.Eras
 
     -- * IsEon
   , Eon(..)
+  , AnyEon(..)
   , AnyEraInEon(..)
 
   , inEonForEraMaybe
   , forEraInEon
   , forEraInEonMaybe
   , forEraMaybeEon
+  , maybeEon
 
     -- * Data family instances
   , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra)

diff --git a/cardano-api/internal/Cardano/Api/Eras/Core.hs b/cardano-api/internal/Cardano/Api/Eras/Core.hs
@@ -30,11 +30,13 @@ module Cardano.Api.Eras.Core
 
     -- * IsEon
   , Eon(..)
+  , AnyEon(..)
   , AnyEraInEon(..)
   , inEonForEraMaybe
   , forEraInEon
   , forEraInEonMaybe
   , forEraMaybeEon
+  , maybeEon
 
     -- * Data family instances
   , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra)
@@ -46,8 +48,10 @@ import qualified Cardano.Ledger.Api as L
 
 import           Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
 import           Data.Kind
+import           Data.Maybe (isJust)
 import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
+import           Data.Typeable (Typeable, showsTypeRep, typeOf)
 
 -- ----------------------------------------------------------------------------
 -- Eras
@@ -149,14 +153,47 @@ forEraMaybeEon :: ()
 forEraMaybeEon =
   inEonForEra Nothing Just
 
+maybeEon :: ()
+  => Eon eon
+  => IsCardanoEra era   -- ^ Era to check
+  => Maybe (eon era)    -- ^ The eon if supported in the era
+maybeEon =
+  inEonForEra Nothing Just cardanoEra
+
 -- ----------------------------------------------------------------------------
--- AnyEraInEon
+-- Era and eon existential types
 
-data AnyEraInEon where
+data AnyEraInEon eon where
   AnyEraInEon
-    :: Eon eon
+    :: ( Typeable era
+       , Typeable (eon era)
+       , Eon eon )
+    => eon era
+    -> AnyEraInEon eon
+
+-- | Assumes that eons are singletons
+instance Show (AnyEraInEon eon) where
+  showsPrec _ (AnyEraInEon eonEra) = showsTypeRep (typeOf eonEra)
+
+-- | Assumes that eons are singletons
+instance TestEquality eon => Eq (AnyEraInEon eon) where
+  AnyEraInEon era1 == AnyEraInEon era2 =
+    isJust $ testEquality era1 era2
+
+data AnyEon where
+  AnyEon
+    :: ( Typeable era
+       , Typeable (eon era)
+       , ToCardanoEra eon
+       , IsCardanoEra era
+       , Eon eon )
     => eon era
-    -> AnyEraInEon
+    -> AnyEon
+
+-- | Assumes that eons are singletons
+instance Show AnyEon where
+  showsPrec _ (AnyEon eonEra) = showsTypeRep (typeOf eonEra)
+
 
 -- ----------------------------------------------------------------------------
 -- ToCardanoEra
@@ -254,11 +291,10 @@ data AnyCardanoEra where
 
 deriving instance Show AnyCardanoEra
 
+-- | Assumes that 'CardanoEra era' are singletons
 instance Eq AnyCardanoEra where
     AnyCardanoEra era == AnyCardanoEra era' =
-      case testEquality era era' of
-        Nothing   -> False
-        Just Refl -> True -- since no constructors share types
+      isJust $ testEquality era era'
 
 instance Bounded AnyCardanoEra where
    minBound = AnyCardanoEra ByronEra

diff --git a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs
@@ -58,10 +58,18 @@ module Cardano.Api.ReexposeLedger
   , Vote (..)
   , Voter (..)
   , VotingProcedure(..)
+  , PoolVotingThresholds(..)
+  , DRepVotingThresholds(..)
+  , dvtPPNetworkGroupL
+  , dvtPPGovGroupL
+  , dvtPPTechnicalGroupL
+  , dvtPPEconomicGroupL
+  , dvtUpdateToConstitutionL
   , drepExpiryL
   , drepAnchorL
   , drepDepositL
   , csCommitteeCredsL
+
   -- Babbage
   , CoinPerByte (..)
 
@@ -107,6 +115,9 @@ import           Cardano.Ledger.BaseTypes (DnsName, Network (..), StrictMaybe (.
                    textToDns, textToUrl, unboundRational, urlToText)
 import           Cardano.Ledger.CertState (csCommitteeCredsL)
 import           Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin)
+import           Cardano.Ledger.Conway.Core (DRepVotingThresholds (..), PoolVotingThresholds (..),
+                   dvtPPEconomicGroupL, dvtPPGovGroupL, dvtPPNetworkGroupL, dvtPPTechnicalGroupL,
+                   dvtUpdateToConstitutionL)
 import           Cardano.Ledger.Conway.Governance (GovActionId (..), GovState, Vote (..),
                    Voter (..), VotingProcedure (..))
 import           Cardano.Ledger.Conway.TxCert (ConwayDelegCert (..), ConwayEraTxCert (..),

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -29,12 +29,14 @@ module Cardano.Api (
 
     -- * Eon support
     Eon(..),
+    AnyEon(..),
     AnyEraInEon(..),
 
     inEonForEraMaybe,
     forEraInEon,
     forEraInEonMaybe,
     forEraMaybeEon,
+    maybeEon,
 
     inEonForShelleyBasedEra,
     inEonForShelleyBasedEraMaybe,