{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Derive 'EpochInfo'
module Ouroboros.Consensus.HardFork.History.EpochInfo (
    dummyEpochInfo
  , interpreterToEpochInfo
  , summaryToEpochInfo
  , toPureEpochInfo
  ) where

import           Control.Exception (throw)
import           Control.Monad.Except (Except, runExcept, throwError)
import           GHC.Stack

import           Cardano.Slotting.EpochInfo.API

import           Ouroboros.Consensus.HardFork.History.Qry
import           Ouroboros.Consensus.HardFork.History.Summary

{-------------------------------------------------------------------------------
  Translation to EpochInfo
-------------------------------------------------------------------------------}

-- | Construct an 'EpochInfo' for a /snapshot/ of the ledger state
summaryToEpochInfo :: forall xs. Summary xs -> EpochInfo (Except PastHorizonException)
summaryToEpochInfo :: Summary xs -> EpochInfo (Except PastHorizonException)
summaryToEpochInfo = Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
interpreterToEpochInfo (Interpreter xs -> EpochInfo (Except PastHorizonException))
-> (Summary xs -> Interpreter xs)
-> Summary xs
-> EpochInfo (Except PastHorizonException)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Summary xs -> Interpreter xs
forall (xs :: [*]). Summary xs -> Interpreter xs
mkInterpreter

-- | Construct an 'EpochInfo' for a /snapshot/ of the ledger state
interpreterToEpochInfo :: forall xs. Interpreter xs
                       -> EpochInfo (Except PastHorizonException)
interpreterToEpochInfo :: Interpreter xs -> EpochInfo (Except PastHorizonException)
interpreterToEpochInfo Interpreter xs
i = EpochInfo :: forall (m :: * -> *).
(HasCallStack => EpochNo -> m EpochSize)
-> (HasCallStack => EpochNo -> m SlotNo)
-> (HasCallStack => SlotNo -> m EpochNo)
-> (HasCallStack => SlotNo -> m RelativeTime)
-> (HasCallStack => SlotNo -> m SlotLength)
-> EpochInfo m
EpochInfo {
      epochInfoSize_ :: HasCallStack => EpochNo -> Except PastHorizonException EpochSize
epochInfoSize_  = \EpochNo
e -> Qry EpochSize -> Except PastHorizonException EpochSize
forall a. HasCallStack => Qry a -> Except PastHorizonException a
interpretQuery' (EpochNo -> Qry EpochSize
epochToSize  EpochNo
e)
    , epochInfoFirst_ :: HasCallStack => EpochNo -> Except PastHorizonException SlotNo
epochInfoFirst_ = \EpochNo
e -> Qry SlotNo -> Except PastHorizonException SlotNo
forall a. HasCallStack => Qry a -> Except PastHorizonException a
interpretQuery' (EpochNo -> Qry SlotNo
epochToSlot' EpochNo
e)
    , epochInfoEpoch_ :: HasCallStack => SlotNo -> Except PastHorizonException EpochNo
epochInfoEpoch_ = \SlotNo
s -> Qry EpochNo -> Except PastHorizonException EpochNo
forall a. HasCallStack => Qry a -> Except PastHorizonException a
interpretQuery' ((EpochNo, Word64) -> EpochNo
forall a b. (a, b) -> a
fst ((EpochNo, Word64) -> EpochNo)
-> Qry (EpochNo, Word64) -> Qry EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> Qry (EpochNo, Word64)
slotToEpoch' SlotNo
s)

    , epochInfoSlotToRelativeTime_ :: HasCallStack => SlotNo -> Except PastHorizonException RelativeTime
epochInfoSlotToRelativeTime_ = \SlotNo
s ->
        Qry RelativeTime -> Except PastHorizonException RelativeTime
forall a. HasCallStack => Qry a -> Except PastHorizonException a
interpretQuery' ((RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst ((RelativeTime, SlotLength) -> RelativeTime)
-> Qry (RelativeTime, SlotLength) -> Qry RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> Qry (RelativeTime, SlotLength)
slotToWallclock SlotNo
s)

    , epochInfoSlotLength_ :: HasCallStack => SlotNo -> Except PastHorizonException SlotLength
epochInfoSlotLength_ = \SlotNo
s -> Qry SlotLength -> Except PastHorizonException SlotLength
forall a. HasCallStack => Qry a -> Except PastHorizonException a
interpretQuery' (SlotNo -> Qry SlotLength
slotToSlotLength SlotNo
s)
    }
  where
    interpretQuery' :: HasCallStack => Qry a -> Except PastHorizonException a
    interpretQuery' :: Qry a -> Except PastHorizonException a
interpretQuery' Qry a
q = (PastHorizonException -> Except PastHorizonException a)
-> (a -> Except PastHorizonException a)
-> Either PastHorizonException a
-> Except PastHorizonException a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PastHorizonException -> Except PastHorizonException a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> Except PastHorizonException a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PastHorizonException a -> Except PastHorizonException a)
-> Either PastHorizonException a -> Except PastHorizonException a
forall a b. (a -> b) -> a -> b
$ Interpreter xs -> Qry a -> Either PastHorizonException a
forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
interpretQuery Interpreter xs
i Qry a
q

-- | A dummy 'EpochInfo' that always throws an 'error'.
--
-- To be used as a placeholder before a summary is available.
dummyEpochInfo :: EpochInfo (Except PastHorizonException)
dummyEpochInfo :: EpochInfo (Except PastHorizonException)
dummyEpochInfo = EpochInfo :: forall (m :: * -> *).
(HasCallStack => EpochNo -> m EpochSize)
-> (HasCallStack => EpochNo -> m SlotNo)
-> (HasCallStack => SlotNo -> m EpochNo)
-> (HasCallStack => SlotNo -> m RelativeTime)
-> (HasCallStack => SlotNo -> m SlotLength)
-> EpochInfo m
EpochInfo {
      epochInfoSize_ :: HasCallStack => EpochNo -> Except PastHorizonException EpochSize
epochInfoSize_               = \EpochNo
_ -> [Char] -> Except PastHorizonException EpochSize
forall a. HasCallStack => [Char] -> a
error [Char]
"dummyEpochInfo used"
    , epochInfoFirst_ :: HasCallStack => EpochNo -> Except PastHorizonException SlotNo
epochInfoFirst_              = \EpochNo
_ -> [Char] -> Except PastHorizonException SlotNo
forall a. HasCallStack => [Char] -> a
error [Char]
"dummyEpochInfo used"
    , epochInfoEpoch_ :: HasCallStack => SlotNo -> Except PastHorizonException EpochNo
epochInfoEpoch_              = \SlotNo
_ -> [Char] -> Except PastHorizonException EpochNo
forall a. HasCallStack => [Char] -> a
error [Char]
"dummyEpochInfo used"
    , epochInfoSlotToRelativeTime_ :: HasCallStack => SlotNo -> Except PastHorizonException RelativeTime
epochInfoSlotToRelativeTime_ = \SlotNo
_ -> [Char] -> Except PastHorizonException RelativeTime
forall a. HasCallStack => [Char] -> a
error [Char]
"dummyEpochInfo used"
    , epochInfoSlotLength_ :: HasCallStack => SlotNo -> Except PastHorizonException SlotLength
epochInfoSlotLength_         = \SlotNo
_ -> [Char] -> Except PastHorizonException SlotLength
forall a. HasCallStack => [Char] -> a
error [Char]
"dummyEpochInfo used"
    }

-- | Interpret the 'PastHorizonException' as a _pure exception_ via 'throw'
--
-- As per usual, this should only be used when the pure exception would
-- indicate a bug.
toPureEpochInfo ::
     Applicative f
  => EpochInfo (Except PastHorizonException)
  -> EpochInfo f
toPureEpochInfo :: EpochInfo (Except PastHorizonException) -> EpochInfo f
toPureEpochInfo = (forall a. Except PastHorizonException a -> f a)
-> EpochInfo (Except PastHorizonException) -> EpochInfo f
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> f a)
-> (a -> f a) -> Either PastHorizonException a -> f a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PastHorizonException -> f a
forall a e. Exception e => e -> a
throw a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PastHorizonException a -> f a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept)