{-# 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

{-------------------------------------------------------------------------------
  Caching the summary
-------------------------------------------------------------------------------}

-- | Stateful abstraction to execute queries
data RunWithCachedSummary (xs :: [Type]) m = RunWithCachedSummary {
      -- | Run the specified query
      --
      -- If the query fails with a 'PastHorizonException', it will update its
      -- internal state (compute a new summary) and try again. If that /still/
      -- fails, the 'PastHorizonException' is returned.
      --
      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)
    }

-- | Construct 'RunWithCachedSummary' given action that computes the summary
--
-- Most use cases will probably construct this action from an action that reads
-- the ledger state and then computes the summary from that.
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'