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