{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
(
LiveLMDBFS (..)
, SnapshotsFS (..)
, BackingStore (..)
, BackingStore'
, DiffsToFlush (..)
, InitFrom (..)
, InitHint
, LedgerBackingStore
, ReadHint
, WriteHint
, BackingStoreValueHandle (..)
, BackingStoreValueHandle'
, LedgerBackingStoreValueHandle
, castBackingStoreValueHandle
, withBsValueHandle
, RangeQuery (..)
, Statistics (..)
, BackingStoreTrace (..)
, BackingStoreValueHandleTrace (..)
, bsRead
, bsReadAll
) where
import Cardano.Slotting.Slot (SlotNo, WithOrigin (..))
import Data.Bifunctor
import Data.Kind
import GHC.Generics
import NoThunks.Class (OnlyCheckWhnfNamed (..))
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import Ouroboros.Consensus.Util.IOLike
import System.FS.API
import qualified System.FS.API.Types as FS
newtype SnapshotsFS m = SnapshotsFS {forall (m :: * -> *). SnapshotsFS m -> SomeHasFS m
snapshotsFs :: SomeHasFS m}
deriving ((forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x)
-> (forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m)
-> Generic (SnapshotsFS m)
forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m
forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (SnapshotsFS m) x -> SnapshotsFS m
forall (m :: * -> *) x. SnapshotsFS m -> Rep (SnapshotsFS m) x
$cfrom :: forall (m :: * -> *) x. SnapshotsFS m -> Rep (SnapshotsFS m) x
from :: forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x
$cto :: forall (m :: * -> *) x. Rep (SnapshotsFS m) x -> SnapshotsFS m
to :: forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m
Generic, Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
Proxy (SnapshotsFS m) -> String
(Context -> SnapshotsFS m -> IO (Maybe ThunkInfo))
-> (Context -> SnapshotsFS m -> IO (Maybe ThunkInfo))
-> (Proxy (SnapshotsFS m) -> String)
-> NoThunks (SnapshotsFS m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (SnapshotsFS m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
noThunks :: Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (SnapshotsFS m) -> String
showTypeOf :: Proxy (SnapshotsFS m) -> String
NoThunks)
newtype LiveLMDBFS m = LiveLMDBFS {forall (m :: * -> *). LiveLMDBFS m -> SomeHasFS m
liveLMDBFs :: SomeHasFS m}
deriving ((forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x)
-> (forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m)
-> Generic (LiveLMDBFS m)
forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
forall (m :: * -> *) x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
$cfrom :: forall (m :: * -> *) x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
from :: forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
$cto :: forall (m :: * -> *) x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
to :: forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
Generic, Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
Proxy (LiveLMDBFS m) -> String
(Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo))
-> (Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo))
-> (Proxy (LiveLMDBFS m) -> String)
-> NoThunks (LiveLMDBFS m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (LiveLMDBFS m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
noThunks :: Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (LiveLMDBFS m) -> String
showTypeOf :: Proxy (LiveLMDBFS m) -> String
NoThunks)
data DiffsToFlush l = DiffsToFlush
{ forall (l :: LedgerStateKind).
DiffsToFlush l -> LedgerTables l DiffMK
toFlushDiffs :: !(LedgerTables l DiffMK)
, forall (l :: LedgerStateKind).
DiffsToFlush l -> (l EmptyMK, l EmptyMK)
toFlushState :: !(l EmptyMK, l EmptyMK)
, forall (l :: LedgerStateKind). DiffsToFlush l -> SlotNo
toFlushSlot :: !SlotNo
}
data BackingStore m keys key values diff = BackingStore
{ forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff -> m ()
bsClose :: !(m ())
, forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff
-> SerializeTablesHint values -> FsPath -> m ()
bsCopy :: !(SerializeTablesHint values -> FS.FsPath -> m ())
, forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff
-> m (BackingStoreValueHandle m keys key values)
bsValueHandle :: !(m (BackingStoreValueHandle m keys key values))
, forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff
-> SlotNo -> WriteHint diff -> diff -> m ()
bsWrite :: !(SlotNo -> WriteHint diff -> diff -> m ())
, forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff -> SnapshotBackend
bsSnapshotBackend :: !SnapshotBackend
}
deriving via
OnlyCheckWhnfNamed "BackingStore" (BackingStore m keys key values diff)
instance
NoThunks (BackingStore m keys key values diff)
type LedgerBackingStore m l =
BackingStore
m
(LedgerTables l KeysMK)
(TxIn l)
(LedgerTables l ValuesMK)
(LedgerTables l DiffMK)
type BackingStore' m blk = LedgerBackingStore m (ExtLedgerState blk)
type family InitHint values :: Type
type instance InitHint (LedgerTables l ValuesMK) = l EmptyMK
type family WriteHint diffs :: Type
type instance WriteHint (LedgerTables l DiffMK) = (l EmptyMK, l EmptyMK)
type family ReadHint values :: Type
type instance ReadHint (LedgerTables l ValuesMK) = l EmptyMK
data InitFrom values
=
InitFromValues !(WithOrigin SlotNo) !(InitHint values) !values
|
InitFromCopy !(InitHint values) !FS.FsPath
data BackingStoreValueHandle m keys key values = BackingStoreValueHandle
{ forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> WithOrigin SlotNo
bsvhAtSlot :: !(WithOrigin SlotNo)
, forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m ()
bsvhClose :: !(m ())
, forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: !(ReadHint values -> RangeQuery keys -> m (values, Maybe key))
, forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> m values
bsvhReadAll :: !(ReadHint values -> m values)
, forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> keys -> m values
bsvhRead :: !(ReadHint values -> keys -> m values)
, forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m Statistics
bsvhStat :: !(m Statistics)
}
deriving via
OnlyCheckWhnfNamed "BackingStoreValueHandle" (BackingStoreValueHandle m keys key values)
instance
NoThunks (BackingStoreValueHandle m keys key values)
type LedgerBackingStoreValueHandle m l =
BackingStoreValueHandle
m
(LedgerTables l KeysMK)
(TxIn l)
(LedgerTables l ValuesMK)
type BackingStoreValueHandle' m blk = LedgerBackingStoreValueHandle m (ExtLedgerState blk)
castBackingStoreValueHandle ::
(Functor m, ReadHint values ~ ReadHint values') =>
(values -> values') ->
(keys' -> keys) ->
(key -> key') ->
BackingStoreValueHandle m keys key values ->
BackingStoreValueHandle m keys' key' values'
castBackingStoreValueHandle :: forall (m :: * -> *) values values' keys' keys key key'.
(Functor m, ReadHint values ~ ReadHint values') =>
(values -> values')
-> (keys' -> keys)
-> (key -> key')
-> BackingStoreValueHandle m keys key values
-> BackingStoreValueHandle m keys' key' values'
castBackingStoreValueHandle values -> values'
f keys' -> keys
g key -> key'
h BackingStoreValueHandle m keys key values
bsvh =
BackingStoreValueHandle
{ WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot
, m ()
bsvhClose :: m ()
bsvhClose :: m ()
bsvhClose
, bsvhReadAll :: ReadHint values' -> m values'
bsvhReadAll = \ReadHint values'
rhint -> values -> values'
f (values -> values') -> m values -> m values'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadHint values -> m values
bsvhReadAll ReadHint values
ReadHint values'
rhint
, bsvhRangeRead :: ReadHint values' -> RangeQuery keys' -> m (values', Maybe key')
bsvhRangeRead = \ReadHint values'
rhint (RangeQuery Maybe keys'
prev Int
count) ->
((values, Maybe key) -> (values', Maybe key'))
-> m (values, Maybe key) -> m (values', Maybe key')
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe key -> Maybe key')
-> (values', Maybe key) -> (values', Maybe key')
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 ((key -> key') -> Maybe key -> Maybe key'
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap key -> key'
h) ((values', Maybe key) -> (values', Maybe key'))
-> ((values, Maybe key) -> (values', Maybe key))
-> (values, Maybe key)
-> (values', Maybe key')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (values -> values') -> (values, Maybe key) -> (values', Maybe key)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first values -> values'
f) (m (values, Maybe key) -> m (values', Maybe key'))
-> (RangeQuery keys -> m (values, Maybe key))
-> RangeQuery keys
-> m (values', Maybe key')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead ReadHint values
ReadHint values'
rhint (RangeQuery keys -> m (values', Maybe key'))
-> RangeQuery keys -> m (values', Maybe key')
forall a b. (a -> b) -> a -> b
$ Maybe keys -> Int -> RangeQuery keys
forall keys. Maybe keys -> Int -> RangeQuery keys
RangeQuery ((keys' -> keys) -> Maybe keys' -> Maybe keys
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap keys' -> keys
g Maybe keys'
prev) Int
count
, bsvhRead :: ReadHint values' -> keys' -> m values'
bsvhRead = \ReadHint values'
rhint -> (values -> values') -> m values -> m values'
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap values -> values'
f (m values -> m values')
-> (keys' -> m values) -> keys' -> m values'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadHint values -> keys -> m values
bsvhRead ReadHint values
ReadHint values'
rhint (keys -> m values) -> (keys' -> keys) -> keys' -> m values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. keys' -> keys
g
, m Statistics
bsvhStat :: m Statistics
bsvhStat :: m Statistics
bsvhStat
}
where
BackingStoreValueHandle
{ m ()
bsvhClose :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m ()
bsvhClose :: m ()
bsvhClose
, ReadHint values -> m values
bsvhReadAll :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> m values
bsvhReadAll :: ReadHint values -> m values
bsvhReadAll
, WithOrigin SlotNo
bsvhAtSlot :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot
, ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead
, ReadHint values -> keys -> m values
bsvhRead :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> keys -> m values
bsvhRead :: ReadHint values -> keys -> m values
bsvhRead
, m Statistics
bsvhStat :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m Statistics
bsvhStat :: m Statistics
bsvhStat
} = BackingStoreValueHandle m keys key values
bsvh
bsRead ::
MonadThrow m =>
BackingStore m keys key values diff ->
ReadHint values ->
keys ->
m (WithOrigin SlotNo, values)
bsRead :: forall (m :: * -> *) keys key values diff.
MonadThrow m =>
BackingStore m keys key values diff
-> ReadHint values -> keys -> m (WithOrigin SlotNo, values)
bsRead BackingStore m keys key values diff
store ReadHint values
rhint keys
keys = BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values
-> m (WithOrigin SlotNo, values))
-> m (WithOrigin SlotNo, values)
forall (m :: * -> *) keys key values diff a.
MonadThrow m =>
BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values -> m a) -> m a
withBsValueHandle BackingStore m keys key values diff
store ((BackingStoreValueHandle m keys key values
-> m (WithOrigin SlotNo, values))
-> m (WithOrigin SlotNo, values))
-> (BackingStoreValueHandle m keys key values
-> m (WithOrigin SlotNo, values))
-> m (WithOrigin SlotNo, values)
forall a b. (a -> b) -> a -> b
$ \BackingStoreValueHandle m keys key values
vh -> do
values <- BackingStoreValueHandle m keys key values
-> ReadHint values -> keys -> m values
forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> keys -> m values
bsvhRead BackingStoreValueHandle m keys key values
vh ReadHint values
rhint keys
keys
pure (bsvhAtSlot vh, values)
bsReadAll ::
MonadThrow m =>
BackingStore m keys key values diff ->
ReadHint values ->
m values
bsReadAll :: forall (m :: * -> *) keys key values diff.
MonadThrow m =>
BackingStore m keys key values diff -> ReadHint values -> m values
bsReadAll BackingStore m keys key values diff
store ReadHint values
rhint = BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values -> m values)
-> m values
forall (m :: * -> *) keys key values diff a.
MonadThrow m =>
BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values -> m a) -> m a
withBsValueHandle BackingStore m keys key values diff
store ((BackingStoreValueHandle m keys key values -> m values)
-> m values)
-> (BackingStoreValueHandle m keys key values -> m values)
-> m values
forall a b. (a -> b) -> a -> b
$ \BackingStoreValueHandle m keys key values
vh -> BackingStoreValueHandle m keys key values
-> ReadHint values -> m values
forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> m values
bsvhReadAll BackingStoreValueHandle m keys key values
vh ReadHint values
rhint
withBsValueHandle ::
MonadThrow m =>
BackingStore m keys key values diff ->
(BackingStoreValueHandle m keys key values -> m a) ->
m a
withBsValueHandle :: forall (m :: * -> *) keys key values diff a.
MonadThrow m =>
BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values -> m a) -> m a
withBsValueHandle BackingStore m keys key values diff
store =
m (BackingStoreValueHandle m keys key values)
-> (BackingStoreValueHandle m keys key values -> m ())
-> (BackingStoreValueHandle m keys key values -> m a)
-> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(BackingStore m keys key values diff
-> m (BackingStoreValueHandle m keys key values)
forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff
-> m (BackingStoreValueHandle m keys key values)
bsValueHandle BackingStore m keys key values diff
store)
BackingStoreValueHandle m keys key values -> m ()
forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m ()
bsvhClose
data RangeQuery keys = RangeQuery
{ forall keys. RangeQuery keys -> Maybe keys
rqPrev :: !(Maybe keys)
, forall keys. RangeQuery keys -> Int
rqCount :: !Int
}
deriving stock (Int -> RangeQuery keys -> ShowS
[RangeQuery keys] -> ShowS
RangeQuery keys -> String
(Int -> RangeQuery keys -> ShowS)
-> (RangeQuery keys -> String)
-> ([RangeQuery keys] -> ShowS)
-> Show (RangeQuery keys)
forall keys. Show keys => Int -> RangeQuery keys -> ShowS
forall keys. Show keys => [RangeQuery keys] -> ShowS
forall keys. Show keys => RangeQuery keys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall keys. Show keys => Int -> RangeQuery keys -> ShowS
showsPrec :: Int -> RangeQuery keys -> ShowS
$cshow :: forall keys. Show keys => RangeQuery keys -> String
show :: RangeQuery keys -> String
$cshowList :: forall keys. Show keys => [RangeQuery keys] -> ShowS
showList :: [RangeQuery keys] -> ShowS
Show, RangeQuery keys -> RangeQuery keys -> Bool
(RangeQuery keys -> RangeQuery keys -> Bool)
-> (RangeQuery keys -> RangeQuery keys -> Bool)
-> Eq (RangeQuery keys)
forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
== :: RangeQuery keys -> RangeQuery keys -> Bool
$c/= :: forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
/= :: RangeQuery keys -> RangeQuery keys -> Bool
Eq)
data Statistics = Statistics
{ Statistics -> WithOrigin SlotNo
sequenceNumber :: !(WithOrigin SlotNo)
, Statistics -> Int
numEntries :: !Int
}
deriving stock (Int -> Statistics -> ShowS
[Statistics] -> ShowS
Statistics -> String
(Int -> Statistics -> ShowS)
-> (Statistics -> String)
-> ([Statistics] -> ShowS)
-> Show Statistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statistics -> ShowS
showsPrec :: Int -> Statistics -> ShowS
$cshow :: Statistics -> String
show :: Statistics -> String
$cshowList :: [Statistics] -> ShowS
showList :: [Statistics] -> ShowS
Show, Statistics -> Statistics -> Bool
(Statistics -> Statistics -> Bool)
-> (Statistics -> Statistics -> Bool) -> Eq Statistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statistics -> Statistics -> Bool
== :: Statistics -> Statistics -> Bool
$c/= :: Statistics -> Statistics -> Bool
/= :: Statistics -> Statistics -> Bool
Eq)
data BackingStoreTrace
= BSOpening
| BSOpened !(Maybe FS.FsPath)
| BSInitialisingFromCopy !FS.FsPath
| BSInitialisedFromCopy !FS.FsPath
| BSInitialisingFromValues !(WithOrigin SlotNo)
| BSInitialisedFromValues !(WithOrigin SlotNo)
| BSClosing
| BSAlreadyClosed
| BSClosed
| BSCopying !FS.FsPath
| BSCopied !FS.FsPath
| BSCreatingValueHandle
| BSValueHandleTrace
!(Maybe Int)
!BackingStoreValueHandleTrace
| BSCreatedValueHandle
| BSWriting !SlotNo
| BSWritten !(WithOrigin SlotNo) !SlotNo
deriving (BackingStoreTrace -> BackingStoreTrace -> Bool
(BackingStoreTrace -> BackingStoreTrace -> Bool)
-> (BackingStoreTrace -> BackingStoreTrace -> Bool)
-> Eq BackingStoreTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackingStoreTrace -> BackingStoreTrace -> Bool
== :: BackingStoreTrace -> BackingStoreTrace -> Bool
$c/= :: BackingStoreTrace -> BackingStoreTrace -> Bool
/= :: BackingStoreTrace -> BackingStoreTrace -> Bool
Eq, Int -> BackingStoreTrace -> ShowS
[BackingStoreTrace] -> ShowS
BackingStoreTrace -> String
(Int -> BackingStoreTrace -> ShowS)
-> (BackingStoreTrace -> String)
-> ([BackingStoreTrace] -> ShowS)
-> Show BackingStoreTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackingStoreTrace -> ShowS
showsPrec :: Int -> BackingStoreTrace -> ShowS
$cshow :: BackingStoreTrace -> String
show :: BackingStoreTrace -> String
$cshowList :: [BackingStoreTrace] -> ShowS
showList :: [BackingStoreTrace] -> ShowS
Show)
data BackingStoreValueHandleTrace
= BSVHClosing
| BSVHAlreadyClosed
| BSVHClosed
| BSVHRangeReading
| BSVHRangeRead
| BSVHReading
| BSVHRead
| BSVHStatting
| BSVHStatted
deriving (BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
(BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool)
-> (BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool)
-> Eq BackingStoreValueHandleTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
== :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
$c/= :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
/= :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
Eq, Int -> BackingStoreValueHandleTrace -> ShowS
[BackingStoreValueHandleTrace] -> ShowS
BackingStoreValueHandleTrace -> String
(Int -> BackingStoreValueHandleTrace -> ShowS)
-> (BackingStoreValueHandleTrace -> String)
-> ([BackingStoreValueHandleTrace] -> ShowS)
-> Show BackingStoreValueHandleTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackingStoreValueHandleTrace -> ShowS
showsPrec :: Int -> BackingStoreValueHandleTrace -> ShowS
$cshow :: BackingStoreValueHandleTrace -> String
show :: BackingStoreValueHandleTrace -> String
$cshowList :: [BackingStoreValueHandleTrace] -> ShowS
showList :: [BackingStoreValueHandleTrace] -> ShowS
Show)