Open union encoding of Eon

IntersectMBO · Oct 15, 2023 · 6109f82 · 6109f82
1 parent 7e54356
commit 6109f82
Show file tree

Hide file tree

Showing 2 changed files with 59 additions and 0 deletions.
diff --git 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
@@ -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