{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Ledger.Era
( Era,
Crypto,
PreviousEra,
TranslationContext,
TranslateEra (..),
translateEra',
translateEraMaybe,
)
where
import qualified Cardano.Ledger.Crypto as CryptoClass
import Control.Monad.Except (Except, runExcept)
import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
class
( CryptoClass.Crypto (Crypto e),
Typeable e
) =>
Era e
where
type Crypto e :: Type
type family PreviousEra era :: Type
type family TranslationContext era :: Type
class (Era era, Era (PreviousEra era)) => TranslateEra era f where
type TranslationError era f :: Type
type TranslationError era f = Void
translateEra :: TranslationContext era -> f (PreviousEra era) -> Except (TranslationError era f) (f era)
default translateEra ::
Coercible (f (PreviousEra era)) (f era) =>
TranslationContext era ->
f (PreviousEra era) ->
Except (TranslationError era f) (f era)
translateEra TranslationContext era
_ = f era -> Except (TranslationError era f) (f era)
forall (m :: * -> *) a. Monad m => a -> m a
return (f era -> Except (TranslationError era f) (f era))
-> (f (PreviousEra era) -> f era)
-> f (PreviousEra era)
-> Except (TranslationError era f) (f era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (PreviousEra era) -> f era
coerce
translateEra' ::
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era ->
f (PreviousEra era) ->
f era
translateEra' :: TranslationContext era -> f (PreviousEra era) -> f era
translateEra' TranslationContext era
ctxt = (Void -> f era) -> (f era -> f era) -> Either Void (f era) -> f era
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> f era
forall a. Void -> a
absurd f era -> f era
forall a. a -> a
id (Either Void (f era) -> f era)
-> (f (PreviousEra era) -> Either Void (f era))
-> f (PreviousEra era)
-> f era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except Void (f era) -> Either Void (f era)
forall e a. Except e a -> Either e a
runExcept (Except Void (f era) -> Either Void (f era))
-> (f (PreviousEra era) -> Except Void (f era))
-> f (PreviousEra era)
-> Either Void (f era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext era
ctxt
translateEraMaybe ::
(TranslateEra era f, TranslationError era f ~ ()) =>
TranslationContext era ->
f (PreviousEra era) ->
Maybe (f era)
translateEraMaybe :: TranslationContext era -> f (PreviousEra era) -> Maybe (f era)
translateEraMaybe TranslationContext era
ctxt =
(() -> Maybe (f era))
-> (f era -> Maybe (f era)) -> Either () (f era) -> Maybe (f era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (f era) -> () -> Maybe (f era)
forall a b. a -> b -> a
const Maybe (f era)
forall a. Maybe a
Nothing) f era -> Maybe (f era)
forall a. a -> Maybe a
Just (Either () (f era) -> Maybe (f era))
-> (f (PreviousEra era) -> Either () (f era))
-> f (PreviousEra era)
-> Maybe (f era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except () (f era) -> Either () (f era)
forall e a. Except e a -> Either e a
runExcept (Except () (f era) -> Either () (f era))
-> (f (PreviousEra era) -> Except () (f era))
-> f (PreviousEra era)
-> Either () (f era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
translateEra TranslationContext era
ctxt