{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Ouroboros.Consensus.HardFork.Combinator.Abstract.CanHardFork (
    CanHardFork(..)
  ) where

import           Data.SOP.Strict
import           Data.Typeable

import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.SOP

import           Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
import           Ouroboros.Consensus.HardFork.Combinator.InjectTxs
import           Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel
import           Ouroboros.Consensus.HardFork.Combinator.Translation
import           Ouroboros.Consensus.HardFork.Combinator.Util.InPairs (InPairs,
                     RequiringBoth)
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.InPairs as InPairs
import           Ouroboros.Consensus.HardFork.Combinator.Util.Tails (Tails)
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.Tails as Tails

{-------------------------------------------------------------------------------
  CanHardFork
-------------------------------------------------------------------------------}

class (All SingleEraBlock xs, Typeable xs, IsNonEmpty xs) => CanHardFork xs where
  hardForkEraTranslation :: EraTranslation xs
  hardForkChainSel       :: Tails AcrossEraSelection xs
  hardForkInjectTxs      :: InPairs (RequiringBoth WrapLedgerConfig InjectTx) xs

instance SingleEraBlock blk => CanHardFork '[blk] where
  hardForkEraTranslation :: EraTranslation '[blk]
hardForkEraTranslation = EraTranslation '[blk]
forall blk. EraTranslation '[blk]
trivialEraTranslation
  hardForkChainSel :: Tails AcrossEraSelection '[blk]
hardForkChainSel       = Tails AcrossEraSelection '[blk]
forall k (f :: k -> k -> *) (x :: k). Tails f '[x]
Tails.mk1
  hardForkInjectTxs :: InPairs (RequiringBoth WrapLedgerConfig InjectTx) '[blk]
hardForkInjectTxs      = InPairs (RequiringBoth WrapLedgerConfig InjectTx) '[blk]
forall k (f :: k -> k -> *) (x :: k). InPairs f '[x]
InPairs.mk1