{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Plutus.Contract.Checkpoint( -- * Checkpoints -- $checkpoints Checkpoint(..) , CheckpointError(..) , AsCheckpointError(..) , CheckpointStore(..) , CheckpointStoreItem(..) , CheckpointKey , CheckpointLogMsg(..) , jsonCheckpoint , jsonCheckpointLoop , handleCheckpoint , completedIntervals , maxKey ) where import Control.Lens import Control.Monad.Freer import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logError) import Control.Monad.Freer.State (State, get, gets, modify, put) import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, Value) import Data.Aeson.Types qualified as JSON import Data.IntervalMap.Interval (Interval (ClosedInterval)) import Data.IntervalSet qualified as IS import Data.Map (Map) import Data.Map qualified as Map import Data.Text (Text) import Data.Text qualified as Text import GHC.Generics (Generic) import Prettyprinter (Pretty (..), colon, vsep, (<+>)) -- $checkpoints -- This module contains a checkpoints mechanism that can be used to store -- intermediate results of 'Control.Monad.Freer.Eff' programs as JSON values -- inside a 'CheckpointStore'. It works similar to the short-circuiting behavior -- of 'Control.Monad.Freer.Error.Error': Before we execute an action -- @Eff effs a@ whose result should be checkpointed, we check if the there is -- already a value of @a@ for this checkpoint it in the store. If there is, we -- return it /instead/ of running the action. If there isn't, we run the action -- @a@ and then store the result. -- -- * To create a checkpoint use 'jsonCheckpoint'. -- * To handle the checkpoint effect use 'handleCheckpoint'. newtype CheckpointKey = CheckpointKey Integer deriving stock (CheckpointKey -> CheckpointKey -> Bool (CheckpointKey -> CheckpointKey -> Bool) -> (CheckpointKey -> CheckpointKey -> Bool) -> Eq CheckpointKey forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckpointKey -> CheckpointKey -> Bool $c/= :: CheckpointKey -> CheckpointKey -> Bool == :: CheckpointKey -> CheckpointKey -> Bool $c== :: CheckpointKey -> CheckpointKey -> Bool Eq, Eq CheckpointKey Eq CheckpointKey -> (CheckpointKey -> CheckpointKey -> Ordering) -> (CheckpointKey -> CheckpointKey -> Bool) -> (CheckpointKey -> CheckpointKey -> Bool) -> (CheckpointKey -> CheckpointKey -> Bool) -> (CheckpointKey -> CheckpointKey -> Bool) -> (CheckpointKey -> CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey -> CheckpointKey) -> Ord CheckpointKey CheckpointKey -> CheckpointKey -> Bool CheckpointKey -> CheckpointKey -> Ordering CheckpointKey -> CheckpointKey -> CheckpointKey forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: CheckpointKey -> CheckpointKey -> CheckpointKey $cmin :: CheckpointKey -> CheckpointKey -> CheckpointKey max :: CheckpointKey -> CheckpointKey -> CheckpointKey $cmax :: CheckpointKey -> CheckpointKey -> CheckpointKey >= :: CheckpointKey -> CheckpointKey -> Bool $c>= :: CheckpointKey -> CheckpointKey -> Bool > :: CheckpointKey -> CheckpointKey -> Bool $c> :: CheckpointKey -> CheckpointKey -> Bool <= :: CheckpointKey -> CheckpointKey -> Bool $c<= :: CheckpointKey -> CheckpointKey -> Bool < :: CheckpointKey -> CheckpointKey -> Bool $c< :: CheckpointKey -> CheckpointKey -> Bool compare :: CheckpointKey -> CheckpointKey -> Ordering $ccompare :: CheckpointKey -> CheckpointKey -> Ordering $cp1Ord :: Eq CheckpointKey Ord, Int -> CheckpointKey -> ShowS [CheckpointKey] -> ShowS CheckpointKey -> String (Int -> CheckpointKey -> ShowS) -> (CheckpointKey -> String) -> ([CheckpointKey] -> ShowS) -> Show CheckpointKey forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckpointKey] -> ShowS $cshowList :: [CheckpointKey] -> ShowS show :: CheckpointKey -> String $cshow :: CheckpointKey -> String showsPrec :: Int -> CheckpointKey -> ShowS $cshowsPrec :: Int -> CheckpointKey -> ShowS Show, (forall x. CheckpointKey -> Rep CheckpointKey x) -> (forall x. Rep CheckpointKey x -> CheckpointKey) -> Generic CheckpointKey forall x. Rep CheckpointKey x -> CheckpointKey forall x. CheckpointKey -> Rep CheckpointKey x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep CheckpointKey x -> CheckpointKey $cfrom :: forall x. CheckpointKey -> Rep CheckpointKey x Generic) deriving newtype (Value -> Parser [CheckpointKey] Value -> Parser CheckpointKey (Value -> Parser CheckpointKey) -> (Value -> Parser [CheckpointKey]) -> FromJSON CheckpointKey forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [CheckpointKey] $cparseJSONList :: Value -> Parser [CheckpointKey] parseJSON :: Value -> Parser CheckpointKey $cparseJSON :: Value -> Parser CheckpointKey FromJSON, [CheckpointKey] -> Encoding [CheckpointKey] -> Value CheckpointKey -> Encoding CheckpointKey -> Value (CheckpointKey -> Value) -> (CheckpointKey -> Encoding) -> ([CheckpointKey] -> Value) -> ([CheckpointKey] -> Encoding) -> ToJSON CheckpointKey forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [CheckpointKey] -> Encoding $ctoEncodingList :: [CheckpointKey] -> Encoding toJSONList :: [CheckpointKey] -> Value $ctoJSONList :: [CheckpointKey] -> Value toEncoding :: CheckpointKey -> Encoding $ctoEncoding :: CheckpointKey -> Encoding toJSON :: CheckpointKey -> Value $ctoJSON :: CheckpointKey -> Value ToJSON, ToJSONKeyFunction [CheckpointKey] ToJSONKeyFunction CheckpointKey ToJSONKeyFunction CheckpointKey -> ToJSONKeyFunction [CheckpointKey] -> ToJSONKey CheckpointKey forall a. ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a toJSONKeyList :: ToJSONKeyFunction [CheckpointKey] $ctoJSONKeyList :: ToJSONKeyFunction [CheckpointKey] toJSONKey :: ToJSONKeyFunction CheckpointKey $ctoJSONKey :: ToJSONKeyFunction CheckpointKey ToJSONKey, FromJSONKeyFunction [CheckpointKey] FromJSONKeyFunction CheckpointKey FromJSONKeyFunction CheckpointKey -> FromJSONKeyFunction [CheckpointKey] -> FromJSONKey CheckpointKey forall a. FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a fromJSONKeyList :: FromJSONKeyFunction [CheckpointKey] $cfromJSONKeyList :: FromJSONKeyFunction [CheckpointKey] fromJSONKey :: FromJSONKeyFunction CheckpointKey $cfromJSONKey :: FromJSONKeyFunction CheckpointKey FromJSONKey, Integer -> CheckpointKey CheckpointKey -> CheckpointKey CheckpointKey -> CheckpointKey -> CheckpointKey (CheckpointKey -> CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey) -> (Integer -> CheckpointKey) -> Num CheckpointKey forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a fromInteger :: Integer -> CheckpointKey $cfromInteger :: Integer -> CheckpointKey signum :: CheckpointKey -> CheckpointKey $csignum :: CheckpointKey -> CheckpointKey abs :: CheckpointKey -> CheckpointKey $cabs :: CheckpointKey -> CheckpointKey negate :: CheckpointKey -> CheckpointKey $cnegate :: CheckpointKey -> CheckpointKey * :: CheckpointKey -> CheckpointKey -> CheckpointKey $c* :: CheckpointKey -> CheckpointKey -> CheckpointKey - :: CheckpointKey -> CheckpointKey -> CheckpointKey $c- :: CheckpointKey -> CheckpointKey -> CheckpointKey + :: CheckpointKey -> CheckpointKey -> CheckpointKey $c+ :: CheckpointKey -> CheckpointKey -> CheckpointKey Num, Int -> CheckpointKey CheckpointKey -> Int CheckpointKey -> [CheckpointKey] CheckpointKey -> CheckpointKey CheckpointKey -> CheckpointKey -> [CheckpointKey] CheckpointKey -> CheckpointKey -> CheckpointKey -> [CheckpointKey] (CheckpointKey -> CheckpointKey) -> (CheckpointKey -> CheckpointKey) -> (Int -> CheckpointKey) -> (CheckpointKey -> Int) -> (CheckpointKey -> [CheckpointKey]) -> (CheckpointKey -> CheckpointKey -> [CheckpointKey]) -> (CheckpointKey -> CheckpointKey -> [CheckpointKey]) -> (CheckpointKey -> CheckpointKey -> CheckpointKey -> [CheckpointKey]) -> Enum CheckpointKey forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a enumFromThenTo :: CheckpointKey -> CheckpointKey -> CheckpointKey -> [CheckpointKey] $cenumFromThenTo :: CheckpointKey -> CheckpointKey -> CheckpointKey -> [CheckpointKey] enumFromTo :: CheckpointKey -> CheckpointKey -> [CheckpointKey] $cenumFromTo :: CheckpointKey -> CheckpointKey -> [CheckpointKey] enumFromThen :: CheckpointKey -> CheckpointKey -> [CheckpointKey] $cenumFromThen :: CheckpointKey -> CheckpointKey -> [CheckpointKey] enumFrom :: CheckpointKey -> [CheckpointKey] $cenumFrom :: CheckpointKey -> [CheckpointKey] fromEnum :: CheckpointKey -> Int $cfromEnum :: CheckpointKey -> Int toEnum :: Int -> CheckpointKey $ctoEnum :: Int -> CheckpointKey pred :: CheckpointKey -> CheckpointKey $cpred :: CheckpointKey -> CheckpointKey succ :: CheckpointKey -> CheckpointKey $csucc :: CheckpointKey -> CheckpointKey Enum, [CheckpointKey] -> Doc ann CheckpointKey -> Doc ann (forall ann. CheckpointKey -> Doc ann) -> (forall ann. [CheckpointKey] -> Doc ann) -> Pretty CheckpointKey forall ann. [CheckpointKey] -> Doc ann forall ann. CheckpointKey -> Doc ann forall a. (forall ann. a -> Doc ann) -> (forall ann. [a] -> Doc ann) -> Pretty a prettyList :: [CheckpointKey] -> Doc ann $cprettyList :: forall ann. [CheckpointKey] -> Doc ann pretty :: CheckpointKey -> Doc ann $cpretty :: forall ann. CheckpointKey -> Doc ann Pretty) data CheckpointError = JSONDecodeError Text deriving stock (CheckpointError -> CheckpointError -> Bool (CheckpointError -> CheckpointError -> Bool) -> (CheckpointError -> CheckpointError -> Bool) -> Eq CheckpointError forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckpointError -> CheckpointError -> Bool $c/= :: CheckpointError -> CheckpointError -> Bool == :: CheckpointError -> CheckpointError -> Bool $c== :: CheckpointError -> CheckpointError -> Bool Eq, Eq CheckpointError Eq CheckpointError -> (CheckpointError -> CheckpointError -> Ordering) -> (CheckpointError -> CheckpointError -> Bool) -> (CheckpointError -> CheckpointError -> Bool) -> (CheckpointError -> CheckpointError -> Bool) -> (CheckpointError -> CheckpointError -> Bool) -> (CheckpointError -> CheckpointError -> CheckpointError) -> (CheckpointError -> CheckpointError -> CheckpointError) -> Ord CheckpointError CheckpointError -> CheckpointError -> Bool CheckpointError -> CheckpointError -> Ordering CheckpointError -> CheckpointError -> CheckpointError forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: CheckpointError -> CheckpointError -> CheckpointError $cmin :: CheckpointError -> CheckpointError -> CheckpointError max :: CheckpointError -> CheckpointError -> CheckpointError $cmax :: CheckpointError -> CheckpointError -> CheckpointError >= :: CheckpointError -> CheckpointError -> Bool $c>= :: CheckpointError -> CheckpointError -> Bool > :: CheckpointError -> CheckpointError -> Bool $c> :: CheckpointError -> CheckpointError -> Bool <= :: CheckpointError -> CheckpointError -> Bool $c<= :: CheckpointError -> CheckpointError -> Bool < :: CheckpointError -> CheckpointError -> Bool $c< :: CheckpointError -> CheckpointError -> Bool compare :: CheckpointError -> CheckpointError -> Ordering $ccompare :: CheckpointError -> CheckpointError -> Ordering $cp1Ord :: Eq CheckpointError Ord, Int -> CheckpointError -> ShowS [CheckpointError] -> ShowS CheckpointError -> String (Int -> CheckpointError -> ShowS) -> (CheckpointError -> String) -> ([CheckpointError] -> ShowS) -> Show CheckpointError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckpointError] -> ShowS $cshowList :: [CheckpointError] -> ShowS show :: CheckpointError -> String $cshow :: CheckpointError -> String showsPrec :: Int -> CheckpointError -> ShowS $cshowsPrec :: Int -> CheckpointError -> ShowS Show, (forall x. CheckpointError -> Rep CheckpointError x) -> (forall x. Rep CheckpointError x -> CheckpointError) -> Generic CheckpointError forall x. Rep CheckpointError x -> CheckpointError forall x. CheckpointError -> Rep CheckpointError x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep CheckpointError x -> CheckpointError $cfrom :: forall x. CheckpointError -> Rep CheckpointError x Generic) deriving anyclass (Value -> Parser [CheckpointError] Value -> Parser CheckpointError (Value -> Parser CheckpointError) -> (Value -> Parser [CheckpointError]) -> FromJSON CheckpointError forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [CheckpointError] $cparseJSONList :: Value -> Parser [CheckpointError] parseJSON :: Value -> Parser CheckpointError $cparseJSON :: Value -> Parser CheckpointError FromJSON, [CheckpointError] -> Encoding [CheckpointError] -> Value CheckpointError -> Encoding CheckpointError -> Value (CheckpointError -> Value) -> (CheckpointError -> Encoding) -> ([CheckpointError] -> Value) -> ([CheckpointError] -> Encoding) -> ToJSON CheckpointError forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [CheckpointError] -> Encoding $ctoEncodingList :: [CheckpointError] -> Encoding toJSONList :: [CheckpointError] -> Value $ctoJSONList :: [CheckpointError] -> Value toEncoding :: CheckpointError -> Encoding $ctoEncoding :: CheckpointError -> Encoding toJSON :: CheckpointError -> Value $ctoJSON :: CheckpointError -> Value ToJSON) instance Pretty CheckpointError where pretty :: CheckpointError -> Doc ann pretty = \case JSONDecodeError Text t -> Doc ann "JSON decoding error:" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text t makeClassyPrisms ''CheckpointError newtype CheckpointStore = CheckpointStore { CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value) unCheckpointStore :: Map CheckpointKey (CheckpointStoreItem Value) } deriving stock (CheckpointStore -> CheckpointStore -> Bool (CheckpointStore -> CheckpointStore -> Bool) -> (CheckpointStore -> CheckpointStore -> Bool) -> Eq CheckpointStore forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckpointStore -> CheckpointStore -> Bool $c/= :: CheckpointStore -> CheckpointStore -> Bool == :: CheckpointStore -> CheckpointStore -> Bool $c== :: CheckpointStore -> CheckpointStore -> Bool Eq, Int -> CheckpointStore -> ShowS [CheckpointStore] -> ShowS CheckpointStore -> String (Int -> CheckpointStore -> ShowS) -> (CheckpointStore -> String) -> ([CheckpointStore] -> ShowS) -> Show CheckpointStore forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckpointStore] -> ShowS $cshowList :: [CheckpointStore] -> ShowS show :: CheckpointStore -> String $cshow :: CheckpointStore -> String showsPrec :: Int -> CheckpointStore -> ShowS $cshowsPrec :: Int -> CheckpointStore -> ShowS Show, (forall x. CheckpointStore -> Rep CheckpointStore x) -> (forall x. Rep CheckpointStore x -> CheckpointStore) -> Generic CheckpointStore forall x. Rep CheckpointStore x -> CheckpointStore forall x. CheckpointStore -> Rep CheckpointStore x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep CheckpointStore x -> CheckpointStore $cfrom :: forall x. CheckpointStore -> Rep CheckpointStore x Generic) deriving anyclass ([CheckpointStore] -> Encoding [CheckpointStore] -> Value CheckpointStore -> Encoding CheckpointStore -> Value (CheckpointStore -> Value) -> (CheckpointStore -> Encoding) -> ([CheckpointStore] -> Value) -> ([CheckpointStore] -> Encoding) -> ToJSON CheckpointStore forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [CheckpointStore] -> Encoding $ctoEncodingList :: [CheckpointStore] -> Encoding toJSONList :: [CheckpointStore] -> Value $ctoJSONList :: [CheckpointStore] -> Value toEncoding :: CheckpointStore -> Encoding $ctoEncoding :: CheckpointStore -> Encoding toJSON :: CheckpointStore -> Value $ctoJSON :: CheckpointStore -> Value ToJSON, Value -> Parser [CheckpointStore] Value -> Parser CheckpointStore (Value -> Parser CheckpointStore) -> (Value -> Parser [CheckpointStore]) -> FromJSON CheckpointStore forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [CheckpointStore] $cparseJSONList :: Value -> Parser [CheckpointStore] parseJSON :: Value -> Parser CheckpointStore $cparseJSON :: Value -> Parser CheckpointStore FromJSON) deriving newtype (b -> CheckpointStore -> CheckpointStore NonEmpty CheckpointStore -> CheckpointStore CheckpointStore -> CheckpointStore -> CheckpointStore (CheckpointStore -> CheckpointStore -> CheckpointStore) -> (NonEmpty CheckpointStore -> CheckpointStore) -> (forall b. Integral b => b -> CheckpointStore -> CheckpointStore) -> Semigroup CheckpointStore forall b. Integral b => b -> CheckpointStore -> CheckpointStore forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a stimes :: b -> CheckpointStore -> CheckpointStore $cstimes :: forall b. Integral b => b -> CheckpointStore -> CheckpointStore sconcat :: NonEmpty CheckpointStore -> CheckpointStore $csconcat :: NonEmpty CheckpointStore -> CheckpointStore <> :: CheckpointStore -> CheckpointStore -> CheckpointStore $c<> :: CheckpointStore -> CheckpointStore -> CheckpointStore Semigroup, Semigroup CheckpointStore CheckpointStore Semigroup CheckpointStore -> CheckpointStore -> (CheckpointStore -> CheckpointStore -> CheckpointStore) -> ([CheckpointStore] -> CheckpointStore) -> Monoid CheckpointStore [CheckpointStore] -> CheckpointStore CheckpointStore -> CheckpointStore -> CheckpointStore forall a. Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a mconcat :: [CheckpointStore] -> CheckpointStore $cmconcat :: [CheckpointStore] -> CheckpointStore mappend :: CheckpointStore -> CheckpointStore -> CheckpointStore $cmappend :: CheckpointStore -> CheckpointStore -> CheckpointStore mempty :: CheckpointStore $cmempty :: CheckpointStore $cp1Monoid :: Semigroup CheckpointStore Monoid) instance Pretty CheckpointStore where pretty :: CheckpointStore -> Doc ann pretty (CheckpointStore Map CheckpointKey (CheckpointStoreItem Value) mp) = let p :: a -> a -> Doc ann p a k a v = a -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty a k Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann colon Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> (String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ann) -> (a -> String) -> a -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> ShowS forall a. Int -> [a] -> [a] take Int 100 ShowS -> (a -> String) -> a -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show) a v in [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ((CheckpointKey -> CheckpointStoreItem Value -> Doc ann) -> (CheckpointKey, CheckpointStoreItem Value) -> Doc ann forall a b c. (a -> b -> c) -> (a, b) -> c uncurry CheckpointKey -> CheckpointStoreItem Value -> Doc ann forall a a ann. (Pretty a, Show a) => a -> a -> Doc ann p ((CheckpointKey, CheckpointStoreItem Value) -> Doc ann) -> [(CheckpointKey, CheckpointStoreItem Value)] -> [Doc ann] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Map CheckpointKey (CheckpointStoreItem Value) -> [(CheckpointKey, CheckpointStoreItem Value)] forall k a. Map k a -> [(k, a)] Map.toList Map CheckpointKey (CheckpointStoreItem Value) mp) _CheckpointStore :: Iso' CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) _CheckpointStore :: p (Map CheckpointKey (CheckpointStoreItem Value)) (f (Map CheckpointKey (CheckpointStoreItem Value))) -> p CheckpointStore (f CheckpointStore) _CheckpointStore = (CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value)) -> (Map CheckpointKey (CheckpointStoreItem Value) -> CheckpointStore) -> Iso CheckpointStore CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value)) forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b iso CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value) unCheckpointStore Map CheckpointKey (CheckpointStoreItem Value) -> CheckpointStore CheckpointStore -- | Intervals of checkpoint keys that are completely covered by the -- checkpoint store. completedIntervals :: CheckpointStore -> IS.IntervalSet (Interval CheckpointKey) completedIntervals :: CheckpointStore -> IntervalSet (Interval CheckpointKey) completedIntervals = [Interval CheckpointKey] -> IntervalSet (Interval CheckpointKey) forall k e. (Interval k e, Ord k) => [k] -> IntervalSet k IS.fromList ([Interval CheckpointKey] -> IntervalSet (Interval CheckpointKey)) -> (CheckpointStore -> [Interval CheckpointKey]) -> CheckpointStore -> IntervalSet (Interval CheckpointKey) forall b c a. (b -> c) -> (a -> b) -> a -> c . ((CheckpointKey, CheckpointStoreItem Value) -> Interval CheckpointKey) -> [(CheckpointKey, CheckpointStoreItem Value)] -> [Interval CheckpointKey] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((CheckpointKey -> CheckpointStoreItem Value -> Interval CheckpointKey) -> (CheckpointKey, CheckpointStoreItem Value) -> Interval CheckpointKey forall a b c. (a -> b -> c) -> (a, b) -> c uncurry CheckpointKey -> CheckpointStoreItem Value -> Interval CheckpointKey forall a. CheckpointKey -> CheckpointStoreItem a -> Interval CheckpointKey f) ([(CheckpointKey, CheckpointStoreItem Value)] -> [Interval CheckpointKey]) -> (CheckpointStore -> [(CheckpointKey, CheckpointStoreItem Value)]) -> CheckpointStore -> [Interval CheckpointKey] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map CheckpointKey (CheckpointStoreItem Value) -> [(CheckpointKey, CheckpointStoreItem Value)] forall k a. Map k a -> [(k, a)] Map.toList (Map CheckpointKey (CheckpointStoreItem Value) -> [(CheckpointKey, CheckpointStoreItem Value)]) -> (CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value)) -> CheckpointStore -> [(CheckpointKey, CheckpointStoreItem Value)] forall b c a. (b -> c) -> (a -> b) -> a -> c . CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value) unCheckpointStore where f :: CheckpointKey -> CheckpointStoreItem a -> Interval CheckpointKey f (CheckpointKey from_ :: CheckpointKey) CheckpointStoreItem{CheckpointKey csNewKey :: forall a. CheckpointStoreItem a -> CheckpointKey csNewKey :: CheckpointKey csNewKey} = CheckpointKey -> CheckpointKey -> Interval CheckpointKey forall a. a -> a -> Interval a ClosedInterval CheckpointKey from_ CheckpointKey csNewKey -- | The maximum key that is present in the store maxKey :: CheckpointStore -> Maybe CheckpointKey maxKey :: CheckpointStore -> Maybe CheckpointKey maxKey = ((CheckpointKey, CheckpointStoreItem Value) -> CheckpointKey) -> Maybe (CheckpointKey, CheckpointStoreItem Value) -> Maybe CheckpointKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (CheckpointKey, CheckpointStoreItem Value) -> CheckpointKey forall a b. (a, b) -> a fst (Maybe (CheckpointKey, CheckpointStoreItem Value) -> Maybe CheckpointKey) -> (CheckpointStore -> Maybe (CheckpointKey, CheckpointStoreItem Value)) -> CheckpointStore -> Maybe CheckpointKey forall b c a. (b -> c) -> (a -> b) -> a -> c . Map CheckpointKey (CheckpointStoreItem Value) -> Maybe (CheckpointKey, CheckpointStoreItem Value) forall k a. Map k a -> Maybe (k, a) Map.lookupMax (Map CheckpointKey (CheckpointStoreItem Value) -> Maybe (CheckpointKey, CheckpointStoreItem Value)) -> (CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value)) -> CheckpointStore -> Maybe (CheckpointKey, CheckpointStoreItem Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . CheckpointStore -> Map CheckpointKey (CheckpointStoreItem Value) unCheckpointStore data CheckpointStoreItem a = CheckpointStoreItem { CheckpointStoreItem a -> a csValue :: a , CheckpointStoreItem a -> CheckpointKey csNewKey :: CheckpointKey } deriving stock (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> Eq (CheckpointStoreItem a) forall a. Eq a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c/= :: forall a. Eq a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool == :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c== :: forall a. Eq a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool Eq, Eq (CheckpointStoreItem a) Eq (CheckpointStoreItem a) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Ordering) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> Bool) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a) -> (CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a) -> Ord (CheckpointStoreItem a) CheckpointStoreItem a -> CheckpointStoreItem a -> Bool CheckpointStoreItem a -> CheckpointStoreItem a -> Ordering CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall a. Ord a => Eq (CheckpointStoreItem a) forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Ordering forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a min :: CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a $cmin :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a max :: CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a $cmax :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> CheckpointStoreItem a >= :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c>= :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool > :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c> :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool <= :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c<= :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool < :: CheckpointStoreItem a -> CheckpointStoreItem a -> Bool $c< :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Bool compare :: CheckpointStoreItem a -> CheckpointStoreItem a -> Ordering $ccompare :: forall a. Ord a => CheckpointStoreItem a -> CheckpointStoreItem a -> Ordering $cp1Ord :: forall a. Ord a => Eq (CheckpointStoreItem a) Ord, Int -> CheckpointStoreItem a -> ShowS [CheckpointStoreItem a] -> ShowS CheckpointStoreItem a -> String (Int -> CheckpointStoreItem a -> ShowS) -> (CheckpointStoreItem a -> String) -> ([CheckpointStoreItem a] -> ShowS) -> Show (CheckpointStoreItem a) forall a. Show a => Int -> CheckpointStoreItem a -> ShowS forall a. Show a => [CheckpointStoreItem a] -> ShowS forall a. Show a => CheckpointStoreItem a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckpointStoreItem a] -> ShowS $cshowList :: forall a. Show a => [CheckpointStoreItem a] -> ShowS show :: CheckpointStoreItem a -> String $cshow :: forall a. Show a => CheckpointStoreItem a -> String showsPrec :: Int -> CheckpointStoreItem a -> ShowS $cshowsPrec :: forall a. Show a => Int -> CheckpointStoreItem a -> ShowS Show, (forall x. CheckpointStoreItem a -> Rep (CheckpointStoreItem a) x) -> (forall x. Rep (CheckpointStoreItem a) x -> CheckpointStoreItem a) -> Generic (CheckpointStoreItem a) forall x. Rep (CheckpointStoreItem a) x -> CheckpointStoreItem a forall x. CheckpointStoreItem a -> Rep (CheckpointStoreItem a) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall a x. Rep (CheckpointStoreItem a) x -> CheckpointStoreItem a forall a x. CheckpointStoreItem a -> Rep (CheckpointStoreItem a) x $cto :: forall a x. Rep (CheckpointStoreItem a) x -> CheckpointStoreItem a $cfrom :: forall a x. CheckpointStoreItem a -> Rep (CheckpointStoreItem a) x Generic, a -> CheckpointStoreItem b -> CheckpointStoreItem a (a -> b) -> CheckpointStoreItem a -> CheckpointStoreItem b (forall a b. (a -> b) -> CheckpointStoreItem a -> CheckpointStoreItem b) -> (forall a b. a -> CheckpointStoreItem b -> CheckpointStoreItem a) -> Functor CheckpointStoreItem forall a b. a -> CheckpointStoreItem b -> CheckpointStoreItem a forall a b. (a -> b) -> CheckpointStoreItem a -> CheckpointStoreItem b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> CheckpointStoreItem b -> CheckpointStoreItem a $c<$ :: forall a b. a -> CheckpointStoreItem b -> CheckpointStoreItem a fmap :: (a -> b) -> CheckpointStoreItem a -> CheckpointStoreItem b $cfmap :: forall a b. (a -> b) -> CheckpointStoreItem a -> CheckpointStoreItem b Functor, CheckpointStoreItem a -> Bool (a -> m) -> CheckpointStoreItem a -> m (a -> b -> b) -> b -> CheckpointStoreItem a -> b (forall m. Monoid m => CheckpointStoreItem m -> m) -> (forall m a. Monoid m => (a -> m) -> CheckpointStoreItem a -> m) -> (forall m a. Monoid m => (a -> m) -> CheckpointStoreItem a -> m) -> (forall a b. (a -> b -> b) -> b -> CheckpointStoreItem a -> b) -> (forall a b. (a -> b -> b) -> b -> CheckpointStoreItem a -> b) -> (forall b a. (b -> a -> b) -> b -> CheckpointStoreItem a -> b) -> (forall b a. (b -> a -> b) -> b -> CheckpointStoreItem a -> b) -> (forall a. (a -> a -> a) -> CheckpointStoreItem a -> a) -> (forall a. (a -> a -> a) -> CheckpointStoreItem a -> a) -> (forall a. CheckpointStoreItem a -> [a]) -> (forall a. CheckpointStoreItem a -> Bool) -> (forall a. CheckpointStoreItem a -> Int) -> (forall a. Eq a => a -> CheckpointStoreItem a -> Bool) -> (forall a. Ord a => CheckpointStoreItem a -> a) -> (forall a. Ord a => CheckpointStoreItem a -> a) -> (forall a. Num a => CheckpointStoreItem a -> a) -> (forall a. Num a => CheckpointStoreItem a -> a) -> Foldable CheckpointStoreItem forall a. Eq a => a -> CheckpointStoreItem a -> Bool forall a. Num a => CheckpointStoreItem a -> a forall a. Ord a => CheckpointStoreItem a -> a forall m. Monoid m => CheckpointStoreItem m -> m forall a. CheckpointStoreItem a -> Bool forall a. CheckpointStoreItem a -> Int forall a. CheckpointStoreItem a -> [a] forall a. (a -> a -> a) -> CheckpointStoreItem a -> a forall m a. Monoid m => (a -> m) -> CheckpointStoreItem a -> m forall b a. (b -> a -> b) -> b -> CheckpointStoreItem a -> b forall a b. (a -> b -> b) -> b -> CheckpointStoreItem a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t product :: CheckpointStoreItem a -> a $cproduct :: forall a. Num a => CheckpointStoreItem a -> a sum :: CheckpointStoreItem a -> a $csum :: forall a. Num a => CheckpointStoreItem a -> a minimum :: CheckpointStoreItem a -> a $cminimum :: forall a. Ord a => CheckpointStoreItem a -> a maximum :: CheckpointStoreItem a -> a $cmaximum :: forall a. Ord a => CheckpointStoreItem a -> a elem :: a -> CheckpointStoreItem a -> Bool $celem :: forall a. Eq a => a -> CheckpointStoreItem a -> Bool length :: CheckpointStoreItem a -> Int $clength :: forall a. CheckpointStoreItem a -> Int null :: CheckpointStoreItem a -> Bool $cnull :: forall a. CheckpointStoreItem a -> Bool toList :: CheckpointStoreItem a -> [a] $ctoList :: forall a. CheckpointStoreItem a -> [a] foldl1 :: (a -> a -> a) -> CheckpointStoreItem a -> a $cfoldl1 :: forall a. (a -> a -> a) -> CheckpointStoreItem a -> a foldr1 :: (a -> a -> a) -> CheckpointStoreItem a -> a $cfoldr1 :: forall a. (a -> a -> a) -> CheckpointStoreItem a -> a foldl' :: (b -> a -> b) -> b -> CheckpointStoreItem a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> CheckpointStoreItem a -> b foldl :: (b -> a -> b) -> b -> CheckpointStoreItem a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> CheckpointStoreItem a -> b foldr' :: (a -> b -> b) -> b -> CheckpointStoreItem a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> CheckpointStoreItem a -> b foldr :: (a -> b -> b) -> b -> CheckpointStoreItem a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> CheckpointStoreItem a -> b foldMap' :: (a -> m) -> CheckpointStoreItem a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> CheckpointStoreItem a -> m foldMap :: (a -> m) -> CheckpointStoreItem a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> CheckpointStoreItem a -> m fold :: CheckpointStoreItem m -> m $cfold :: forall m. Monoid m => CheckpointStoreItem m -> m Foldable, Functor CheckpointStoreItem Foldable CheckpointStoreItem Functor CheckpointStoreItem -> Foldable CheckpointStoreItem -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> CheckpointStoreItem a -> f (CheckpointStoreItem b)) -> (forall (f :: * -> *) a. Applicative f => CheckpointStoreItem (f a) -> f (CheckpointStoreItem a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> CheckpointStoreItem a -> m (CheckpointStoreItem b)) -> (forall (m :: * -> *) a. Monad m => CheckpointStoreItem (m a) -> m (CheckpointStoreItem a)) -> Traversable CheckpointStoreItem (a -> f b) -> CheckpointStoreItem a -> f (CheckpointStoreItem b) forall (t :: * -> *). Functor t -> Foldable t -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => CheckpointStoreItem (m a) -> m (CheckpointStoreItem a) forall (f :: * -> *) a. Applicative f => CheckpointStoreItem (f a) -> f (CheckpointStoreItem a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> CheckpointStoreItem a -> m (CheckpointStoreItem b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> CheckpointStoreItem a -> f (CheckpointStoreItem b) sequence :: CheckpointStoreItem (m a) -> m (CheckpointStoreItem a) $csequence :: forall (m :: * -> *) a. Monad m => CheckpointStoreItem (m a) -> m (CheckpointStoreItem a) mapM :: (a -> m b) -> CheckpointStoreItem a -> m (CheckpointStoreItem b) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> CheckpointStoreItem a -> m (CheckpointStoreItem b) sequenceA :: CheckpointStoreItem (f a) -> f (CheckpointStoreItem a) $csequenceA :: forall (f :: * -> *) a. Applicative f => CheckpointStoreItem (f a) -> f (CheckpointStoreItem a) traverse :: (a -> f b) -> CheckpointStoreItem a -> f (CheckpointStoreItem b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> CheckpointStoreItem a -> f (CheckpointStoreItem b) $cp2Traversable :: Foldable CheckpointStoreItem $cp1Traversable :: Functor CheckpointStoreItem Traversable) deriving anyclass ([CheckpointStoreItem a] -> Encoding [CheckpointStoreItem a] -> Value CheckpointStoreItem a -> Encoding CheckpointStoreItem a -> Value (CheckpointStoreItem a -> Value) -> (CheckpointStoreItem a -> Encoding) -> ([CheckpointStoreItem a] -> Value) -> ([CheckpointStoreItem a] -> Encoding) -> ToJSON (CheckpointStoreItem a) forall a. ToJSON a => [CheckpointStoreItem a] -> Encoding forall a. ToJSON a => [CheckpointStoreItem a] -> Value forall a. ToJSON a => CheckpointStoreItem a -> Encoding forall a. ToJSON a => CheckpointStoreItem a -> Value forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [CheckpointStoreItem a] -> Encoding $ctoEncodingList :: forall a. ToJSON a => [CheckpointStoreItem a] -> Encoding toJSONList :: [CheckpointStoreItem a] -> Value $ctoJSONList :: forall a. ToJSON a => [CheckpointStoreItem a] -> Value toEncoding :: CheckpointStoreItem a -> Encoding $ctoEncoding :: forall a. ToJSON a => CheckpointStoreItem a -> Encoding toJSON :: CheckpointStoreItem a -> Value $ctoJSON :: forall a. ToJSON a => CheckpointStoreItem a -> Value ToJSON, Value -> Parser [CheckpointStoreItem a] Value -> Parser (CheckpointStoreItem a) (Value -> Parser (CheckpointStoreItem a)) -> (Value -> Parser [CheckpointStoreItem a]) -> FromJSON (CheckpointStoreItem a) forall a. FromJSON a => Value -> Parser [CheckpointStoreItem a] forall a. FromJSON a => Value -> Parser (CheckpointStoreItem a) forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [CheckpointStoreItem a] $cparseJSONList :: forall a. FromJSON a => Value -> Parser [CheckpointStoreItem a] parseJSON :: Value -> Parser (CheckpointStoreItem a) $cparseJSON :: forall a. FromJSON a => Value -> Parser (CheckpointStoreItem a) FromJSON) data CheckpointLogMsg = LogFoundValueRestoringKey CheckpointKey | LogDecodingErrorAtKey CheckpointKey | LogNoValueForKey CheckpointKey | LogDoCheckpoint | LogAllocateKey | LogRetrieve CheckpointKey | LogStore CheckpointKey CheckpointKey | LogKeyUpdate CheckpointKey CheckpointKey deriving (CheckpointLogMsg -> CheckpointLogMsg -> Bool (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> Eq CheckpointLogMsg forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c/= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool == :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c== :: CheckpointLogMsg -> CheckpointLogMsg -> Bool Eq, Eq CheckpointLogMsg Eq CheckpointLogMsg -> (CheckpointLogMsg -> CheckpointLogMsg -> Ordering) -> (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> (CheckpointLogMsg -> CheckpointLogMsg -> Bool) -> (CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg) -> (CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg) -> Ord CheckpointLogMsg CheckpointLogMsg -> CheckpointLogMsg -> Bool CheckpointLogMsg -> CheckpointLogMsg -> Ordering CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg $cmin :: CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg max :: CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg $cmax :: CheckpointLogMsg -> CheckpointLogMsg -> CheckpointLogMsg >= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c>= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool > :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c> :: CheckpointLogMsg -> CheckpointLogMsg -> Bool <= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c<= :: CheckpointLogMsg -> CheckpointLogMsg -> Bool < :: CheckpointLogMsg -> CheckpointLogMsg -> Bool $c< :: CheckpointLogMsg -> CheckpointLogMsg -> Bool compare :: CheckpointLogMsg -> CheckpointLogMsg -> Ordering $ccompare :: CheckpointLogMsg -> CheckpointLogMsg -> Ordering $cp1Ord :: Eq CheckpointLogMsg Ord, Int -> CheckpointLogMsg -> ShowS [CheckpointLogMsg] -> ShowS CheckpointLogMsg -> String (Int -> CheckpointLogMsg -> ShowS) -> (CheckpointLogMsg -> String) -> ([CheckpointLogMsg] -> ShowS) -> Show CheckpointLogMsg forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckpointLogMsg] -> ShowS $cshowList :: [CheckpointLogMsg] -> ShowS show :: CheckpointLogMsg -> String $cshow :: CheckpointLogMsg -> String showsPrec :: Int -> CheckpointLogMsg -> ShowS $cshowsPrec :: Int -> CheckpointLogMsg -> ShowS Show, (forall x. CheckpointLogMsg -> Rep CheckpointLogMsg x) -> (forall x. Rep CheckpointLogMsg x -> CheckpointLogMsg) -> Generic CheckpointLogMsg forall x. Rep CheckpointLogMsg x -> CheckpointLogMsg forall x. CheckpointLogMsg -> Rep CheckpointLogMsg x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep CheckpointLogMsg x -> CheckpointLogMsg $cfrom :: forall x. CheckpointLogMsg -> Rep CheckpointLogMsg x Generic) deriving anyclass ([CheckpointLogMsg] -> Encoding [CheckpointLogMsg] -> Value CheckpointLogMsg -> Encoding CheckpointLogMsg -> Value (CheckpointLogMsg -> Value) -> (CheckpointLogMsg -> Encoding) -> ([CheckpointLogMsg] -> Value) -> ([CheckpointLogMsg] -> Encoding) -> ToJSON CheckpointLogMsg forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [CheckpointLogMsg] -> Encoding $ctoEncodingList :: [CheckpointLogMsg] -> Encoding toJSONList :: [CheckpointLogMsg] -> Value $ctoJSONList :: [CheckpointLogMsg] -> Value toEncoding :: CheckpointLogMsg -> Encoding $ctoEncoding :: CheckpointLogMsg -> Encoding toJSON :: CheckpointLogMsg -> Value $ctoJSON :: CheckpointLogMsg -> Value ToJSON, Value -> Parser [CheckpointLogMsg] Value -> Parser CheckpointLogMsg (Value -> Parser CheckpointLogMsg) -> (Value -> Parser [CheckpointLogMsg]) -> FromJSON CheckpointLogMsg forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [CheckpointLogMsg] $cparseJSONList :: Value -> Parser [CheckpointLogMsg] parseJSON :: Value -> Parser CheckpointLogMsg $cparseJSON :: Value -> Parser CheckpointLogMsg FromJSON) instance Pretty CheckpointLogMsg where pretty :: CheckpointLogMsg -> Doc ann pretty = \case LogFoundValueRestoringKey CheckpointKey k -> Doc ann "Found a value, restoring previous key" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k LogDecodingErrorAtKey CheckpointKey k -> Doc ann "Decoding error at key" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k LogNoValueForKey CheckpointKey k -> Doc ann "No value for key" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann ". The action will be once." CheckpointLogMsg LogDoCheckpoint -> Doc ann "doCheckpoint" CheckpointLogMsg LogAllocateKey -> Doc ann "allocateKey" LogRetrieve CheckpointKey k -> Doc ann "retrieve" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k LogStore CheckpointKey k1 CheckpointKey k2 -> Doc ann "Store; key1:" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k1 Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann "; key2:" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k2 LogKeyUpdate CheckpointKey k1 CheckpointKey k2 -> Doc ann "Key update; key then:" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k1 Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann "; key now:" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> CheckpointKey -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty CheckpointKey k2 {-| Insert a new value into the checkpoint store. The first 'CheckpointKey' is the checkpoint key *before* running the checkpointed action, the second 'Checkpoint' key is the value *after* running it. When we restore the checkpoint from the state (in 'restore') we set the 'CheckpointKey' state to the second argument to prevent chaos. -} insert :: ( ToJSON a , Member (State CheckpointStore) effs ) => CheckpointKey -> CheckpointKey -> a -> Eff effs () insert :: CheckpointKey -> CheckpointKey -> a -> Eff effs () insert CheckpointKey k CheckpointKey k' a v = let vl :: CheckpointStoreItem Value vl = CheckpointStoreItem :: forall a. a -> CheckpointKey -> CheckpointStoreItem a CheckpointStoreItem{csValue :: Value csValue = a -> Value forall a. ToJSON a => a -> Value JSON.toJSON a v, csNewKey :: CheckpointKey csNewKey = CheckpointKey k'} in (CheckpointStore -> CheckpointStore) -> Eff effs () forall s (effs :: [* -> *]). Member (State s) effs => (s -> s) -> Eff effs () modify (ASetter CheckpointStore CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value)) -> (Map CheckpointKey (CheckpointStoreItem Value) -> Map CheckpointKey (CheckpointStoreItem Value)) -> CheckpointStore -> CheckpointStore forall s t a b. ASetter s t a b -> (a -> b) -> s -> t over ASetter CheckpointStore CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value)) Iso CheckpointStore CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value)) _CheckpointStore (CheckpointKey -> CheckpointStoreItem Value -> Map CheckpointKey (CheckpointStoreItem Value) -> Map CheckpointKey (CheckpointStoreItem Value) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert CheckpointKey k CheckpointStoreItem Value vl)) {-| @restore k@ checks for an entry for @k@ in the checkpoint store, and parses the result if there is such an entry. It returns * @Right Nothing@ if no entry was found * @Left err@ if an entry was found but failed to parse with the 'FromJSON' instance * @Right (Just a)@ if an entry was found and parsed succesfully. -} restore :: forall a effs. ( FromJSON a , Member (State CheckpointStore) effs , Member (State CheckpointKey) effs , Member (LogMsg CheckpointLogMsg) effs ) => CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) restore :: CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) restore CheckpointKey k = do Maybe (CheckpointStoreItem Value) value <- (CheckpointStore -> Maybe (CheckpointStoreItem Value)) -> Eff effs (Maybe (CheckpointStoreItem Value)) forall s a (effs :: [* -> *]). Member (State s) effs => (s -> a) -> Eff effs a gets (Getting (Maybe (CheckpointStoreItem Value)) CheckpointStore (Maybe (CheckpointStoreItem Value)) -> CheckpointStore -> Maybe (CheckpointStoreItem Value) forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view (Getting (Maybe (CheckpointStoreItem Value)) CheckpointStore (Maybe (CheckpointStoreItem Value)) -> CheckpointStore -> Maybe (CheckpointStoreItem Value)) -> Getting (Maybe (CheckpointStoreItem Value)) CheckpointStore (Maybe (CheckpointStoreItem Value)) -> CheckpointStore -> Maybe (CheckpointStoreItem Value) forall a b. (a -> b) -> a -> b $ (Map CheckpointKey (CheckpointStoreItem Value) -> Const (Maybe (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value))) -> CheckpointStore -> Const (Maybe (CheckpointStoreItem Value)) CheckpointStore Iso CheckpointStore CheckpointStore (Map CheckpointKey (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value)) _CheckpointStore ((Map CheckpointKey (CheckpointStoreItem Value) -> Const (Maybe (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value))) -> CheckpointStore -> Const (Maybe (CheckpointStoreItem Value)) CheckpointStore) -> ((Maybe (CheckpointStoreItem Value) -> Const (Maybe (CheckpointStoreItem Value)) (Maybe (CheckpointStoreItem Value))) -> Map CheckpointKey (CheckpointStoreItem Value) -> Const (Maybe (CheckpointStoreItem Value)) (Map CheckpointKey (CheckpointStoreItem Value))) -> Getting (Maybe (CheckpointStoreItem Value)) CheckpointStore (Maybe (CheckpointStoreItem Value)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Index (Map CheckpointKey (CheckpointStoreItem Value)) -> Lens' (Map CheckpointKey (CheckpointStoreItem Value)) (Maybe (IxValue (Map CheckpointKey (CheckpointStoreItem Value)))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at Index (Map CheckpointKey (CheckpointStoreItem Value)) CheckpointKey k) let (Maybe (Either String (CheckpointStoreItem a)) result :: Maybe (Either String (CheckpointStoreItem a))) = (CheckpointStoreItem Value -> Either String (CheckpointStoreItem a)) -> Maybe (CheckpointStoreItem Value) -> Maybe (Either String (CheckpointStoreItem a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((Value -> Either String a) -> CheckpointStoreItem Value -> Either String (CheckpointStoreItem a) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ((Value -> Parser a) -> Value -> Either String a forall a b. (a -> Parser b) -> a -> Either String b JSON.parseEither Value -> Parser a forall a. FromJSON a => Value -> Parser a JSON.parseJSON)) Maybe (CheckpointStoreItem Value) value case Maybe (Either String (CheckpointStoreItem a)) result of Maybe (Either String (CheckpointStoreItem a)) Nothing -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug (CheckpointKey -> CheckpointLogMsg LogNoValueForKey CheckpointKey k) Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a))) -> Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall a b. (a -> b) -> a -> b $ Maybe a -> Either CheckpointError (Maybe a) forall a b. b -> Either a b Right Maybe a forall a. Maybe a Nothing Just (Left String err) -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logError (CheckpointKey -> CheckpointLogMsg LogDecodingErrorAtKey CheckpointKey k) Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a))) -> Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall a b. (a -> b) -> a -> b $ CheckpointError -> Either CheckpointError (Maybe a) forall a b. a -> Either a b Left (Text -> CheckpointError JSONDecodeError (Text -> CheckpointError) -> Text -> CheckpointError forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String err) Just (Right CheckpointStoreItem{a csValue :: a csValue :: forall a. CheckpointStoreItem a -> a csValue,CheckpointKey csNewKey :: CheckpointKey csNewKey :: forall a. CheckpointStoreItem a -> CheckpointKey csNewKey}) -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug (CheckpointLogMsg -> Eff effs ()) -> CheckpointLogMsg -> Eff effs () forall a b. (a -> b) -> a -> b $ CheckpointKey -> CheckpointLogMsg LogFoundValueRestoringKey CheckpointKey csNewKey let nk :: CheckpointKey nk = CheckpointKey -> CheckpointKey forall a. Enum a => a -> a succ CheckpointKey csNewKey CheckpointKey -> Eff effs () forall s (effs :: [* -> *]). Member (State s) effs => s -> Eff effs () put CheckpointKey nk Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe a -> Either CheckpointError (Maybe a) forall a b. b -> Either a b Right (a -> Maybe a forall a. a -> Maybe a Just a csValue)) data Checkpoint r where DoCheckpoint :: Checkpoint () AllocateKey :: Checkpoint CheckpointKey Store :: (ToJSON a) => CheckpointKey -> CheckpointKey -> a -> Checkpoint () Retrieve :: (FromJSON a) => CheckpointKey -> Checkpoint (Either CheckpointError (Maybe a)) doCheckpoint :: forall effs. Member Checkpoint effs => Eff effs () doCheckpoint :: Eff effs () doCheckpoint = Checkpoint () -> Eff effs () forall (eff :: * -> *) (effs :: [* -> *]) a. Member eff effs => eff a -> Eff effs a send Checkpoint () DoCheckpoint allocateKey :: forall effs. Member Checkpoint effs => Eff effs CheckpointKey allocateKey :: Eff effs CheckpointKey allocateKey = Checkpoint CheckpointKey -> Eff effs CheckpointKey forall (eff :: * -> *) (effs :: [* -> *]) a. Member eff effs => eff a -> Eff effs a send Checkpoint CheckpointKey AllocateKey store :: forall a effs. (Member Checkpoint effs, ToJSON a) => CheckpointKey -> CheckpointKey -> a -> Eff effs () store :: CheckpointKey -> CheckpointKey -> a -> Eff effs () store CheckpointKey k1 CheckpointKey k2 a a = Checkpoint () -> Eff effs () forall (eff :: * -> *) (effs :: [* -> *]) a. Member eff effs => eff a -> Eff effs a send @Checkpoint (CheckpointKey -> CheckpointKey -> a -> Checkpoint () forall a. ToJSON a => CheckpointKey -> CheckpointKey -> a -> Checkpoint () Store CheckpointKey k1 CheckpointKey k2 a a) retrieve :: forall a effs. (Member Checkpoint effs, FromJSON a) => CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) retrieve :: CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) retrieve CheckpointKey k = Checkpoint (Either CheckpointError (Maybe a)) -> Eff effs (Either CheckpointError (Maybe a)) forall (eff :: * -> *) (effs :: [* -> *]) a. Member eff effs => eff a -> Eff effs a send @Checkpoint (CheckpointKey -> Checkpoint (Either CheckpointError (Maybe a)) forall a. FromJSON a => CheckpointKey -> Checkpoint (Either CheckpointError (Maybe a)) Retrieve CheckpointKey k) -- | Handle the 'Checkpoint' effect in terms of 'CheckpointStore' and -- 'CheckpointKey' states. handleCheckpoint :: forall effs. ( Member (State CheckpointStore) effs , Member (State CheckpointKey) effs , Member (LogMsg CheckpointLogMsg) effs ) => Eff (Checkpoint ': effs) ~> Eff effs handleCheckpoint :: Eff (Checkpoint : effs) ~> Eff effs handleCheckpoint = (Checkpoint ~> Eff effs) -> Eff (Checkpoint : effs) ~> Eff effs forall (eff :: * -> *) (effs :: [* -> *]). (eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs interpret ((Checkpoint ~> Eff effs) -> Eff (Checkpoint : effs) ~> Eff effs) -> (Checkpoint ~> Eff effs) -> Eff (Checkpoint : effs) ~> Eff effs forall a b. (a -> b) -> a -> b $ \case Checkpoint x DoCheckpoint -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug CheckpointLogMsg LogDoCheckpoint (CheckpointKey -> CheckpointKey) -> Eff effs () forall s (effs :: [* -> *]). Member (State s) effs => (s -> s) -> Eff effs () modify @CheckpointKey CheckpointKey -> CheckpointKey forall a. Enum a => a -> a succ Checkpoint x AllocateKey -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug CheckpointLogMsg LogAllocateKey forall (effs :: [* -> *]). Member (State CheckpointKey) effs => Eff effs CheckpointKey forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s get @CheckpointKey Store k k' a -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug (CheckpointLogMsg -> Eff effs ()) -> CheckpointLogMsg -> Eff effs () forall a b. (a -> b) -> a -> b $ CheckpointKey -> CheckpointKey -> CheckpointLogMsg LogStore CheckpointKey k CheckpointKey k' CheckpointKey -> CheckpointKey -> a -> Eff effs () forall a (effs :: [* -> *]). (ToJSON a, Member (State CheckpointStore) effs) => CheckpointKey -> CheckpointKey -> a -> Eff effs () insert CheckpointKey k CheckpointKey k' a a Retrieve k -> do CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug (CheckpointLogMsg -> Eff effs ()) -> CheckpointLogMsg -> Eff effs () forall a b. (a -> b) -> a -> b $ CheckpointKey -> CheckpointLogMsg LogRetrieve CheckpointKey k Either CheckpointError (Maybe a) result <- CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) forall a (effs :: [* -> *]). (FromJSON a, Member (State CheckpointStore) effs, Member (State CheckpointKey) effs, Member (LogMsg CheckpointLogMsg) effs) => CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) restore @_ @effs CheckpointKey k CheckpointKey k' <- forall (effs :: [* -> *]). Member (State CheckpointKey) effs => Eff effs CheckpointKey forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s get @CheckpointKey CheckpointLogMsg -> Eff effs () forall a (effs :: [* -> *]). Member (LogMsg a) effs => a -> Eff effs () logDebug (CheckpointLogMsg -> Eff effs ()) -> CheckpointLogMsg -> Eff effs () forall a b. (a -> b) -> a -> b $ CheckpointKey -> CheckpointKey -> CheckpointLogMsg LogKeyUpdate CheckpointKey k CheckpointKey k' Either CheckpointError (Maybe a) -> Eff effs (Either CheckpointError (Maybe a)) forall (f :: * -> *) a. Applicative f => a -> f a pure Either CheckpointError (Maybe a) result {-| Create a checkpoint for an action. @handleCheckpoint (jsonCheckpoint action)@ will * Obtain a 'CheckpointKey' that identifies the position of the current checkpoint in the program * Run @action@, convert its result to JSON and store it in the checkpoint store if there is no value at the key * Retrieve the result as a JSON value from the store, parse it, and return it *instead* of running @action@ if there is a value at the key. -} jsonCheckpoint :: forall err a effs. ( Member Checkpoint effs , Member (Error err) effs , ToJSON a , FromJSON a , AsCheckpointError err ) => Eff effs a -- ^ The @action@ that is checkpointed -> Eff effs a jsonCheckpoint :: Eff effs a -> Eff effs a jsonCheckpoint Eff effs a action = (() -> Eff effs (Either a ())) -> () -> Eff effs a forall err a b (effs :: [* -> *]). (Member Checkpoint effs, Member (Error err) effs, ToJSON a, FromJSON a, ToJSON b, FromJSON b, AsCheckpointError err) => (a -> Eff effs (Either b a)) -> a -> Eff effs b jsonCheckpointLoop @err @() @a (\() -> a -> Either a () forall a b. a -> Either a b Left (a -> Either a ()) -> Eff effs a -> Eff effs (Either a ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Eff effs a action) () {- Create a checkpoint for an action that is run repeatedly. -} jsonCheckpointLoop :: forall err a b effs. ( Member Checkpoint effs , Member (Error err) effs , ToJSON a , FromJSON a , ToJSON b , FromJSON b , AsCheckpointError err ) => (a -> Eff effs (Either b a)) -- ^ The action that is repeated until it returns a 'Left'. Only the accumulated result of the action will be stored. -> a -- ^ Initial value -> Eff effs b jsonCheckpointLoop :: (a -> Eff effs (Either b a)) -> a -> Eff effs b jsonCheckpointLoop a -> Eff effs (Either b a) action a initial = do Eff effs () forall (effs :: [* -> *]). Member Checkpoint effs => Eff effs () doCheckpoint CheckpointKey k <- Eff effs CheckpointKey forall (effs :: [* -> *]). Member Checkpoint effs => Eff effs CheckpointKey allocateKey Either b a current <- do Either CheckpointError (Maybe (Either b a)) vl <- CheckpointKey -> Eff effs (Either CheckpointError (Maybe (Either b a))) forall a (effs :: [* -> *]). (Member Checkpoint effs, FromJSON a) => CheckpointKey -> Eff effs (Either CheckpointError (Maybe a)) retrieve @_ CheckpointKey k case Either CheckpointError (Maybe (Either b a)) vl of Left CheckpointError err -> do err -> Eff effs (Either b a) forall e (effs :: [* -> *]) a. Member (Error e) effs => e -> Eff effs a throwError @err (AReview err CheckpointError -> CheckpointError -> err forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t review AReview err CheckpointError forall r. AsCheckpointError r => Prism' r CheckpointError _CheckpointError CheckpointError err) Right (Just Either b a a) -> do Either b a -> Eff effs (Either b a) forall (f :: * -> *) a. Applicative f => a -> f a pure Either b a a Right Maybe (Either b a) Nothing -> do Either b a -> Eff effs (Either b a) forall (f :: * -> *) a. Applicative f => a -> f a pure (a -> Either b a forall a b. b -> Either a b Right a initial) let go :: Either b a -> Eff effs b go (Left b b) = b -> Eff effs b forall (f :: * -> *) a. Applicative f => a -> f a pure b b go (Right a a) = do Either b a actionResult <- a -> Eff effs (Either b a) action a a CheckpointKey k' <- Eff effs CheckpointKey forall (effs :: [* -> *]). Member Checkpoint effs => Eff effs CheckpointKey allocateKey CheckpointKey -> CheckpointKey -> Either b a -> Eff effs () forall a (effs :: [* -> *]). (Member Checkpoint effs, ToJSON a) => CheckpointKey -> CheckpointKey -> a -> Eff effs () store @_ CheckpointKey k CheckpointKey k' Either b a actionResult Eff effs () forall (effs :: [* -> *]). Member Checkpoint effs => Eff effs () doCheckpoint Either b a -> Eff effs b go Either b a actionResult Either b a -> Eff effs b go Either b a current