-
Notifications
You must be signed in to change notification settings - Fork 25
Improved feature ergonomics #128
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Merged
+225
−126
Merged
Changes from all commits
Commits
Show all changes
4 commits
Select commit
Hold shift + click to select a range
d0a554e
Move ShelleyToBabbageEra and ConwayEraOnwards to their own module
newhoggy 128dad5
Move FeatureInEra to Cardano.Api.Eras module
newhoggy 24e6df1
Improved feature ergonomics
newhoggy 3ef0c97
New shelleyToBabbageEraToCardanoEra and cardanoEraOnwardsToCardanoEra…
newhoggy File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,98 +1,46 @@ | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE KindSignatures #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE StandaloneDeriving #-} | ||
|
|
||
| {-# OPTIONS_GHC -Wno-deprecations #-} | ||
|
|
||
| module Cardano.Api.Feature | ||
| ( FeatureValue (..) | ||
| , FeatureInEra(..) | ||
| , featureInShelleyBasedEra | ||
| , valueOrDefault | ||
| , asFeatureValue | ||
| , asFeatureValueInShelleyBasedEra | ||
| , isFeatureValue | ||
| ( Featured (..) | ||
| , asFeaturedInEra | ||
| , asFeaturedInShelleyBasedEra | ||
| ) where | ||
|
|
||
| import Cardano.Api.Eras | ||
|
|
||
| import Data.Kind | ||
|
|
||
| -- | A class for features that are supported in some eras but not others. | ||
| class FeatureInEra (feature :: Type -> Type) where | ||
| -- | Determine the value to use for a feature in a given 'CardanoEra'. | ||
| -- Note that the negative case is the first argument, and the positive case is the second as per | ||
| -- the 'either' function convention. | ||
| featureInEra :: () | ||
| => a -- ^ Value to use if the feature is not supported in the era | ||
| -> (feature era -> a) -- ^ Function to get thealue to use if the feature is supported in the era | ||
| -> CardanoEra era -- ^ Era to check | ||
| -> a -- ^ The value to use | ||
|
|
||
| instance FeatureInEra ShelleyBasedEra where | ||
| featureInEra no yes = \case | ||
| ByronEra -> no | ||
| ShelleyEra -> yes ShelleyBasedEraShelley | ||
| AllegraEra -> yes ShelleyBasedEraAllegra | ||
| MaryEra -> yes ShelleyBasedEraMary | ||
| AlonzoEra -> yes ShelleyBasedEraAlonzo | ||
| BabbageEra -> yes ShelleyBasedEraBabbage | ||
| ConwayEra -> yes ShelleyBasedEraConway | ||
|
|
||
| -- | Determine the value to use for a feature in a given 'ShelleyBasedEra'. | ||
| featureInShelleyBasedEra :: () | ||
| => FeatureInEra feature | ||
| => a | ||
| -> (feature era -> a) | ||
| -> ShelleyBasedEra era | ||
| -> a | ||
| featureInShelleyBasedEra no yes = featureInEra no yes . shelleyBasedToCardanoEra | ||
|
|
||
| -- | A value of type @'FeatureValue' feature era a@ is either: | ||
| data FeatureValue feature era a where | ||
| -- | A value is available for this feature in this era | ||
| FeatureValue | ||
| -- | A value only if the feature is supported in this era | ||
| data Featured feature era a where | ||
| Featured | ||
| :: feature era | ||
| -- ^ The witness that the feature is supported in this era | ||
| -> a | ||
| -- ^ The value to use | ||
| -> FeatureValue feature era a | ||
|
|
||
| -- | No value is available for this feature in this era | ||
| NoFeatureValue | ||
| :: FeatureValue feature era a | ||
|
|
||
| deriving instance (Eq a, Eq (feature era)) => Eq (FeatureValue feature era a) | ||
| deriving instance (Show a, Show (feature era)) => Show (FeatureValue feature era a) | ||
| -> Featured feature era a | ||
|
|
||
| -- | Determine if a value is defined. | ||
| -- | ||
| -- If the value is not defined, it could be because the feature is not supported or | ||
| -- because the feature is supported but the value is not available. | ||
| isFeatureValue :: FeatureValue feature era a -> Bool | ||
| isFeatureValue = \case | ||
| NoFeatureValue -> False | ||
| FeatureValue _ _ -> True | ||
| deriving instance (Eq a, Eq (feature era)) => Eq (Featured feature era a) | ||
| deriving instance (Show a, Show (feature era)) => Show (Featured feature era a) | ||
|
|
||
| -- | Get the value if it is defined, otherwise return the default value. | ||
| valueOrDefault :: a -> FeatureValue feature era a -> a | ||
| valueOrDefault defaultValue = \case | ||
| NoFeatureValue -> defaultValue | ||
| FeatureValue _ a -> a | ||
| instance Functor (Featured feature era) where | ||
| fmap f (Featured feature a) = Featured feature (f a) | ||
|
|
||
| -- | Attempt to construct a 'FeatureValue' from a value and era. | ||
| -- If the feature is not supported in the era, then 'NoFeatureValue' is returned. | ||
| asFeatureValue :: () | ||
| asFeaturedInEra :: () | ||
| => FeatureInEra feature | ||
| => a | ||
| -> CardanoEra era | ||
| -> FeatureValue feature era a | ||
| asFeatureValue value = featureInEra NoFeatureValue (`FeatureValue` value) | ||
| -> Maybe (Featured feature era a) | ||
| asFeaturedInEra value = featureInEra Nothing (Just . flip Featured value) | ||
|
|
||
| -- | Attempt to construct a 'FeatureValue' from a value and a shelley-based-era. | ||
| asFeatureValueInShelleyBasedEra :: () | ||
| asFeaturedInShelleyBasedEra :: () | ||
| => FeatureInEra feature | ||
| => a | ||
| -> ShelleyBasedEra era | ||
| -> FeatureValue feature era a | ||
| asFeatureValueInShelleyBasedEra value = asFeatureValue value . shelleyBasedToCardanoEra | ||
| -> Maybe (Featured feature era a) | ||
| asFeaturedInShelleyBasedEra value = asFeaturedInEra value . shelleyBasedToCardanoEra | ||
56 changes: 56 additions & 0 deletions
56
cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,56 @@ | ||
| {-# LANGUAGE ConstraintKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE StandaloneDeriving #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE TypeOperators #-} | ||
|
|
||
| module Cardano.Api.Feature.ConwayEraOnwards | ||
| ( ConwayEraOnwards(..) | ||
| , conwayEraOnwardsConstraints | ||
| , conwayEraOnwardsToCardanoEra | ||
| , conwayEraOnwardsToShelleyBasedEra | ||
| ) where | ||
|
|
||
| import Cardano.Api.Eras | ||
|
|
||
| import Cardano.Crypto.Hash.Class (HashAlgorithm) | ||
| import qualified Cardano.Ledger.Api as L | ||
|
|
||
| data ConwayEraOnwards era where | ||
| ConwayEraOnwardsConway :: ConwayEraOnwards ConwayEra | ||
|
|
||
| deriving instance Show (ConwayEraOnwards era) | ||
| deriving instance Eq (ConwayEraOnwards era) | ||
|
|
||
| instance FeatureInEra ConwayEraOnwards where | ||
| featureInEra no yes = \case | ||
| ByronEra -> no | ||
| ShelleyEra -> no | ||
| AllegraEra -> no | ||
| MaryEra -> no | ||
| AlonzoEra -> no | ||
| BabbageEra -> no | ||
| ConwayEra -> yes ConwayEraOnwardsConway | ||
|
|
||
| type ConwayEraOnwardsConstraints era = | ||
| ( L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto | ||
| , HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) | ||
| , L.ConwayEraTxBody (ShelleyLedgerEra era) | ||
| ) | ||
|
|
||
| conwayEraOnwardsConstraints | ||
| :: ConwayEraOnwards era | ||
| -> (ConwayEraOnwardsConstraints era => a) | ||
| -> a | ||
| conwayEraOnwardsConstraints = \case | ||
| ConwayEraOnwardsConway -> id | ||
|
|
||
| conwayEraOnwardsToCardanoEra :: ConwayEraOnwards era -> CardanoEra era | ||
| conwayEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . conwayEraOnwardsToShelleyBasedEra | ||
|
|
||
| conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era | ||
| conwayEraOnwardsToShelleyBasedEra = \case | ||
| ConwayEraOnwardsConway -> ShelleyBasedEraConway |
67 changes: 67 additions & 0 deletions
67
cardano-api/internal/Cardano/Api/Feature/ShelleyToBabbageEra.hs
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,67 @@ | ||
| {-# LANGUAGE ConstraintKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE StandaloneDeriving #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE TypeOperators #-} | ||
|
|
||
| module Cardano.Api.Feature.ShelleyToBabbageEra | ||
| ( ShelleyToBabbageEra(..) | ||
| , shelleyToBabbageEraConstraints | ||
| , shelleyToBabbageEraToCardanoEra | ||
| , shelleyToBabbageEraToShelleyBasedEra | ||
| ) where | ||
|
|
||
| import Cardano.Api.Eras | ||
|
|
||
| import Cardano.Crypto.Hash.Class (HashAlgorithm) | ||
| import qualified Cardano.Ledger.Api as L | ||
|
|
||
| data ShelleyToBabbageEra era where | ||
| ShelleyToBabbageEraShelley :: ShelleyToBabbageEra ShelleyEra | ||
| ShelleyToBabbageEraAllegra :: ShelleyToBabbageEra AllegraEra | ||
| ShelleyToBabbageEraMary :: ShelleyToBabbageEra MaryEra | ||
| ShelleyToBabbageEraAlonzo :: ShelleyToBabbageEra AlonzoEra | ||
| ShelleyToBabbageEraBabbage :: ShelleyToBabbageEra BabbageEra | ||
|
|
||
| deriving instance Show (ShelleyToBabbageEra era) | ||
| deriving instance Eq (ShelleyToBabbageEra era) | ||
|
|
||
| instance FeatureInEra ShelleyToBabbageEra where | ||
| featureInEra no yes = \case | ||
| ByronEra -> no | ||
| ShelleyEra -> yes ShelleyToBabbageEraShelley | ||
| AllegraEra -> yes ShelleyToBabbageEraAllegra | ||
| MaryEra -> yes ShelleyToBabbageEraMary | ||
| AlonzoEra -> yes ShelleyToBabbageEraAlonzo | ||
| BabbageEra -> yes ShelleyToBabbageEraBabbage | ||
| ConwayEra -> no | ||
|
|
||
| type ShelleyToBabbageEraConstraints era = | ||
| ( L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto | ||
| , HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) | ||
| ) | ||
|
|
||
| shelleyToBabbageEraConstraints | ||
| :: ShelleyToBabbageEra era | ||
| -> (ShelleyToBabbageEraConstraints era => a) | ||
| -> a | ||
| shelleyToBabbageEraConstraints = \case | ||
| ShelleyToBabbageEraShelley -> id | ||
| ShelleyToBabbageEraAllegra -> id | ||
| ShelleyToBabbageEraMary -> id | ||
| ShelleyToBabbageEraAlonzo -> id | ||
| ShelleyToBabbageEraBabbage -> id | ||
|
|
||
| shelleyToBabbageEraToCardanoEra :: ShelleyToBabbageEra era -> CardanoEra era | ||
| shelleyToBabbageEraToCardanoEra = shelleyBasedToCardanoEra . shelleyToBabbageEraToShelleyBasedEra | ||
|
|
||
| shelleyToBabbageEraToShelleyBasedEra :: ShelleyToBabbageEra era -> ShelleyBasedEra era | ||
| shelleyToBabbageEraToShelleyBasedEra = \case | ||
| ShelleyToBabbageEraShelley -> ShelleyBasedEraShelley | ||
| ShelleyToBabbageEraAllegra -> ShelleyBasedEraAllegra | ||
| ShelleyToBabbageEraMary -> ShelleyBasedEraMary | ||
| ShelleyToBabbageEraAlonzo -> ShelleyBasedEraAlonzo | ||
| ShelleyToBabbageEraBabbage -> ShelleyBasedEraBabbage |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I'm skeptical about introducing another abstraction as we are in the process of handing over part of cardano-api to the ledger team. We don't want additional churn as we have an October target we need to hit. Where do you envision this being used?
Uh oh!
There was an error while loading. Please reload this page.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I'm anticipating that we it will be used in the CLI parser.
For example we currently don't have a good way to say some value that's passed into the run function from the parser is mandatory but only for a particular era.
This change is also a simplification of existing code. Currently
FeatureValueincludes optionality, which I think is better modelled viaMaybe.I think this data type will also provide us a good way to shrink our API, which would mean less code to maintain and make the handover easier.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We can postpone the merge of this PR until after the next
cardano-apirelease.