Translate: allow heterogenous translations

IntersectMBO · Sep 8, 2023 · 6e22a69 · 6e22a69
1 parent f318ffe
commit 6e22a69
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 6 deletions.
diff --git a/...ros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs b/...ros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs
@@ -51,7 +51,7 @@ import           Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel
 import           Ouroboros.Consensus.HardFork.Combinator.Protocol.LedgerView
                      (HardForkLedgerView, HardForkLedgerView_ (..), Ticked (..))
 import           Ouroboros.Consensus.HardFork.Combinator.State (HardForkState,
-                     Translate (..))
+                     Translate)
 import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
 import           Ouroboros.Consensus.HardFork.Combinator.Translation
 import           Ouroboros.Consensus.Protocol.Abstract

diff --git a/...-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/State/Types.hs b/...-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/State/Types.hs
@@ -12,8 +12,10 @@ module Ouroboros.Consensus.HardFork.Combinator.State.Types (
   , sequenceHardForkState
     -- * Supporting types
   , CrossEraForecaster (..)
+  , TickedTranslate
   , TransitionInfo (..)
-  , Translate (..)
+  , Translate
+  , Translate' (..)
   ) where
 
 import           Control.Monad.Except
@@ -109,13 +111,17 @@ sequenceHardForkState (HardForkState tel) =
   Supporting types
 -------------------------------------------------------------------------------}
 
--- | Translate @f x@ to @f y@ across an era transition
+-- | Translate @f x@ to @g y@ across an era transition
 --
--- Typically @f@ will be 'LedgerState' or 'WrapChainDepState'.
-newtype Translate f x y = Translate {
-      translateWith :: EpochNo -> f x -> f y
+-- Typically @f@/@g@ will be 'LedgerState' or 'WrapChainDepState'.
+newtype Translate' f g x y = Translate {
+      translateWith :: EpochNo -> f x -> g y
     }
 
+type Translate f = Translate' f f
+
+type TickedTranslate f = Translate' (Ticked :.: f) f
+
 -- | Forecast a @'Ticked' (view y)@ from a @state x@ across an
 -- era transition.
 --