{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} module Ouroboros.Consensus.HardFork.Combinator.Protocol.LedgerView ( -- * Hard fork HardForkLedgerView , HardForkLedgerView_ (..) -- * Type family instances , Ticked (..) ) where import Data.SOP.BasicFunctors import Data.SOP.Constraint import Data.SOP.Dict (Dict (..), all_NP) import Data.SOP.Strict import Ouroboros.Consensus.HardFork.Combinator.Abstract import Ouroboros.Consensus.HardFork.Combinator.State.Instances () import Ouroboros.Consensus.HardFork.Combinator.State.Types import Ouroboros.Consensus.Ticked import Ouroboros.Consensus.TypeFamilyWrappers {------------------------------------------------------------------------------- HardForkLedgerView -------------------------------------------------------------------------------} data HardForkLedgerView_ f xs = HardForkLedgerView { -- | Information about the transition to the next era, if known forall (f :: * -> *) (xs :: [*]). HardForkLedgerView_ f xs -> TransitionInfo hardForkLedgerViewTransition :: !TransitionInfo -- | The underlying ledger view , forall (f :: * -> *) (xs :: [*]). HardForkLedgerView_ f xs -> HardForkState f xs hardForkLedgerViewPerEra :: !(HardForkState f xs) } deriving instance CanHardFork xs => Show (HardForkLedgerView_ WrapLedgerView xs) type HardForkLedgerView = HardForkLedgerView_ WrapLedgerView {------------------------------------------------------------------------------- Show instance for the benefit of tests -------------------------------------------------------------------------------} instance (SListI xs, Show a) => Show (HardForkLedgerView_ (K a) xs) where show :: HardForkLedgerView_ (K a) xs -> String show HardForkLedgerView{TransitionInfo HardForkState (K a) xs hardForkLedgerViewTransition :: forall (f :: * -> *) (xs :: [*]). HardForkLedgerView_ f xs -> TransitionInfo hardForkLedgerViewPerEra :: forall (f :: * -> *) (xs :: [*]). HardForkLedgerView_ f xs -> HardForkState f xs hardForkLedgerViewTransition :: TransitionInfo hardForkLedgerViewPerEra :: HardForkState (K a) xs ..} = case (Dict (All (Compose Show (K Past))) xs dictPast, Dict (All (Compose Show (Current (K a)))) xs dictCurrent) of (Dict (All (Compose Show (K Past))) xs Dict, Dict (All (Compose Show (Current (K a)))) xs Dict) -> (TransitionInfo, Telescope (K Past) (Current (K a)) xs) -> String forall a. Show a => a -> String show ( TransitionInfo hardForkLedgerViewTransition , HardForkState (K a) xs -> Telescope (K Past) (Current (K a)) xs forall (f :: * -> *) (xs :: [*]). HardForkState f xs -> Telescope (K Past) (Current f) xs getHardForkState HardForkState (K a) xs hardForkLedgerViewPerEra ) where dictPast :: Dict (All (Compose Show (K Past))) xs dictPast :: Dict (All (Compose Show (K Past))) xs dictPast = NP (Dict (Compose Show (K Past))) xs -> Dict (All (Compose Show (K Past))) xs forall {k} (c :: k -> Constraint) (xs :: [k]). NP (Dict c) xs -> Dict (All c) xs all_NP (NP (Dict (Compose Show (K Past))) xs -> Dict (All (Compose Show (K Past))) xs) -> NP (Dict (Compose Show (K Past))) xs -> Dict (All (Compose Show (K Past))) xs forall a b. (a -> b) -> a -> b $ (forall a. Dict (Compose Show (K Past)) a) -> NP (Dict (Compose Show (K Past))) xs forall (xs :: [*]) (f :: * -> *). SListIN NP xs => (forall a. f a) -> NP f xs forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *). (HPure h, SListIN h xs) => (forall (a :: k). f a) -> h f xs hpure Dict (Compose Show (K Past)) a forall a. Dict (Compose Show (K Past)) a forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a Dict dictCurrent :: Dict (All (Compose Show (Current (K a)))) xs dictCurrent :: Dict (All (Compose Show (Current (K a)))) xs dictCurrent = NP (Dict (Compose Show (Current (K a)))) xs -> Dict (All (Compose Show (Current (K a)))) xs forall {k} (c :: k -> Constraint) (xs :: [k]). NP (Dict c) xs -> Dict (All c) xs all_NP (NP (Dict (Compose Show (Current (K a)))) xs -> Dict (All (Compose Show (Current (K a)))) xs) -> NP (Dict (Compose Show (Current (K a)))) xs -> Dict (All (Compose Show (Current (K a)))) xs forall a b. (a -> b) -> a -> b $ (forall a. Dict (Compose Show (Current (K a))) a) -> NP (Dict (Compose Show (Current (K a)))) xs forall (xs :: [*]) (f :: * -> *). SListIN NP xs => (forall a. f a) -> NP f xs forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *). (HPure h, SListIN h xs) => (forall (a :: k). f a) -> h f xs hpure Dict (Compose Show (Current (K a))) a forall a. Dict (Compose Show (Current (K a))) a forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a Dict