content: {-# LANGUAGE DefaultSignatures #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilyDependencies #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableSuperClasses #-}
  
  module Cardano.Ledger.Core.Translation (
    PreviousEra,
    TranslationContext,
    TranslationError,
    TranslateEra,
    translateEra,
    translateEraMaybe,
    translateEra',
    translateEraThroughCBOR,
  ) where
  
  import Cardano.Ledger.Binary
  import Cardano.Ledger.Core.Era
  import Cardano.Ledger.Genesis
  import Control.Monad.Except (Except, runExcept)
  import Data.Coerce (Coercible, coerce)
  import Data.Kind (Type)
  import Data.Text (Text)
  import Data.Void (Void, absurd)
  
  --------------------------------------------------------------------------------
  -- Era translation
  --------------------------------------------------------------------------------
  
  -- | Per-era context used for 'TranslateEra'.
  --
  -- This context will be passed to the translation instances of /all/ types of
  -- that particular era. In practice, most instances won't need the context, but
  -- this approach makes the translation composable (as opposed to having a
  -- separate context per type).
  type family TranslationContext era :: Type
  
  -- | Translation of types between eras, e.g., from Shelley to Allegra.
  --
  -- When @era@ is just a phantom type parameter, an empty standalone deriving can be used:
  --
  -- > newtype Foo era = Foo Int
  -- >
  -- > instance TranslateEra AllegraEra Foo
  --
  -- Note that one could use @DerivingAnyClass@ (@deriving (TranslateEra (Allegra
  -- c))@), but this would introduce an undesired coupling between the
  -- era-parametric type and (a) particular era(s). The intention is to have a
  -- module with orphan instances per era.
  --
  -- In most cases, the @era@ parameter won't be phantom, and a manual instance
  -- will have to be written:
  --
  -- > newtype Bar era = Bar (TxBody era)
  -- >
  -- > instance TranslateEra AllegraEra Bar where
  -- >     translateEra ctxt = Bar <$> translateEra ctxt
  -- >
  -- > -- With the following instance being in scope:
  -- > instance TranslatEra AllegraEra TxBody
  --
  -- Note: we use 'PreviousEra' instead of @NextEra@ as an era definitely knows
  -- its predecessor, but not necessarily its successor. Moreover, one could argue
  -- that it makes more sense to define the translation from era A to era B where
  -- era B is defined, than where era A is defined.
  class (Era era, Era (PreviousEra era)) => TranslateEra era f where
    -- | Most translations should be infallible (default instance), but we leave
    -- the door open for partial translations.
    --
    -- For a partial translation, override the default type to be '()' or a
    -- concrete error type.
    type TranslationError era f :: Type
  
    type TranslationError era f = Void
  
    -- | Translate a type @f@ parameterised by the era from an era to the era
    -- after it.
    --
    -- The translation is a given the translation context of @era@.
    --
    -- A default instance is provided for when the two types are 'Coercible'.
    translateEra ::
      TranslationContext era -> f (PreviousEra era) -> Except (TranslationError era f) (f era)
    default translateEra ::
      (Coercible (f (PreviousEra era)) (f era), TranslationContext era ~ NoGenesis era) =>
      TranslationContext era ->
      f (PreviousEra era) ->
      Except (TranslationError era f) (f era)
    translateEra NoGenesis = return . coerce
  
  -- | Variant of 'translateEra' for when 'TranslationError' is 'Void' and the
  -- translation thus cannot fail.
  translateEra' ::
    (TranslateEra era f, TranslationError era f ~ Void) =>
    TranslationContext era ->
    f (PreviousEra era) ->
    f era
  translateEra' ctxt = either absurd id . runExcept . translateEra ctxt
  
  -- | Variant of 'translateEra' for when 'TranslationError' is '()', converting
  -- the result to a 'Maybe'.
  translateEraMaybe ::
    (TranslateEra era f, TranslationError era f ~ ()) =>
    TranslationContext era ->
    f (PreviousEra era) ->
    Maybe (f era)
  translateEraMaybe ctxt =
    either (const Nothing) Just . runExcept . translateEra ctxt
  
  -- | Translate a type through its binary representation from previous era to the current one.
  translateEraThroughCBOR ::
    forall era ti to.
    (Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (Annotator (to era))) =>
    -- | Label for error reporting
    Text ->
    ti (PreviousEra era) ->
    Except DecoderError (to era)
  translateEraThroughCBOR =
    translateViaCBORAnnotator (eraProtVerLow @era)
  