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