{-# 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
  { forall (f :: * -> *) (xs :: [*]).
HardForkLedgerView_ f xs -> TransitionInfo
hardForkLedgerViewTransition :: !TransitionInfo
  -- ^ Information about the transition to the next era, if known
  , forall (f :: * -> *) (xs :: [*]).
HardForkLedgerView_ f xs -> HardForkState f xs
hardForkLedgerViewPerEra :: !(HardForkState f xs)
  -- ^ The underlying ledger view
  }

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