module Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks (
    NoHardForks (..)
  , noHardForksEpochInfo
  ) where

import           Data.Functor.Identity (runIdentity)

import           Cardano.Slotting.EpochInfo

import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.Ledger.Abstract

import           Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig

{-------------------------------------------------------------------------------
  Blocks that don't /have/ any transitions
-------------------------------------------------------------------------------}

class SingleEraBlock blk => NoHardForks blk where
  -- | Extract 'EraParams' from the top-level config
  --
  -- The HFC itself does not care about this, as it must be given the full shape
  -- across /all/ eras.
  getEraParams :: TopLevelConfig blk -> EraParams


  -- | Construct partial ledger config from full ledger config
  --
  -- See also 'toPartialConsensusConfig'
  toPartialLedgerConfig :: proxy blk
                        -> LedgerConfig blk -> PartialLedgerConfig blk

noHardForksEpochInfo :: (Monad m, NoHardForks blk)
                     => TopLevelConfig blk
                     -> EpochInfo m
noHardForksEpochInfo :: TopLevelConfig blk -> EpochInfo m
noHardForksEpochInfo TopLevelConfig blk
cfg =
      (forall a. Identity a -> m a) -> EpochInfo Identity -> EpochInfo m
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
    (EpochInfo Identity -> EpochInfo m)
-> EpochInfo Identity -> EpochInfo m
forall a b. (a -> b) -> a -> b
$ EpochSize -> SlotLength -> EpochInfo Identity
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo
        (EraParams -> EpochSize
History.eraEpochSize  EraParams
params)
        (EraParams -> SlotLength
History.eraSlotLength EraParams
params)
  where
    params :: EraParams
    params :: EraParams
params = TopLevelConfig blk -> EraParams
forall blk. NoHardForks blk => TopLevelConfig blk -> EraParams
getEraParams TopLevelConfig blk
cfg