{-# 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