{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Consensus.HardFork.History.Caching
( RunWithCachedSummary (..)
, runWithCachedSummary
) where
import Data.Kind (Type)
import Ouroboros.Consensus.HardFork.History.Qry
import Ouroboros.Consensus.HardFork.History.Summary
import Ouroboros.Consensus.Util.IOLike
data RunWithCachedSummary (xs :: [Type]) m = RunWithCachedSummary
{ forall (xs :: [*]) (m :: * -> *).
RunWithCachedSummary xs m
-> forall a. Qry a -> STM m (Either PastHorizonException a)
cachedRunQuery ::
forall a.
Qry a ->
STM m (Either PastHorizonException a)
}
runWithCachedSummary ::
forall m xs.
MonadSTM m =>
STM m (Summary xs) ->
m (RunWithCachedSummary xs m)
runWithCachedSummary :: forall (m :: * -> *) (xs :: [*]).
MonadSTM m =>
STM m (Summary xs) -> m (RunWithCachedSummary xs m)
runWithCachedSummary STM m (Summary xs)
getLatestSummary = do
initSummary <- STM m (Summary xs) -> m (Summary xs)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (Summary xs)
getLatestSummary
var <- newTVarIO initSummary
return $ RunWithCachedSummary{cachedRunQuery = go var}
where
go ::
StrictTVar m (Summary xs) ->
Qry a ->
STM m (Either PastHorizonException a)
go :: forall a.
StrictTVar m (Summary xs)
-> Qry a -> STM m (Either PastHorizonException a)
go StrictTVar m (Summary xs)
var Qry a
q = do
summary <- StrictTVar m (Summary xs) -> STM m (Summary xs)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (Summary xs)
var
case runQuery q summary of
Right a
a -> Either PastHorizonException a
-> STM m (Either PastHorizonException a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either PastHorizonException a
forall a b. b -> Either a b
Right a
a)
Left PastHorizon{} -> do
summary' <- STM m (Summary xs)
getLatestSummary
writeTVar var summary'
return $ runQuery q summary'