diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index d7f8f517ee..c6805f78b0 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -66,6 +66,7 @@ library internal Cardano.Api.Eon.ByronToAlonzoEra Cardano.Api.Eon.ByronToMaryEra Cardano.Api.Eon.ConwayEraOnwards + Cardano.Api.Eon.Core Cardano.Api.Eon.MaryEraOnly Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra @@ -204,6 +205,7 @@ library internal , typed-protocols ^>= 0.1 , unordered-containers >= 0.2.11 , vector + , world-peace , yaml library diff --git a/cardano-api/internal/Cardano/Api/Eon/Core.hs b/cardano-api/internal/Cardano/Api/Eon/Core.hs new file mode 100644 index 0000000000..2a8105b7f9 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/Core.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.Eon.Core where + +import Data.Kind +import Data.WorldPeace + +data Eon (eras :: [Type]) era where + Eon + :: IsMember era eras + => OpenUnion eras + -> Eon eras era + +data Byron = Byron deriving (Eq, Show) +data Shelley = Shelley deriving (Eq, Show) +data Allegra = Allegra deriving (Eq, Show) +data Mary = Mary deriving (Eq, Show) +data Alonzo = Alonzo deriving (Eq, Show) +data Babbage = Babbage deriving (Eq, Show) +data Conway = Conway deriving (Eq, Show) + +type ByronEraOnly = '[Byron ] +type ShelleyEraOnly = '[ Shelley ] +type AllegraEraOnly = '[ Allegra ] +type MaryEraOnly = '[ Mary ] +type AlonzoEraOnly = '[ Alonzo ] +type BabbageEraOnly = '[ Babbage ] +type ConwayEraOnly = '[ Conway] + +type ByronEraOnwards = '[Byron, Shelley, Allegra, Mary, Alonzo, Babbage, Conway] +type ShelleyEraOnwards = '[ Shelley, Allegra, Mary, Alonzo, Babbage, Conway] +type AllegraEraOnwards = '[ Allegra, Mary, Alonzo, Babbage, Conway] +type MaryEraOnwards = '[ Mary, Alonzo, Babbage, Conway] +type AlonzoEraOnwards = '[ Alonzo, Babbage, Conway] +type BabbageEraOnwards = '[ Babbage, Conway] +type ConwayEraOnwards = '[ Conway] + +relaxEon :: () + => Contains as bs + => IsMember a bs -- This constraing shouldn't be needed + => Eon as a + -> Eon bs a +relaxEon (Eon a) = Eon (relaxOpenUnion a) + +example1 :: IsMember era ByronEraOnwards => Eon ByronEraOnwards era -> Eon ByronEraOnwards era +example1 = relaxEon + +example2 :: IsMember era ByronEraOnwards => Eon ShelleyEraOnwards era -> Eon ByronEraOnwards era +example2 = relaxEon