{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.HardFork.History.Qry (
Expr (..)
, PastHorizonException (..)
, qryFromExpr
, runQuery
, runQueryPure
, runQueryThrow
, Qry
, interpretQuery
, mkInterpreter
, unsafeExtendSafeZone
, Interpreter
, epochToSize
, epochToSlot
, epochToSlot'
, slotToEpoch
, slotToEpoch'
, slotToGenesisWindow
, slotToSlotLength
, slotToWallclock
, wallclockToSlot
) where
import Codec.Serialise (Serialise (..))
import Control.Exception (throw)
import Control.Monad (ap, guard, liftM, (>=>))
import Control.Monad.Except ()
import Data.Bifunctor
import Data.Fixed (divMod')
import Data.Foldable (toList)
import Data.Functor.Identity
import Data.Kind (Type)
import Data.Reflection (Given)
import Data.SOP.NonEmpty (NonEmpty (..))
import Data.SOP.Sing (SListI)
import Data.Time hiding (UTCTime)
import Data.Word
import GHC.Generics (Generic)
import GHC.Show (showSpace)
import GHC.Stack
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
import Ouroboros.Consensus.HardFork.History.EraParams
import Ouroboros.Consensus.HardFork.History.Summary
import Ouroboros.Consensus.HardFork.History.Util
import Ouroboros.Consensus.Util (Some (..))
import Ouroboros.Consensus.Util.IOLike
import Quiet
data Qry :: Type -> Type where
QPure :: a -> Qry a
QExpr :: ClosedExpr a -> (a -> Qry b) -> Qry b
instance Functor Qry where
fmap :: forall a b. (a -> b) -> Qry a -> Qry b
fmap = (a -> b) -> Qry a -> Qry b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Qry where
pure :: forall a. a -> Qry a
pure = a -> Qry a
forall a. a -> Qry a
QPure
<*> :: forall a b. Qry (a -> b) -> Qry a -> Qry b
(<*>) = Qry (a -> b) -> Qry a -> Qry b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Qry where
return :: forall a. a -> Qry a
return = a -> Qry a
forall a. a -> Qry a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
QPure a
a >>= :: forall a b. Qry a -> (a -> Qry b) -> Qry b
>>= a -> Qry b
k = a -> Qry b
k a
a
QExpr ClosedExpr a
e a -> Qry a
f >>= a -> Qry b
k = ClosedExpr a -> (a -> Qry b) -> Qry b
forall b b. ClosedExpr b -> (b -> Qry b) -> Qry b
QExpr ClosedExpr a
e (a -> Qry a
f (a -> Qry a) -> (a -> Qry b) -> a -> Qry b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Qry b
k)
qryFromExpr :: (forall f. Expr f a) -> Qry a
qryFromExpr :: forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr forall (f :: * -> *). Expr f a
e = ClosedExpr a -> (a -> Qry a) -> Qry a
forall b b. ClosedExpr b -> (b -> Qry b) -> Qry b
QExpr ((forall (f :: * -> *). Expr f a) -> ClosedExpr a
forall a. (forall (f :: * -> *). Expr f a) -> ClosedExpr a
ClosedExpr Expr f a
forall (f :: * -> *). Expr f a
e) a -> Qry a
forall a. a -> Qry a
QPure
newtype TimeInEra = TimeInEra { TimeInEra -> NominalDiffTime
getTimeInEra :: NominalDiffTime } deriving ((forall x. TimeInEra -> Rep TimeInEra x)
-> (forall x. Rep TimeInEra x -> TimeInEra) -> Generic TimeInEra
forall x. Rep TimeInEra x -> TimeInEra
forall x. TimeInEra -> Rep TimeInEra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeInEra -> Rep TimeInEra x
from :: forall x. TimeInEra -> Rep TimeInEra x
$cto :: forall x. Rep TimeInEra x -> TimeInEra
to :: forall x. Rep TimeInEra x -> TimeInEra
Generic)
newtype TimeInSlot = TimeInSlot { TimeInSlot -> NominalDiffTime
getTimeInSlot :: NominalDiffTime } deriving ((forall x. TimeInSlot -> Rep TimeInSlot x)
-> (forall x. Rep TimeInSlot x -> TimeInSlot) -> Generic TimeInSlot
forall x. Rep TimeInSlot x -> TimeInSlot
forall x. TimeInSlot -> Rep TimeInSlot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeInSlot -> Rep TimeInSlot x
from :: forall x. TimeInSlot -> Rep TimeInSlot x
$cto :: forall x. Rep TimeInSlot x -> TimeInSlot
to :: forall x. Rep TimeInSlot x -> TimeInSlot
Generic)
newtype SlotInEra = SlotInEra { SlotInEra -> Word64
getSlotInEra :: Word64 } deriving ((forall x. SlotInEra -> Rep SlotInEra x)
-> (forall x. Rep SlotInEra x -> SlotInEra) -> Generic SlotInEra
forall x. Rep SlotInEra x -> SlotInEra
forall x. SlotInEra -> Rep SlotInEra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotInEra -> Rep SlotInEra x
from :: forall x. SlotInEra -> Rep SlotInEra x
$cto :: forall x. Rep SlotInEra x -> SlotInEra
to :: forall x. Rep SlotInEra x -> SlotInEra
Generic)
newtype SlotInEpoch = SlotInEpoch { SlotInEpoch -> Word64
getSlotInEpoch :: Word64 } deriving ((forall x. SlotInEpoch -> Rep SlotInEpoch x)
-> (forall x. Rep SlotInEpoch x -> SlotInEpoch)
-> Generic SlotInEpoch
forall x. Rep SlotInEpoch x -> SlotInEpoch
forall x. SlotInEpoch -> Rep SlotInEpoch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotInEpoch -> Rep SlotInEpoch x
from :: forall x. SlotInEpoch -> Rep SlotInEpoch x
$cto :: forall x. Rep SlotInEpoch x -> SlotInEpoch
to :: forall x. Rep SlotInEpoch x -> SlotInEpoch
Generic)
newtype EpochInEra = EpochInEra { EpochInEra -> Word64
getEpochInEra :: Word64 } deriving ((forall x. EpochInEra -> Rep EpochInEra x)
-> (forall x. Rep EpochInEra x -> EpochInEra) -> Generic EpochInEra
forall x. Rep EpochInEra x -> EpochInEra
forall x. EpochInEra -> Rep EpochInEra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EpochInEra -> Rep EpochInEra x
from :: forall x. EpochInEra -> Rep EpochInEra x
$cto :: forall x. Rep EpochInEra x -> EpochInEra
to :: forall x. Rep EpochInEra x -> EpochInEra
Generic)
deriving via Quiet TimeInEra instance Show TimeInEra
deriving via Quiet TimeInSlot instance Show TimeInSlot
deriving via Quiet SlotInEra instance Show SlotInEra
deriving via Quiet SlotInEpoch instance Show SlotInEpoch
deriving via Quiet EpochInEra instance Show EpochInEra
data ClosedExpr a = ClosedExpr (forall f. Expr f a)
data Expr (f :: Type -> Type) :: Type -> Type where
EVar :: f a -> Expr f a
ELit :: Show a => a -> Expr f a
ELet :: Expr f a -> (f a -> Expr f b) -> Expr f b
EPair :: Expr f a -> Expr f b -> Expr f (a, b)
EFst :: Expr f (a, b) -> Expr f a
ESnd :: Expr f (a, b) -> Expr f b
EAbsToRelTime :: Expr f RelativeTime -> Expr f TimeInEra
EAbsToRelSlot :: Expr f SlotNo -> Expr f SlotInEra
EAbsToRelEpoch :: Expr f EpochNo -> Expr f EpochInEra
ERelToAbsTime :: Expr f TimeInEra -> Expr f RelativeTime
ERelToAbsSlot :: Expr f (SlotInEra, TimeInSlot) -> Expr f SlotNo
ERelToAbsEpoch :: Expr f (EpochInEra, SlotInEpoch) -> Expr f EpochNo
ERelTimeToSlot :: Expr f TimeInEra -> Expr f (SlotInEra, TimeInSlot)
ERelSlotToTime :: Expr f SlotInEra -> Expr f TimeInEra
ERelSlotToEpoch :: Expr f SlotInEra -> Expr f (EpochInEra, SlotInEpoch)
ERelEpochToSlot :: Expr f EpochInEra -> Expr f SlotInEra
ESlotLength :: Expr f SlotNo -> Expr f SlotLength
EEpochSize :: Expr f EpochNo -> Expr f EpochSize
EGenesisWindow :: Expr f SlotNo -> Expr f GenesisWindow
evalExprInEra :: EraSummary -> ClosedExpr a -> Maybe a
evalExprInEra :: forall a. EraSummary -> ClosedExpr a -> Maybe a
evalExprInEra EraSummary{EraParams
EraEnd
Bound
eraStart :: Bound
eraEnd :: EraEnd
eraParams :: EraParams
eraStart :: EraSummary -> Bound
eraEnd :: EraSummary -> EraEnd
eraParams :: EraSummary -> EraParams
..} = \(ClosedExpr forall (f :: * -> *). Expr f a
e) -> Expr Identity a -> Maybe a
forall a. Expr Identity a -> Maybe a
go Expr Identity a
forall (f :: * -> *). Expr f a
e
where
EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
eraEpochSize :: EraParams -> EpochSize
eraSlotLength :: EraParams -> SlotLength
eraSafeZone :: EraParams -> SafeZone
eraGenesisWin :: EraParams -> GenesisWindow
..} = EraParams
eraParams
slotLen :: NominalDiffTime
slotLen = SlotLength -> NominalDiffTime
getSlotLength SlotLength
eraSlotLength
epochSize :: Word64
epochSize = EpochSize -> Word64
unEpochSize EpochSize
eraEpochSize
guardEnd :: (Bound -> Bool) -> Maybe ()
guardEnd :: (Bound -> Bool) -> Maybe ()
guardEnd Bound -> Bool
p =
case EraEnd
eraEnd of
EraEnd
EraUnbounded -> () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EraEnd Bound
b -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bound -> Bool
p Bound
b
go :: Expr Identity a -> Maybe a
go :: forall a. Expr Identity a -> Maybe a
go (EVar Identity a
a) =
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
a
go (ELet Expr Identity a
e Identity a -> Expr Identity a
f) =
Expr Identity a -> Maybe a
forall a. Expr Identity a -> Maybe a
go Expr Identity a
e Maybe a -> (a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr Identity a -> Maybe a
forall a. Expr Identity a -> Maybe a
go (Expr Identity a -> Maybe a)
-> (a -> Expr Identity a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> Expr Identity a
f (Identity a -> Expr Identity a)
-> (a -> Identity a) -> a -> Expr Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
go (ELit a
i) =
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i
go (EPair Expr Identity a
e Expr Identity b
e') = do
a
x <- Expr Identity a -> Maybe a
forall a. Expr Identity a -> Maybe a
go Expr Identity a
e
b
y <- Expr Identity b -> Maybe b
forall a. Expr Identity a -> Maybe a
go Expr Identity b
e'
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y)
go (EFst Expr Identity (a, b)
e) =
(a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> Maybe (a, b) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Identity (a, b) -> Maybe (a, b)
forall a. Expr Identity a -> Maybe a
go Expr Identity (a, b)
e
go (ESnd Expr Identity (a, a)
e) =
(a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> Maybe (a, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Identity (a, a) -> Maybe (a, a)
forall a. Expr Identity a -> Maybe a
go Expr Identity (a, a)
e
go (EAbsToRelTime Expr Identity RelativeTime
expr) = do
RelativeTime
t <- Expr Identity RelativeTime -> Maybe RelativeTime
forall a. Expr Identity a -> Maybe a
go Expr Identity RelativeTime
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RelativeTime
t RelativeTime -> RelativeTime -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> RelativeTime
boundTime Bound
eraStart)
TimeInEra -> Maybe TimeInEra
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeInEra -> Maybe TimeInEra) -> TimeInEra -> Maybe TimeInEra
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> TimeInEra
TimeInEra (RelativeTime
t RelativeTime -> RelativeTime -> NominalDiffTime
`diffRelTime` Bound -> RelativeTime
boundTime Bound
eraStart)
go (EAbsToRelSlot Expr Identity SlotNo
expr) = do
SlotNo
s <- Expr Identity SlotNo -> Maybe SlotNo
forall a. Expr Identity a -> Maybe a
go Expr Identity SlotNo
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> SlotNo
boundSlot Bound
eraStart)
SlotInEra -> Maybe SlotInEra
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotInEra -> Maybe SlotInEra) -> SlotInEra -> Maybe SlotInEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotInEra
SlotInEra (HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
countSlots SlotNo
s (Bound -> SlotNo
boundSlot Bound
eraStart))
go (EAbsToRelEpoch Expr Identity EpochNo
expr) = do
EpochNo
e <- Expr Identity EpochNo -> Maybe EpochNo
forall a. Expr Identity a -> Maybe a
go Expr Identity EpochNo
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (EpochNo
e EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> EpochNo
boundEpoch Bound
eraStart)
EpochInEra -> Maybe EpochInEra
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpochInEra -> Maybe EpochInEra) -> EpochInEra -> Maybe EpochInEra
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochInEra
EpochInEra (HasCallStack => EpochNo -> EpochNo -> Word64
EpochNo -> EpochNo -> Word64
countEpochs EpochNo
e (Bound -> EpochNo
boundEpoch Bound
eraStart))
go (ERelToAbsTime Expr Identity TimeInEra
expr) = do
TimeInEra
t <- Expr Identity TimeInEra -> Maybe TimeInEra
forall a. Expr Identity a -> Maybe a
go Expr Identity TimeInEra
expr
let absTime :: RelativeTime
absTime = TimeInEra -> NominalDiffTime
getTimeInEra TimeInEra
t NominalDiffTime -> RelativeTime -> RelativeTime
`addRelTime` Bound -> RelativeTime
boundTime Bound
eraStart
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> RelativeTime
absTime RelativeTime -> RelativeTime -> Bool
forall a. Ord a => a -> a -> Bool
<= Bound -> RelativeTime
boundTime Bound
end
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
RelativeTime
absTime
go (ERelToAbsSlot Expr Identity (SlotInEra, TimeInSlot)
expr) = do
(SlotInEra
s, TimeInSlot
t) <- Expr Identity (SlotInEra, TimeInSlot)
-> Maybe (SlotInEra, TimeInSlot)
forall a. Expr Identity a -> Maybe a
go Expr Identity (SlotInEra, TimeInSlot)
expr
let absSlot :: SlotNo
absSlot = Word64 -> SlotNo -> SlotNo
addSlots (SlotInEra -> Word64
getSlotInEra SlotInEra
s) (Bound -> SlotNo
boundSlot Bound
eraStart)
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> SlotNo
absSlot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> SlotNo
boundSlot Bound
end
Bool -> Bool -> Bool
|| SlotNo
absSlot SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== Bound -> SlotNo
boundSlot Bound
end Bool -> Bool -> Bool
&& TimeInSlot -> NominalDiffTime
getTimeInSlot TimeInSlot
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
== NominalDiffTime
0
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
SlotNo
absSlot
go (ERelToAbsEpoch Expr Identity (EpochInEra, SlotInEpoch)
expr) = do
(EpochInEra
e, SlotInEpoch
s) <- Expr Identity (EpochInEra, SlotInEpoch)
-> Maybe (EpochInEra, SlotInEpoch)
forall a. Expr Identity a -> Maybe a
go Expr Identity (EpochInEra, SlotInEpoch)
expr
let absEpoch :: EpochNo
absEpoch = Word64 -> EpochNo -> EpochNo
addEpochs (EpochInEra -> Word64
getEpochInEra EpochInEra
e) (Bound -> EpochNo
boundEpoch Bound
eraStart)
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> EpochNo
absEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> EpochNo
boundEpoch Bound
end
Bool -> Bool -> Bool
|| EpochNo
absEpoch EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== Bound -> EpochNo
boundEpoch Bound
end Bool -> Bool -> Bool
&& SlotInEpoch -> Word64
getSlotInEpoch SlotInEpoch
s Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
EpochNo
absEpoch
go (ERelTimeToSlot Expr Identity TimeInEra
expr) = do
TimeInEra
t <- Expr Identity TimeInEra -> Maybe TimeInEra
forall a. Expr Identity a -> Maybe a
go Expr Identity TimeInEra
expr
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (Word64 -> SlotInEra)
-> (NominalDiffTime -> TimeInSlot)
-> (Word64, NominalDiffTime)
-> (SlotInEra, TimeInSlot)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Word64 -> SlotInEra
SlotInEra NominalDiffTime -> TimeInSlot
TimeInSlot (TimeInEra -> NominalDiffTime
getTimeInEra TimeInEra
t NominalDiffTime -> NominalDiffTime -> (Word64, NominalDiffTime)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
`divMod'` NominalDiffTime
slotLen)
go (ERelSlotToTime Expr Identity SlotInEra
expr) = do
SlotInEra
s <- Expr Identity SlotInEra -> Maybe SlotInEra
forall a. Expr Identity a -> Maybe a
go Expr Identity SlotInEra
expr
TimeInEra -> Maybe TimeInEra
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeInEra -> Maybe TimeInEra) -> TimeInEra -> Maybe TimeInEra
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> TimeInEra
TimeInEra (Word64 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SlotInEra -> Word64
getSlotInEra SlotInEra
s) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
slotLen)
go (ERelSlotToEpoch Expr Identity SlotInEra
expr) = do
SlotInEra
s <- Expr Identity SlotInEra -> Maybe SlotInEra
forall a. Expr Identity a -> Maybe a
go Expr Identity SlotInEra
expr
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (Word64 -> EpochInEra)
-> (Word64 -> SlotInEpoch)
-> (Word64, Word64)
-> (EpochInEra, SlotInEpoch)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Word64 -> EpochInEra
EpochInEra Word64 -> SlotInEpoch
SlotInEpoch ((Word64, Word64) -> (EpochInEra, SlotInEpoch))
-> (Word64, Word64) -> (EpochInEra, SlotInEpoch)
forall a b. (a -> b) -> a -> b
$ SlotInEra -> Word64
getSlotInEra SlotInEra
s Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
epochSize
go (ERelEpochToSlot Expr Identity EpochInEra
expr) = do
EpochInEra
e <- Expr Identity EpochInEra -> Maybe EpochInEra
forall a. Expr Identity a -> Maybe a
go Expr Identity EpochInEra
expr
SlotInEra -> Maybe SlotInEra
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotInEra -> Maybe SlotInEra) -> SlotInEra -> Maybe SlotInEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotInEra
SlotInEra (EpochInEra -> Word64
getEpochInEra EpochInEra
e Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
epochSize)
go (ESlotLength Expr Identity SlotNo
expr) = do
SlotNo
s <- Expr Identity SlotNo -> Maybe SlotNo
forall a. Expr Identity a -> Maybe a
go Expr Identity SlotNo
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> SlotNo
boundSlot Bound
eraStart
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> SlotNo
boundSlot Bound
end
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
SlotLength
eraSlotLength
go (EEpochSize Expr Identity EpochNo
expr) = do
EpochNo
e <- Expr Identity EpochNo -> Maybe EpochNo
forall a. Expr Identity a -> Maybe a
go Expr Identity EpochNo
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ EpochNo
e EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> EpochNo
boundEpoch Bound
eraStart
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> EpochNo
e EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> EpochNo
boundEpoch Bound
end
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
EpochSize
eraEpochSize
go (EGenesisWindow Expr Identity SlotNo
expr) = do
SlotNo
s <- Expr Identity SlotNo -> Maybe SlotNo
forall a. Expr Identity a -> Maybe a
go Expr Identity SlotNo
expr
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= Bound -> SlotNo
boundSlot Bound
eraStart
(Bound -> Bool) -> Maybe ()
guardEnd ((Bound -> Bool) -> Maybe ()) -> (Bound -> Bool) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Bound
end -> SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> SlotNo
boundSlot Bound
end
a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
GenesisWindow
eraGenesisWin
data PastHorizonException = PastHorizon {
PastHorizonException -> CallStack
pastHorizonCallStack :: CallStack
, PastHorizonException -> Some ClosedExpr
pastHorizonExpression :: Some ClosedExpr
, PastHorizonException -> [EraSummary]
pastHorizonSummary :: [EraSummary]
}
deriving instance Show PastHorizonException
instance Exception PastHorizonException
runQuery ::
forall a xs. HasCallStack
=> Qry a -> Summary xs -> Either PastHorizonException a
runQuery :: forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
runQuery Qry a
qry (Summary NonEmpty xs EraSummary
summary) = NonEmpty xs EraSummary -> Either PastHorizonException a
forall (xs' :: [*]).
NonEmpty xs' EraSummary -> Either PastHorizonException a
go NonEmpty xs EraSummary
summary
where
go :: NonEmpty xs' EraSummary -> Either PastHorizonException a
go :: forall (xs' :: [*]).
NonEmpty xs' EraSummary -> Either PastHorizonException a
go (NonEmptyOne EraSummary
era) = EraSummary -> Qry a -> Either PastHorizonException a
forall b. EraSummary -> Qry b -> Either PastHorizonException b
tryEra EraSummary
era Qry a
qry
go (NonEmptyCons EraSummary
era NonEmpty xs1 EraSummary
eras) = case EraSummary -> Qry a -> Either PastHorizonException a
forall b. EraSummary -> Qry b -> Either PastHorizonException b
tryEra EraSummary
era Qry a
qry of
Left PastHorizonException
_ -> NonEmpty xs1 EraSummary -> Either PastHorizonException a
forall (xs' :: [*]).
NonEmpty xs' EraSummary -> Either PastHorizonException a
go NonEmpty xs1 EraSummary
eras
Right a
x -> a -> Either PastHorizonException a
forall a b. b -> Either a b
Right a
x
tryEra :: forall b. EraSummary -> Qry b -> Either PastHorizonException b
tryEra :: forall b. EraSummary -> Qry b -> Either PastHorizonException b
tryEra EraSummary
era = \case
QPure b
x -> b -> Either PastHorizonException b
forall a b. b -> Either a b
Right b
x
QExpr ClosedExpr a
e a -> Qry b
k ->
case EraSummary -> ClosedExpr a -> Maybe a
forall a. EraSummary -> ClosedExpr a -> Maybe a
evalExprInEra EraSummary
era ClosedExpr a
e of
Just a
x ->
EraSummary -> Qry b -> Either PastHorizonException b
forall b. EraSummary -> Qry b -> Either PastHorizonException b
tryEra EraSummary
era (a -> Qry b
k a
x)
Maybe a
Nothing ->
PastHorizonException -> Either PastHorizonException b
forall a b. a -> Either a b
Left (PastHorizonException -> Either PastHorizonException b)
-> PastHorizonException -> Either PastHorizonException b
forall a b. (a -> b) -> a -> b
$ CallStack
-> Some ClosedExpr -> [EraSummary] -> PastHorizonException
PastHorizon CallStack
HasCallStack => CallStack
callStack (ClosedExpr a -> Some ClosedExpr
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some ClosedExpr a
e) (NonEmpty xs EraSummary -> [EraSummary]
forall a. NonEmpty xs a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty xs EraSummary
summary)
runQueryThrow :: (HasCallStack, MonadThrow m) => Qry a -> Summary xs -> m a
runQueryThrow :: forall (m :: * -> *) a (xs :: [*]).
(HasCallStack, MonadThrow m) =>
Qry a -> Summary xs -> m a
runQueryThrow Qry a
q = (PastHorizonException -> m a)
-> (a -> m a) -> Either PastHorizonException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PastHorizonException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PastHorizonException a -> m a)
-> (Summary xs -> Either PastHorizonException a)
-> Summary xs
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qry a -> Summary xs -> Either PastHorizonException a
forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
runQuery Qry a
q
runQueryPure :: HasCallStack => Qry a -> Summary xs -> a
runQueryPure :: forall a (xs :: [*]). HasCallStack => Qry a -> Summary xs -> a
runQueryPure Qry a
q = (PastHorizonException -> a)
-> (a -> a) -> Either PastHorizonException a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PastHorizonException -> a
forall a e. Exception e => e -> a
throw a -> a
forall a. a -> a
id (Either PastHorizonException a -> a)
-> (Summary xs -> Either PastHorizonException a) -> Summary xs -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qry a -> Summary xs -> Either PastHorizonException a
forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
runQuery Qry a
q
newtype Interpreter xs = Interpreter (Summary xs)
deriving (Interpreter xs -> Interpreter xs -> Bool
(Interpreter xs -> Interpreter xs -> Bool)
-> (Interpreter xs -> Interpreter xs -> Bool)
-> Eq (Interpreter xs)
forall (xs :: [*]). Interpreter xs -> Interpreter xs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (xs :: [*]). Interpreter xs -> Interpreter xs -> Bool
== :: Interpreter xs -> Interpreter xs -> Bool
$c/= :: forall (xs :: [*]). Interpreter xs -> Interpreter xs -> Bool
/= :: Interpreter xs -> Interpreter xs -> Bool
Eq)
deriving instance (SListI xs, Given EraParamsFormat) => Serialise (Interpreter xs)
instance Show (Interpreter xs) where
show :: Interpreter xs -> String
show Interpreter xs
_ = String
"<Interpreter>"
mkInterpreter :: Summary xs -> Interpreter xs
mkInterpreter :: forall (xs :: [*]). Summary xs -> Interpreter xs
mkInterpreter = Summary xs -> Interpreter xs
forall (xs :: [*]). Summary xs -> Interpreter xs
Interpreter
interpretQuery ::
HasCallStack
=> Interpreter xs
-> Qry a
-> Either PastHorizonException a
interpretQuery :: forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
interpretQuery (Interpreter Summary xs
summary) Qry a
qry = Qry a -> Summary xs -> Either PastHorizonException a
forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
runQuery Qry a
qry Summary xs
summary
unsafeExtendSafeZone :: Interpreter xs -> Interpreter xs
unsafeExtendSafeZone :: forall (xs :: [*]). Interpreter xs -> Interpreter xs
unsafeExtendSafeZone (Interpreter (Summary NonEmpty xs EraSummary
eraSummaries)) =
Summary xs -> Interpreter xs
forall (xs :: [*]). Summary xs -> Interpreter xs
Interpreter (NonEmpty xs EraSummary -> Summary xs
forall (xs :: [*]). NonEmpty xs EraSummary -> Summary xs
Summary (NonEmpty xs EraSummary -> NonEmpty xs EraSummary
forall (xs' :: [*]).
NonEmpty xs' EraSummary -> NonEmpty xs' EraSummary
go NonEmpty xs EraSummary
eraSummaries))
where
go :: NonEmpty xs' EraSummary -> NonEmpty xs' EraSummary
go :: forall (xs' :: [*]).
NonEmpty xs' EraSummary -> NonEmpty xs' EraSummary
go (NonEmptyCons EraSummary
e NonEmpty xs1 EraSummary
es) = EraSummary
-> NonEmpty xs1 EraSummary -> NonEmpty (x : xs1) EraSummary
forall a (xs1 :: [*]) x.
a -> NonEmpty xs1 a -> NonEmpty (x : xs1) a
NonEmptyCons EraSummary
e (NonEmpty xs1 EraSummary -> NonEmpty xs1 EraSummary
forall (xs' :: [*]).
NonEmpty xs' EraSummary -> NonEmpty xs' EraSummary
go NonEmpty xs1 EraSummary
es)
go (NonEmptyOne EraSummary
e) = EraSummary -> NonEmpty (x : xs1) EraSummary
forall a x (xs1 :: [*]). a -> NonEmpty (x : xs1) a
NonEmptyOne EraSummary
e { eraEnd = EraUnbounded }
wallclockToSlot :: RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
wallclockToSlot :: RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
wallclockToSlot RelativeTime
absTime =
(TimeInSlot, (SlotNo, SlotLength))
-> (SlotNo, NominalDiffTime, NominalDiffTime)
aux ((TimeInSlot, (SlotNo, SlotLength))
-> (SlotNo, NominalDiffTime, NominalDiffTime))
-> Qry (TimeInSlot, (SlotNo, SlotLength))
-> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Qry (TimeInSlot, (SlotNo, SlotLength))
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (RelativeTime -> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall (f :: * -> *).
RelativeTime -> Expr f (TimeInSlot, (SlotNo, SlotLength))
wallclockToSlotExpr RelativeTime
absTime)
where
aux :: (TimeInSlot, (SlotNo, SlotLength))
-> (SlotNo, NominalDiffTime, NominalDiffTime)
aux :: (TimeInSlot, (SlotNo, SlotLength))
-> (SlotNo, NominalDiffTime, NominalDiffTime)
aux (TimeInSlot NominalDiffTime
timeInSlot, (SlotNo
absSlot, SlotLength
slotLen)) = (
SlotNo
absSlot
, NominalDiffTime
timeInSlot
, SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLen NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
timeInSlot
)
slotToWallclock :: SlotNo -> Qry (RelativeTime, SlotLength)
slotToWallclock :: SlotNo -> Qry (RelativeTime, SlotLength)
slotToWallclock SlotNo
absSlot =
(forall (f :: * -> *). Expr f (RelativeTime, SlotLength))
-> Qry (RelativeTime, SlotLength)
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (SlotNo -> Expr f (RelativeTime, SlotLength)
forall (f :: * -> *). SlotNo -> Expr f (RelativeTime, SlotLength)
slotToWallclockExpr SlotNo
absSlot)
slotToSlotLength :: SlotNo -> Qry SlotLength
slotToSlotLength :: SlotNo -> Qry SlotLength
slotToSlotLength SlotNo
absSlot =
(forall (f :: * -> *). Expr f SlotLength) -> Qry SlotLength
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (SlotNo -> Expr f SlotLength
forall (f :: * -> *). SlotNo -> Expr f SlotLength
slotToSlotLengthExpr SlotNo
absSlot)
slotToEpoch' :: SlotNo -> Qry (EpochNo, Word64)
slotToEpoch' :: SlotNo -> Qry (EpochNo, Word64)
slotToEpoch' SlotNo
absSlot =
(SlotInEpoch -> Word64)
-> (EpochNo, SlotInEpoch) -> (EpochNo, Word64)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SlotInEpoch -> Word64
getSlotInEpoch ((EpochNo, SlotInEpoch) -> (EpochNo, Word64))
-> Qry (EpochNo, SlotInEpoch) -> Qry (EpochNo, Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Expr f (EpochNo, SlotInEpoch))
-> Qry (EpochNo, SlotInEpoch)
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (SlotNo -> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *). SlotNo -> Expr f (EpochNo, SlotInEpoch)
slotToEpochExpr' SlotNo
absSlot)
slotToEpoch :: SlotNo -> Qry (EpochNo, Word64, Word64)
slotToEpoch :: SlotNo -> Qry (EpochNo, Word64, Word64)
slotToEpoch SlotNo
absSlot =
((EpochNo, SlotInEpoch), EpochSize) -> (EpochNo, Word64, Word64)
aux (((EpochNo, SlotInEpoch), EpochSize) -> (EpochNo, Word64, Word64))
-> Qry ((EpochNo, SlotInEpoch), EpochSize)
-> Qry (EpochNo, Word64, Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Expr f ((EpochNo, SlotInEpoch), EpochSize))
-> Qry ((EpochNo, SlotInEpoch), EpochSize)
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (SlotNo -> Expr f ((EpochNo, SlotInEpoch), EpochSize)
forall (f :: * -> *).
SlotNo -> Expr f ((EpochNo, SlotInEpoch), EpochSize)
slotToEpochExpr SlotNo
absSlot)
where
aux :: ((EpochNo, SlotInEpoch), EpochSize)
-> (EpochNo, Word64, Word64)
aux :: ((EpochNo, SlotInEpoch), EpochSize) -> (EpochNo, Word64, Word64)
aux ((EpochNo
absEpoch, SlotInEpoch Word64
slotInEpoch), EpochSize
epochSize) = (
EpochNo
absEpoch
, Word64
slotInEpoch
, EpochSize -> Word64
unEpochSize EpochSize
epochSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
slotInEpoch
)
epochToSlot' :: EpochNo -> Qry SlotNo
epochToSlot' :: EpochNo -> Qry SlotNo
epochToSlot' EpochNo
absEpoch =
(forall (f :: * -> *). Expr f SlotNo) -> Qry SlotNo
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (EpochNo -> Expr f SlotNo
forall (f :: * -> *). EpochNo -> Expr f SlotNo
epochToSlotExpr' EpochNo
absEpoch)
epochToSlot :: EpochNo -> Qry (SlotNo, EpochSize)
epochToSlot :: EpochNo -> Qry (SlotNo, EpochSize)
epochToSlot EpochNo
absEpoch =
(forall (f :: * -> *). Expr f (SlotNo, EpochSize))
-> Qry (SlotNo, EpochSize)
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (EpochNo -> Expr f (SlotNo, EpochSize)
forall (f :: * -> *). EpochNo -> Expr f (SlotNo, EpochSize)
epochToSlotExpr EpochNo
absEpoch)
epochToSize :: EpochNo -> Qry EpochSize
epochToSize :: EpochNo -> Qry EpochSize
epochToSize EpochNo
absEpoch =
(forall (f :: * -> *). Expr f EpochSize) -> Qry EpochSize
forall a. (forall (f :: * -> *). Expr f a) -> Qry a
qryFromExpr (EpochNo -> Expr f EpochSize
forall (f :: * -> *). EpochNo -> Expr f EpochSize
epochToSizeExpr EpochNo
absEpoch)
wallclockToSlotExpr :: RelativeTime -> Expr f (TimeInSlot, (SlotNo, SlotLength))
wallclockToSlotExpr :: forall (f :: * -> *).
RelativeTime -> Expr f (TimeInSlot, (SlotNo, SlotLength))
wallclockToSlotExpr RelativeTime
absTime =
Expr f (SlotInEra, TimeInSlot)
-> (f (SlotInEra, TimeInSlot)
-> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall (f :: * -> *) b b. Expr f b -> (f b -> Expr f b) -> Expr f b
ELet (Expr f TimeInEra -> Expr f (SlotInEra, TimeInSlot)
forall (f :: * -> *).
Expr f TimeInEra -> Expr f (SlotInEra, TimeInSlot)
ERelTimeToSlot (Expr f RelativeTime -> Expr f TimeInEra
forall (f :: * -> *). Expr f RelativeTime -> Expr f TimeInEra
EAbsToRelTime (RelativeTime -> Expr f RelativeTime
forall a (f :: * -> *). Show a => a -> Expr f a
ELit RelativeTime
absTime))) ((f (SlotInEra, TimeInSlot)
-> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> (f (SlotInEra, TimeInSlot)
-> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall a b. (a -> b) -> a -> b
$ \f (SlotInEra, TimeInSlot)
relSlot ->
Expr f SlotNo
-> (f SlotNo -> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall (f :: * -> *) b b. Expr f b -> (f b -> Expr f b) -> Expr f b
ELet (Expr f (SlotInEra, TimeInSlot) -> Expr f SlotNo
forall (f :: * -> *).
Expr f (SlotInEra, TimeInSlot) -> Expr f SlotNo
ERelToAbsSlot (f (SlotInEra, TimeInSlot) -> Expr f (SlotInEra, TimeInSlot)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (SlotInEra, TimeInSlot)
relSlot)) ((f SlotNo -> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> (f SlotNo -> Expr f (TimeInSlot, (SlotNo, SlotLength)))
-> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall a b. (a -> b) -> a -> b
$ \f SlotNo
absSlot ->
Expr f TimeInSlot
-> Expr f (SlotNo, SlotLength)
-> Expr f (TimeInSlot, (SlotNo, SlotLength))
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (Expr f (SlotInEra, TimeInSlot) -> Expr f TimeInSlot
forall (f :: * -> *) b b. Expr f (b, b) -> Expr f b
ESnd (f (SlotInEra, TimeInSlot) -> Expr f (SlotInEra, TimeInSlot)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (SlotInEra, TimeInSlot)
relSlot))
(Expr f SlotNo -> Expr f SlotLength -> Expr f (SlotNo, SlotLength)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (f SlotNo -> Expr f SlotNo
forall (f :: * -> *) a. f a -> Expr f a
EVar f SlotNo
absSlot) (Expr f SlotNo -> Expr f SlotLength
forall (f :: * -> *). Expr f SlotNo -> Expr f SlotLength
ESlotLength (f SlotNo -> Expr f SlotNo
forall (f :: * -> *) a. f a -> Expr f a
EVar f SlotNo
absSlot)))
slotToWallclockExpr :: SlotNo -> Expr f (RelativeTime, SlotLength)
slotToWallclockExpr :: forall (f :: * -> *). SlotNo -> Expr f (RelativeTime, SlotLength)
slotToWallclockExpr SlotNo
absSlot =
Expr f RelativeTime
-> Expr f SlotLength -> Expr f (RelativeTime, SlotLength)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair
(Expr f TimeInEra -> Expr f RelativeTime
forall (f :: * -> *). Expr f TimeInEra -> Expr f RelativeTime
ERelToAbsTime (Expr f SlotInEra -> Expr f TimeInEra
forall (f :: * -> *). Expr f SlotInEra -> Expr f TimeInEra
ERelSlotToTime (Expr f SlotNo -> Expr f SlotInEra
forall (f :: * -> *). Expr f SlotNo -> Expr f SlotInEra
EAbsToRelSlot (SlotNo -> Expr f SlotNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit SlotNo
absSlot))))
(Expr f SlotNo -> Expr f SlotLength
forall (f :: * -> *). Expr f SlotNo -> Expr f SlotLength
ESlotLength (SlotNo -> Expr f SlotNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit SlotNo
absSlot))
slotToSlotLengthExpr :: SlotNo -> Expr f SlotLength
slotToSlotLengthExpr :: forall (f :: * -> *). SlotNo -> Expr f SlotLength
slotToSlotLengthExpr SlotNo
absSlot = Expr f SlotNo -> Expr f SlotLength
forall (f :: * -> *). Expr f SlotNo -> Expr f SlotLength
ESlotLength (SlotNo -> Expr f SlotNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit SlotNo
absSlot)
slotToEpochExpr' :: SlotNo -> Expr f (EpochNo, SlotInEpoch)
slotToEpochExpr' :: forall (f :: * -> *). SlotNo -> Expr f (EpochNo, SlotInEpoch)
slotToEpochExpr' SlotNo
absSlot =
Expr f (EpochInEra, SlotInEpoch)
-> (f (EpochInEra, SlotInEpoch) -> Expr f (EpochNo, SlotInEpoch))
-> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *) b b. Expr f b -> (f b -> Expr f b) -> Expr f b
ELet (Expr f SlotInEra -> Expr f (EpochInEra, SlotInEpoch)
forall (f :: * -> *).
Expr f SlotInEra -> Expr f (EpochInEra, SlotInEpoch)
ERelSlotToEpoch (Expr f SlotNo -> Expr f SlotInEra
forall (f :: * -> *). Expr f SlotNo -> Expr f SlotInEra
EAbsToRelSlot (SlotNo -> Expr f SlotNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit SlotNo
absSlot))) ((f (EpochInEra, SlotInEpoch) -> Expr f (EpochNo, SlotInEpoch))
-> Expr f (EpochNo, SlotInEpoch))
-> (f (EpochInEra, SlotInEpoch) -> Expr f (EpochNo, SlotInEpoch))
-> Expr f (EpochNo, SlotInEpoch)
forall a b. (a -> b) -> a -> b
$ \f (EpochInEra, SlotInEpoch)
epochSlot ->
Expr f EpochNo
-> Expr f SlotInEpoch -> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (Expr f (EpochInEra, SlotInEpoch) -> Expr f EpochNo
forall (f :: * -> *).
Expr f (EpochInEra, SlotInEpoch) -> Expr f EpochNo
ERelToAbsEpoch (f (EpochInEra, SlotInEpoch) -> Expr f (EpochInEra, SlotInEpoch)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (EpochInEra, SlotInEpoch)
epochSlot)) (Expr f (EpochInEra, SlotInEpoch) -> Expr f SlotInEpoch
forall (f :: * -> *) b b. Expr f (b, b) -> Expr f b
ESnd (f (EpochInEra, SlotInEpoch) -> Expr f (EpochInEra, SlotInEpoch)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (EpochInEra, SlotInEpoch)
epochSlot))
slotToEpochExpr ::
SlotNo
-> Expr f ((EpochNo, SlotInEpoch), EpochSize)
slotToEpochExpr :: forall (f :: * -> *).
SlotNo -> Expr f ((EpochNo, SlotInEpoch), EpochSize)
slotToEpochExpr SlotNo
absSlot =
Expr f (EpochNo, SlotInEpoch)
-> (f (EpochNo, SlotInEpoch)
-> Expr f ((EpochNo, SlotInEpoch), EpochSize))
-> Expr f ((EpochNo, SlotInEpoch), EpochSize)
forall (f :: * -> *) b b. Expr f b -> (f b -> Expr f b) -> Expr f b
ELet (SlotNo -> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *). SlotNo -> Expr f (EpochNo, SlotInEpoch)
slotToEpochExpr' SlotNo
absSlot) ((f (EpochNo, SlotInEpoch)
-> Expr f ((EpochNo, SlotInEpoch), EpochSize))
-> Expr f ((EpochNo, SlotInEpoch), EpochSize))
-> (f (EpochNo, SlotInEpoch)
-> Expr f ((EpochNo, SlotInEpoch), EpochSize))
-> Expr f ((EpochNo, SlotInEpoch), EpochSize)
forall a b. (a -> b) -> a -> b
$ \f (EpochNo, SlotInEpoch)
x ->
Expr f (EpochNo, SlotInEpoch)
-> Expr f EpochSize -> Expr f ((EpochNo, SlotInEpoch), EpochSize)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (f (EpochNo, SlotInEpoch) -> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (EpochNo, SlotInEpoch)
x) (Expr f EpochNo -> Expr f EpochSize
forall (f :: * -> *). Expr f EpochNo -> Expr f EpochSize
EEpochSize (Expr f (EpochNo, SlotInEpoch) -> Expr f EpochNo
forall (f :: * -> *) a b. Expr f (a, b) -> Expr f a
EFst (f (EpochNo, SlotInEpoch) -> Expr f (EpochNo, SlotInEpoch)
forall (f :: * -> *) a. f a -> Expr f a
EVar f (EpochNo, SlotInEpoch)
x)))
epochToSlotExpr' :: EpochNo -> Expr f SlotNo
epochToSlotExpr' :: forall (f :: * -> *). EpochNo -> Expr f SlotNo
epochToSlotExpr' EpochNo
absEpoch =
Expr f (SlotInEra, TimeInSlot) -> Expr f SlotNo
forall (f :: * -> *).
Expr f (SlotInEra, TimeInSlot) -> Expr f SlotNo
ERelToAbsSlot (Expr f SlotInEra
-> Expr f TimeInSlot -> Expr f (SlotInEra, TimeInSlot)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (Expr f EpochInEra -> Expr f SlotInEra
forall (f :: * -> *). Expr f EpochInEra -> Expr f SlotInEra
ERelEpochToSlot (Expr f EpochNo -> Expr f EpochInEra
forall (f :: * -> *). Expr f EpochNo -> Expr f EpochInEra
EAbsToRelEpoch (EpochNo -> Expr f EpochNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit EpochNo
absEpoch)))
(TimeInSlot -> Expr f TimeInSlot
forall a (f :: * -> *). Show a => a -> Expr f a
ELit (NominalDiffTime -> TimeInSlot
TimeInSlot NominalDiffTime
0)))
epochToSlotExpr :: EpochNo -> Expr f (SlotNo, EpochSize)
epochToSlotExpr :: forall (f :: * -> *). EpochNo -> Expr f (SlotNo, EpochSize)
epochToSlotExpr EpochNo
absEpoch =
Expr f SlotNo -> Expr f EpochSize -> Expr f (SlotNo, EpochSize)
forall (f :: * -> *) b b. Expr f b -> Expr f b -> Expr f (b, b)
EPair (EpochNo -> Expr f SlotNo
forall (f :: * -> *). EpochNo -> Expr f SlotNo
epochToSlotExpr' EpochNo
absEpoch) (EpochNo -> Expr f EpochSize
forall (f :: * -> *). EpochNo -> Expr f EpochSize
epochToSizeExpr EpochNo
absEpoch)
epochToSizeExpr :: EpochNo -> Expr f EpochSize
epochToSizeExpr :: forall (f :: * -> *). EpochNo -> Expr f EpochSize
epochToSizeExpr EpochNo
absEpoch =
Expr f EpochNo -> Expr f EpochSize
forall (f :: * -> *). Expr f EpochNo -> Expr f EpochSize
EEpochSize (EpochNo -> Expr f EpochNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit EpochNo
absEpoch)
slotToGenesisWindow :: SlotNo -> Expr f GenesisWindow
slotToGenesisWindow :: forall (f :: * -> *). SlotNo -> Expr f GenesisWindow
slotToGenesisWindow SlotNo
absSlot =
Expr f SlotNo -> Expr f GenesisWindow
forall (f :: * -> *). Expr f SlotNo -> Expr f GenesisWindow
EGenesisWindow (SlotNo -> Expr f SlotNo
forall a (f :: * -> *). Show a => a -> Expr f a
ELit SlotNo
absSlot)
newtype Var a = Var String
deriving (Int -> Var a -> ShowS
[Var a] -> ShowS
Var a -> String
(Int -> Var a -> ShowS)
-> (Var a -> String) -> ([Var a] -> ShowS) -> Show (Var a)
forall a. Int -> Var a -> ShowS
forall a. [Var a] -> ShowS
forall a. Var a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Var a -> ShowS
showsPrec :: Int -> Var a -> ShowS
$cshow :: forall a. Var a -> String
show :: Var a -> String
$cshowList :: forall a. [Var a] -> ShowS
showList :: [Var a] -> ShowS
Show)
deriving instance Show (Some ClosedExpr)
instance Show (ClosedExpr a) where
showsPrec :: Int -> ClosedExpr a -> ShowS
showsPrec = \Int
d (ClosedExpr forall (f :: * -> *). Expr f a
e) -> Int -> Int -> Expr Var a -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
0 Int
d Expr Var a
forall (f :: * -> *). Expr f a
e
where
go :: Int
-> Int
-> Expr Var b -> ShowS
go :: forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
d = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> (Expr Var b -> ShowS) -> Expr Var b -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
EVar (Var String
x) -> String -> ShowS
showString String
"EVar " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
x
ELet Expr Var a
e Var a -> Expr Var b
f -> let x :: String
x = String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n in
String -> ShowS
showString String
"ELet "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var a -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var a
e
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" (\\"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
x
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" -> "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var b -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 (Var a -> Expr Var b
f (String -> Var a
forall a. String -> Var a
Var String
x))
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
ELit b
i -> String -> ShowS
showString String
"ELit " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 b
i
EPair Expr Var a
e Expr Var b
e' -> String -> ShowS
showString String
"EPair " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var a -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var a
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var b -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var b
e'
EFst Expr Var (b, b)
e -> String -> ShowS
showString String
"EFst " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var (b, b) -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var (b, b)
e
ESnd Expr Var (a, b)
e -> String -> ShowS
showString String
"ESnd " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var (a, b) -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var (a, b)
e
EAbsToRelTime Expr Var RelativeTime
e -> String -> ShowS
showString String
"EAbsToRelTime " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var RelativeTime -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var RelativeTime
e
EAbsToRelSlot Expr Var SlotNo
e -> String -> ShowS
showString String
"EAbsToRelSlot " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var SlotNo -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var SlotNo
e
EAbsToRelEpoch Expr Var EpochNo
e -> String -> ShowS
showString String
"EAbsToRelEpoch " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var EpochNo -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var EpochNo
e
ERelToAbsTime Expr Var TimeInEra
e -> String -> ShowS
showString String
"ERelToAbsTime " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var TimeInEra -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var TimeInEra
e
ERelToAbsSlot Expr Var (SlotInEra, TimeInSlot)
e -> String -> ShowS
showString String
"ERelToAbsSlot " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var (SlotInEra, TimeInSlot) -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var (SlotInEra, TimeInSlot)
e
ERelToAbsEpoch Expr Var (EpochInEra, SlotInEpoch)
e -> String -> ShowS
showString String
"ERelToAbsEpoch " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var (EpochInEra, SlotInEpoch) -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var (EpochInEra, SlotInEpoch)
e
ERelTimeToSlot Expr Var TimeInEra
e -> String -> ShowS
showString String
"ERelTimeToSlot " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var TimeInEra -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var TimeInEra
e
ERelSlotToTime Expr Var SlotInEra
e -> String -> ShowS
showString String
"ERelSlotToTime " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var SlotInEra -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var SlotInEra
e
ERelSlotToEpoch Expr Var SlotInEra
e -> String -> ShowS
showString String
"ERelSlotToEpoch " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var SlotInEra -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var SlotInEra
e
ERelEpochToSlot Expr Var EpochInEra
e -> String -> ShowS
showString String
"ERelEpochToSlot " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var EpochInEra -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var EpochInEra
e
ESlotLength Expr Var SlotNo
e -> String -> ShowS
showString String
"ESlotLength " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var SlotNo -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var SlotNo
e
EEpochSize Expr Var EpochNo
e -> String -> ShowS
showString String
"EEpochSize " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var EpochNo -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var EpochNo
e
EGenesisWindow Expr Var SlotNo
e -> String -> ShowS
showString String
"EGenesisWindow " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Expr Var SlotNo -> ShowS
forall b. Int -> Int -> Expr Var b -> ShowS
go Int
n Int
11 Expr Var SlotNo
e