{-# OPTIONS_HADDOCK not-home #-}

-- | Encoders and decoders for snapshot metadata
--
module Database.LSMTree.Internal.Snapshot.Codec (
    -- * Versioning
    SnapshotVersion (..)
  , prettySnapshotVersion
  , currentSnapshotVersion
    -- * Writing and reading files
  , writeFileSnapshotMetaData
  , readFileSnapshotMetaData
  , encodeSnapshotMetaData
    -- * Encoding and decoding
  , Encode (..)
  , Decode (..)
  , DecodeVersioned (..)
  , Versioned (..)
  ) where

import           Codec.CBOR.Decoding
import           Codec.CBOR.Encoding
import           Codec.CBOR.Read
import           Codec.CBOR.Write
import           Control.Monad (when)
import           Control.Monad.Class.MonadThrow (Exception (displayException),
                     MonadThrow (..))
import           Data.Bifunctor (Bifunctor (..))
import qualified Data.ByteString.Char8 as BSC
import           Data.ByteString.Lazy (ByteString)
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
import           Database.LSMTree.Internal.Config
import           Database.LSMTree.Internal.CRC32C
import qualified Database.LSMTree.Internal.CRC32C as FS
import           Database.LSMTree.Internal.Entry
import           Database.LSMTree.Internal.MergeSchedule
import qualified Database.LSMTree.Internal.MergingRun as MR
import           Database.LSMTree.Internal.RunBuilder (IndexType (..),
                     RunBloomFilterAlloc (..), RunDataCaching (..),
                     RunParams (..))
import           Database.LSMTree.Internal.RunNumber
import           Database.LSMTree.Internal.Snapshot
import qualified System.FS.API as FS
import           System.FS.API (FsPath, HasFS)
import           Text.Printf

{-------------------------------------------------------------------------------
  Versioning
-------------------------------------------------------------------------------}

-- | The version of a snapshot.
--
-- A snapshot format version is a number. Version numbers are consecutive and
-- increasing. A single release of the library may support several older
-- snapshot format versions, and thereby provide backwards compatibility.
-- Support for old versions is not guaranteed indefinitely, but backwards
-- compatibility is guaranteed for at least the previous version, and preferably
-- for more. Forwards compatibility is not provided at all: snapshots with a
-- later version than the current version for the library release will always
-- fail.
data SnapshotVersion = V0
  deriving stock (Int -> SnapshotVersion -> ShowS
[SnapshotVersion] -> ShowS
SnapshotVersion -> String
(Int -> SnapshotVersion -> ShowS)
-> (SnapshotVersion -> String)
-> ([SnapshotVersion] -> ShowS)
-> Show SnapshotVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotVersion -> ShowS
showsPrec :: Int -> SnapshotVersion -> ShowS
$cshow :: SnapshotVersion -> String
show :: SnapshotVersion -> String
$cshowList :: [SnapshotVersion] -> ShowS
showList :: [SnapshotVersion] -> ShowS
Show, SnapshotVersion -> SnapshotVersion -> Bool
(SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> Eq SnapshotVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotVersion -> SnapshotVersion -> Bool
== :: SnapshotVersion -> SnapshotVersion -> Bool
$c/= :: SnapshotVersion -> SnapshotVersion -> Bool
/= :: SnapshotVersion -> SnapshotVersion -> Bool
Eq)

-- >>> prettySnapshotVersion currentSnapshotVersion
-- "v0"
prettySnapshotVersion :: SnapshotVersion -> String
prettySnapshotVersion :: SnapshotVersion -> String
prettySnapshotVersion SnapshotVersion
V0 = String
"v0"

-- >>> currentSnapshotVersion
-- V0
currentSnapshotVersion :: SnapshotVersion
currentSnapshotVersion :: SnapshotVersion
currentSnapshotVersion = SnapshotVersion
V0

isCompatible :: SnapshotVersion -> Either String ()
isCompatible :: SnapshotVersion -> Either String ()
isCompatible SnapshotVersion
otherVersion = do
    case ( SnapshotVersion
currentSnapshotVersion, SnapshotVersion
otherVersion ) of
      (SnapshotVersion
V0, SnapshotVersion
V0) -> () -> Either String ()
forall a b. b -> Either a b
Right ()

{-------------------------------------------------------------------------------
  Writing and reading files
-------------------------------------------------------------------------------}

{-# SPECIALIZE
  writeFileSnapshotMetaData ::
       HasFS IO h
    -> FsPath
    -> FsPath
    -> SnapshotMetaData
    -> IO ()
  #-}
-- | Encode 'SnapshotMetaData' and write it to 'SnapshotMetaDataFile'.
--
-- In the presence of exceptions, newly created files will not be removed. It is
-- up to the user of this function to clean up the files.
writeFileSnapshotMetaData ::
     MonadThrow m
  => HasFS m h
  -> FsPath -- ^ Target file for snapshot metadata
  -> FsPath -- ^ Target file for checksum
  -> SnapshotMetaData
  -> m ()
writeFileSnapshotMetaData :: forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FsPath -> FsPath -> SnapshotMetaData -> m ()
writeFileSnapshotMetaData HasFS m h
hfs FsPath
contentPath FsPath
checksumPath SnapshotMetaData
snapMetaData = do
    (Word64
_, CRC32C
checksum) <-
      HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (Word64, CRC32C))
-> m (Word64, CRC32C)
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
FS.withFile HasFS m h
hfs FsPath
contentPath (AllowExisting -> OpenMode
FS.WriteMode AllowExisting
FS.MustBeNew) ((Handle h -> m (Word64, CRC32C)) -> m (Word64, CRC32C))
-> (Handle h -> m (Word64, CRC32C)) -> m (Word64, CRC32C)
forall a b. (a -> b) -> a -> b
$ \Handle h
h ->
        HasFS m h -> Handle h -> ByteString -> CRC32C -> m (Word64, CRC32C)
forall (m :: * -> *) h.
Monad m =>
HasFS m h -> Handle h -> ByteString -> CRC32C -> m (Word64, CRC32C)
hPutAllChunksCRC32C HasFS m h
hfs Handle h
h (SnapshotMetaData -> ByteString
encodeSnapshotMetaData SnapshotMetaData
snapMetaData) CRC32C
initialCRC32C

    let checksumFileName :: ChecksumsFileName
checksumFileName = ByteString -> ChecksumsFileName
ChecksumsFileName (String -> ByteString
BSC.pack String
"metadata")
        checksumFile :: Map ChecksumsFileName CRC32C
checksumFile = ChecksumsFileName -> CRC32C -> Map ChecksumsFileName CRC32C
forall k a. k -> a -> Map k a
Map.singleton ChecksumsFileName
checksumFileName CRC32C
checksum
    HasFS m h -> FsPath -> Map ChecksumsFileName CRC32C -> m ()
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FsPath -> Map ChecksumsFileName CRC32C -> m ()
writeChecksumsFile HasFS m h
hfs FsPath
checksumPath Map ChecksumsFileName CRC32C
checksumFile

encodeSnapshotMetaData :: SnapshotMetaData -> ByteString
encodeSnapshotMetaData :: SnapshotMetaData -> ByteString
encodeSnapshotMetaData = Encoding -> ByteString
toLazyByteString (Encoding -> ByteString)
-> (SnapshotMetaData -> Encoding) -> SnapshotMetaData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned SnapshotMetaData -> Encoding
forall a. Encode a => a -> Encoding
encode (Versioned SnapshotMetaData -> Encoding)
-> (SnapshotMetaData -> Versioned SnapshotMetaData)
-> SnapshotMetaData
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapshotMetaData -> Versioned SnapshotMetaData
forall a. a -> Versioned a
Versioned

{-# SPECIALIZE
  readFileSnapshotMetaData ::
       HasFS IO h
    -> FsPath
    -> FsPath
    -> IO SnapshotMetaData
  #-}
-- | Read from 'SnapshotMetaDataFile' and attempt to decode it to
-- 'SnapshotMetaData'.
readFileSnapshotMetaData ::
     (MonadThrow m)
  => HasFS m h
  -> FsPath -- ^ Source file for snapshot metadata
  -> FsPath -- ^ Source file for checksum
  -> m SnapshotMetaData
readFileSnapshotMetaData :: forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FsPath -> FsPath -> m SnapshotMetaData
readFileSnapshotMetaData HasFS m h
hfs FsPath
contentPath FsPath
checksumPath = do
    Map ChecksumsFileName CRC32C
checksumFile <- HasFS m h -> FsPath -> m (Map ChecksumsFileName CRC32C)
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FsPath -> m (Map ChecksumsFileName CRC32C)
readChecksumsFile HasFS m h
hfs FsPath
checksumPath
    let checksumFileName :: ChecksumsFileName
checksumFileName = ByteString -> ChecksumsFileName
ChecksumsFileName (String -> ByteString
BSC.pack String
"metadata")

    CRC32C
expectedChecksum <- FsPath
-> Map ChecksumsFileName CRC32C -> ChecksumsFileName -> m CRC32C
forall (m :: * -> *).
MonadThrow m =>
FsPath
-> Map ChecksumsFileName CRC32C -> ChecksumsFileName -> m CRC32C
getChecksum FsPath
checksumPath Map ChecksumsFileName CRC32C
checksumFile ChecksumsFileName
checksumFileName

    (ByteString
lbs, CRC32C
actualChecksum) <- HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (ByteString, CRC32C))
-> m (ByteString, CRC32C)
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
FS.withFile HasFS m h
hfs FsPath
contentPath OpenMode
FS.ReadMode ((Handle h -> m (ByteString, CRC32C)) -> m (ByteString, CRC32C))
-> (Handle h -> m (ByteString, CRC32C)) -> m (ByteString, CRC32C)
forall a b. (a -> b) -> a -> b
$ \Handle h
h -> do
      Word64
n <- HasFS m h -> HasCallStack => Handle h -> m Word64
forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
FS.hGetSize HasFS m h
hfs Handle h
h
      HasFS m h -> Handle h -> Word64 -> CRC32C -> m (ByteString, CRC32C)
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> Handle h -> Word64 -> CRC32C -> m (ByteString, CRC32C)
FS.hGetExactlyCRC32C HasFS m h
hfs Handle h
h Word64
n CRC32C
initialCRC32C

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CRC32C
expectedChecksum CRC32C -> CRC32C -> Bool
forall a. Eq a => a -> a -> Bool
/= CRC32C
actualChecksum) (m () -> m ())
-> (FileCorruptedError -> m ()) -> FileCorruptedError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileCorruptedError -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FileCorruptedError -> m ()) -> FileCorruptedError -> m ()
forall a b. (a -> b) -> a -> b
$
      FsPath -> Word32 -> Word32 -> FileCorruptedError
ErrFileChecksumMismatch FsPath
contentPath (CRC32C -> Word32
unCRC32C CRC32C
expectedChecksum) (CRC32C -> Word32
unCRC32C CRC32C
actualChecksum)

    FsPath
-> FileFormat
-> Either String SnapshotMetaData
-> m SnapshotMetaData
forall (m :: * -> *) a.
MonadThrow m =>
FsPath -> FileFormat -> Either String a -> m a
expectValidFile FsPath
contentPath FileFormat
FormatSnapshotMetaData (ByteString -> Either String SnapshotMetaData
decodeSnapshotMetaData ByteString
lbs)

decodeSnapshotMetaData :: ByteString -> Either String SnapshotMetaData
decodeSnapshotMetaData :: ByteString -> Either String SnapshotMetaData
decodeSnapshotMetaData ByteString
lbs = (DeserialiseFailure -> String)
-> ((ByteString, Versioned SnapshotMetaData) -> SnapshotMetaData)
-> Either
     DeserialiseFailure (ByteString, Versioned SnapshotMetaData)
-> Either String SnapshotMetaData
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DeserialiseFailure -> String
forall e. Exception e => e -> String
displayException (Versioned SnapshotMetaData -> SnapshotMetaData
forall a. Versioned a -> a
getVersioned (Versioned SnapshotMetaData -> SnapshotMetaData)
-> ((ByteString, Versioned SnapshotMetaData)
    -> Versioned SnapshotMetaData)
-> (ByteString, Versioned SnapshotMetaData)
-> SnapshotMetaData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Versioned SnapshotMetaData)
-> Versioned SnapshotMetaData
forall a b. (a, b) -> b
snd) ((forall s. Decoder s (Versioned SnapshotMetaData))
-> ByteString
-> Either
     DeserialiseFailure (ByteString, Versioned SnapshotMetaData)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes Decoder s (Versioned SnapshotMetaData)
forall s. Decoder s (Versioned SnapshotMetaData)
forall a s. Decode a => Decoder s a
decode ByteString
lbs)

{-------------------------------------------------------------------------------
  Encoding and decoding
-------------------------------------------------------------------------------}

class Encode a where
  encode :: a -> Encoding

-- | Decoder that is not parameterised by a 'SnapshotVersion'.
--
-- Used only for 'SnapshotVersion' and 'Versioned', which live outside the
-- 'SnapshotMetaData' type hierarchy.
class Decode a where
  decode :: Decoder s a

-- | Decoder parameterised by a 'SnapshotVersion'.
--
-- Used for every type in the 'SnapshotMetaData' type hierarchy.
class DecodeVersioned a where
  decodeVersioned :: SnapshotVersion -> Decoder s a

newtype Versioned a = Versioned { forall a. Versioned a -> a
getVersioned :: a }
  deriving stock (Int -> Versioned a -> ShowS
[Versioned a] -> ShowS
Versioned a -> String
(Int -> Versioned a -> ShowS)
-> (Versioned a -> String)
-> ([Versioned a] -> ShowS)
-> Show (Versioned a)
forall a. Show a => Int -> Versioned a -> ShowS
forall a. Show a => [Versioned a] -> ShowS
forall a. Show a => Versioned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Versioned a -> ShowS
showsPrec :: Int -> Versioned a -> ShowS
$cshow :: forall a. Show a => Versioned a -> String
show :: Versioned a -> String
$cshowList :: forall a. Show a => [Versioned a] -> ShowS
showList :: [Versioned a] -> ShowS
Show, Versioned a -> Versioned a -> Bool
(Versioned a -> Versioned a -> Bool)
-> (Versioned a -> Versioned a -> Bool) -> Eq (Versioned a)
forall a. Eq a => Versioned a -> Versioned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Versioned a -> Versioned a -> Bool
== :: Versioned a -> Versioned a -> Bool
$c/= :: forall a. Eq a => Versioned a -> Versioned a -> Bool
/= :: Versioned a -> Versioned a -> Bool
Eq)

instance Encode a => Encode (Versioned a) where
  encode :: Versioned a -> Encoding
encode (Versioned a
x) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotVersion -> Encoding
forall a. Encode a => a -> Encoding
encode SnapshotVersion
currentSnapshotVersion
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. Encode a => a -> Encoding
encode a
x

-- | Decodes a 'SnapshotVersion' first, and then passes that into the versioned
-- decoder for @a@.
instance DecodeVersioned a => Decode (Versioned a) where
  decode :: forall s. Decoder s (Versioned a)
decode = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
      SnapshotVersion
version <- Decoder s SnapshotVersion
forall s. Decoder s SnapshotVersion
forall a s. Decode a => Decoder s a
decode
      case SnapshotVersion -> Either String ()
isCompatible SnapshotVersion
version of
        Right () -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left String
errMsg ->
          String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
            String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Incompatible snapshot format version found. Version %s \
                   \is not backwards compatible with version %s : %s"
                   (SnapshotVersion -> String
prettySnapshotVersion SnapshotVersion
currentSnapshotVersion)
                   (SnapshotVersion -> String
prettySnapshotVersion SnapshotVersion
version)
                   String
errMsg
      a -> Versioned a
forall a. a -> Versioned a
Versioned (a -> Versioned a) -> Decoder s a -> Decoder s (Versioned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s a
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s a
decodeVersioned SnapshotVersion
version

{-------------------------------------------------------------------------------
  Encoding and decoding: Versioning
-------------------------------------------------------------------------------}

instance Encode SnapshotVersion where
  encode :: SnapshotVersion -> Encoding
encode SnapshotVersion
ver =
         Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> case SnapshotVersion
ver of
           SnapshotVersion
V0 -> Word -> Encoding
encodeWord Word
0

instance Decode SnapshotVersion where
  decode :: forall s. Decoder s SnapshotVersion
decode = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
1
      Word
ver <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
ver of
        Word
0 -> SnapshotVersion -> Decoder s SnapshotVersion
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotVersion
V0
        Word
_ -> String -> Decoder s SnapshotVersion
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown snapshot format version number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>  Word -> String
forall a. Show a => a -> String
show Word
ver)

{-------------------------------------------------------------------------------
  Encoding and decoding: SnapshotMetaData
-------------------------------------------------------------------------------}

-- SnapshotMetaData

instance Encode SnapshotMetaData where
  encode :: SnapshotMetaData -> Encoding
encode (SnapshotMetaData SnapshotLabel
label SnapshotTableType
tableType TableConfig
config RunNumber
writeBuffer SnapLevels SnapshotRun
levels Maybe (SnapMergingTree SnapshotRun)
mergingTree) =
         Word -> Encoding
encodeListLen Word
6
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotLabel -> Encoding
forall a. Encode a => a -> Encoding
encode SnapshotLabel
label
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotTableType -> Encoding
forall a. Encode a => a -> Encoding
encode SnapshotTableType
tableType
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TableConfig -> Encoding
forall a. Encode a => a -> Encoding
encode TableConfig
config
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunNumber -> Encoding
forall a. Encode a => a -> Encoding
encode RunNumber
writeBuffer
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapLevels SnapshotRun -> Encoding
forall a. Encode a => a -> Encoding
encode SnapLevels SnapshotRun
levels
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (SnapMergingTree SnapshotRun) -> Encoding
forall a. Encode a => Maybe a -> Encoding
encodeMaybe Maybe (SnapMergingTree SnapshotRun)
mergingTree

instance DecodeVersioned SnapshotMetaData where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s SnapshotMetaData
decodeVersioned ver :: SnapshotVersion
ver@SnapshotVersion
V0 = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
6
      SnapshotLabel
-> SnapshotTableType
-> TableConfig
-> RunNumber
-> SnapLevels SnapshotRun
-> Maybe (SnapMergingTree SnapshotRun)
-> SnapshotMetaData
SnapshotMetaData
        (SnapshotLabel
 -> SnapshotTableType
 -> TableConfig
 -> RunNumber
 -> SnapLevels SnapshotRun
 -> Maybe (SnapMergingTree SnapshotRun)
 -> SnapshotMetaData)
-> Decoder s SnapshotLabel
-> Decoder
     s
     (SnapshotTableType
      -> TableConfig
      -> RunNumber
      -> SnapLevels SnapshotRun
      -> Maybe (SnapMergingTree SnapshotRun)
      -> SnapshotMetaData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s SnapshotLabel
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s SnapshotLabel
decodeVersioned SnapshotVersion
ver
        Decoder
  s
  (SnapshotTableType
   -> TableConfig
   -> RunNumber
   -> SnapLevels SnapshotRun
   -> Maybe (SnapMergingTree SnapshotRun)
   -> SnapshotMetaData)
-> Decoder s SnapshotTableType
-> Decoder
     s
     (TableConfig
      -> RunNumber
      -> SnapLevels SnapshotRun
      -> Maybe (SnapMergingTree SnapshotRun)
      -> SnapshotMetaData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s SnapshotTableType
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s SnapshotTableType
decodeVersioned SnapshotVersion
ver
        Decoder
  s
  (TableConfig
   -> RunNumber
   -> SnapLevels SnapshotRun
   -> Maybe (SnapMergingTree SnapshotRun)
   -> SnapshotMetaData)
-> Decoder s TableConfig
-> Decoder
     s
     (RunNumber
      -> SnapLevels SnapshotRun
      -> Maybe (SnapMergingTree SnapshotRun)
      -> SnapshotMetaData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s TableConfig
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s TableConfig
decodeVersioned SnapshotVersion
ver
        Decoder
  s
  (RunNumber
   -> SnapLevels SnapshotRun
   -> Maybe (SnapMergingTree SnapshotRun)
   -> SnapshotMetaData)
-> Decoder s RunNumber
-> Decoder
     s
     (SnapLevels SnapshotRun
      -> Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s RunNumber
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunNumber
decodeVersioned SnapshotVersion
ver
        Decoder
  s
  (SnapLevels SnapshotRun
   -> Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData)
-> Decoder s (SnapLevels SnapshotRun)
-> Decoder
     s (Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (SnapLevels SnapshotRun)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (SnapLevels SnapshotRun)
decodeVersioned SnapshotVersion
ver
        Decoder s (Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData)
-> Decoder s (Maybe (SnapMergingTree SnapshotRun))
-> Decoder s SnapshotMetaData
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (Maybe (SnapMergingTree SnapshotRun))
forall a s.
DecodeVersioned a =>
SnapshotVersion -> Decoder s (Maybe a)
decodeMaybe SnapshotVersion
ver

-- SnapshotLabel

instance Encode SnapshotLabel where
  encode :: SnapshotLabel -> Encoding
encode (SnapshotLabel Text
s) = Text -> Encoding
encodeString Text
s

instance DecodeVersioned SnapshotLabel where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s SnapshotLabel
decodeVersioned SnapshotVersion
V0 = Text -> SnapshotLabel
SnapshotLabel (Text -> SnapshotLabel)
-> Decoder s Text -> Decoder s SnapshotLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
decodeString

-- TableType

instance Encode SnapshotTableType where
  encode :: SnapshotTableType -> Encoding
encode SnapshotTableType
SnapNormalTable   = Word -> Encoding
encodeWord Word
0
  encode SnapshotTableType
SnapMonoidalTable = Word -> Encoding
encodeWord Word
1
  encode SnapshotTableType
SnapFullTable     = Word -> Encoding
encodeWord Word
2

instance DecodeVersioned SnapshotTableType where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s SnapshotTableType
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> SnapshotTableType -> Decoder s SnapshotTableType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotTableType
SnapNormalTable
        Word
1 -> SnapshotTableType -> Decoder s SnapshotTableType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotTableType
SnapMonoidalTable
        Word
2 -> SnapshotTableType -> Decoder s SnapshotTableType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotTableType
SnapFullTable
        Word
_ -> String -> Decoder s SnapshotTableType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapshotTableType] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

instance Encode SnapshotRun where
  encode :: SnapshotRun -> Encoding
encode SnapshotRun { RunNumber
snapRunNumber :: RunNumber
snapRunNumber :: SnapshotRun -> RunNumber
snapRunNumber, RunDataCaching
snapRunCaching :: RunDataCaching
snapRunCaching :: SnapshotRun -> RunDataCaching
snapRunCaching, IndexType
snapRunIndex :: IndexType
snapRunIndex :: SnapshotRun -> IndexType
snapRunIndex } =
         Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunNumber -> Encoding
forall a. Encode a => a -> Encoding
encode RunNumber
snapRunNumber
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunDataCaching -> Encoding
forall a. Encode a => a -> Encoding
encode RunDataCaching
snapRunCaching
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> IndexType -> Encoding
forall a. Encode a => a -> Encoding
encode IndexType
snapRunIndex

instance DecodeVersioned SnapshotRun where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s SnapshotRun
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
4, Word
0) -> do RunNumber
snapRunNumber  <- SnapshotVersion -> Decoder s RunNumber
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunNumber
decodeVersioned SnapshotVersion
v
                     RunDataCaching
snapRunCaching <- SnapshotVersion -> Decoder s RunDataCaching
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunDataCaching
decodeVersioned SnapshotVersion
v
                     IndexType
snapRunIndex   <- SnapshotVersion -> Decoder s IndexType
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s IndexType
decodeVersioned SnapshotVersion
v
                     SnapshotRun -> Decoder s SnapshotRun
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotRun{RunNumber
IndexType
RunDataCaching
snapRunNumber :: RunNumber
snapRunCaching :: RunDataCaching
snapRunIndex :: IndexType
snapRunNumber :: RunNumber
snapRunCaching :: RunDataCaching
snapRunIndex :: IndexType
..}
        (Int, Word)
_ -> String -> Decoder s SnapshotRun
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapshotRun] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

{-------------------------------------------------------------------------------
  Encoding and decoding: TableConfig
-------------------------------------------------------------------------------}

-- TableConfig

instance Encode TableConfig where
  encode :: TableConfig -> Encoding
encode TableConfig
config =
         Word -> Encoding
encodeListLen Word
7
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MergePolicy -> Encoding
forall a. Encode a => a -> Encoding
encode MergePolicy
mergePolicy
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SizeRatio -> Encoding
forall a. Encode a => a -> Encoding
encode SizeRatio
sizeRatio
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> WriteBufferAlloc -> Encoding
forall a. Encode a => a -> Encoding
encode WriteBufferAlloc
writeBufferAlloc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BloomFilterAlloc -> Encoding
forall a. Encode a => a -> Encoding
encode BloomFilterAlloc
bloomFilterAlloc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> FencePointerIndexType -> Encoding
forall a. Encode a => a -> Encoding
encode FencePointerIndexType
fencePointerIndex
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DiskCachePolicy -> Encoding
forall a. Encode a => a -> Encoding
encode DiskCachePolicy
diskCachePolicy
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MergeSchedule -> Encoding
forall a. Encode a => a -> Encoding
encode MergeSchedule
mergeSchedule
    where
      TableConfig
        MergePolicy
mergePolicy
        SizeRatio
sizeRatio
        WriteBufferAlloc
writeBufferAlloc
        BloomFilterAlloc
bloomFilterAlloc
        FencePointerIndexType
fencePointerIndex
        DiskCachePolicy
diskCachePolicy
        MergeSchedule
mergeSchedule
        = TableConfig
config

instance DecodeVersioned TableConfig where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s TableConfig
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
7
      MergePolicy
-> SizeRatio
-> WriteBufferAlloc
-> BloomFilterAlloc
-> FencePointerIndexType
-> DiskCachePolicy
-> MergeSchedule
-> TableConfig
TableConfig
        (MergePolicy
 -> SizeRatio
 -> WriteBufferAlloc
 -> BloomFilterAlloc
 -> FencePointerIndexType
 -> DiskCachePolicy
 -> MergeSchedule
 -> TableConfig)
-> Decoder s MergePolicy
-> Decoder
     s
     (SizeRatio
      -> WriteBufferAlloc
      -> BloomFilterAlloc
      -> FencePointerIndexType
      -> DiskCachePolicy
      -> MergeSchedule
      -> TableConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s MergePolicy
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s MergePolicy
decodeVersioned SnapshotVersion
v Decoder
  s
  (SizeRatio
   -> WriteBufferAlloc
   -> BloomFilterAlloc
   -> FencePointerIndexType
   -> DiskCachePolicy
   -> MergeSchedule
   -> TableConfig)
-> Decoder s SizeRatio
-> Decoder
     s
     (WriteBufferAlloc
      -> BloomFilterAlloc
      -> FencePointerIndexType
      -> DiskCachePolicy
      -> MergeSchedule
      -> TableConfig)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s SizeRatio
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s SizeRatio
decodeVersioned SnapshotVersion
v Decoder
  s
  (WriteBufferAlloc
   -> BloomFilterAlloc
   -> FencePointerIndexType
   -> DiskCachePolicy
   -> MergeSchedule
   -> TableConfig)
-> Decoder s WriteBufferAlloc
-> Decoder
     s
     (BloomFilterAlloc
      -> FencePointerIndexType
      -> DiskCachePolicy
      -> MergeSchedule
      -> TableConfig)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s WriteBufferAlloc
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s WriteBufferAlloc
decodeVersioned SnapshotVersion
v
        Decoder
  s
  (BloomFilterAlloc
   -> FencePointerIndexType
   -> DiskCachePolicy
   -> MergeSchedule
   -> TableConfig)
-> Decoder s BloomFilterAlloc
-> Decoder
     s
     (FencePointerIndexType
      -> DiskCachePolicy -> MergeSchedule -> TableConfig)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s BloomFilterAlloc
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s BloomFilterAlloc
decodeVersioned SnapshotVersion
v Decoder
  s
  (FencePointerIndexType
   -> DiskCachePolicy -> MergeSchedule -> TableConfig)
-> Decoder s FencePointerIndexType
-> Decoder s (DiskCachePolicy -> MergeSchedule -> TableConfig)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s FencePointerIndexType
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s FencePointerIndexType
decodeVersioned SnapshotVersion
v Decoder s (DiskCachePolicy -> MergeSchedule -> TableConfig)
-> Decoder s DiskCachePolicy
-> Decoder s (MergeSchedule -> TableConfig)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s DiskCachePolicy
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s DiskCachePolicy
decodeVersioned SnapshotVersion
v
        Decoder s (MergeSchedule -> TableConfig)
-> Decoder s MergeSchedule -> Decoder s TableConfig
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s MergeSchedule
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s MergeSchedule
decodeVersioned SnapshotVersion
v

-- MergePolicy

instance Encode MergePolicy where
  encode :: MergePolicy -> Encoding
encode MergePolicy
MergePolicyLazyLevelling = Word -> Encoding
encodeWord Word
0

instance DecodeVersioned MergePolicy where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s MergePolicy
decodeVersioned SnapshotVersion
V0 =  do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> MergePolicy -> Decoder s MergePolicy
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergePolicy
MergePolicyLazyLevelling
        Word
_ -> String -> Decoder s MergePolicy
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[MergePolicy] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

-- SizeRatio

instance Encode SizeRatio where
  encode :: SizeRatio -> Encoding
encode SizeRatio
Four = Int -> Encoding
encodeInt Int
4

instance DecodeVersioned SizeRatio where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s SizeRatio
decodeVersioned SnapshotVersion
V0 = do
      Word64
x <- Decoder s Word64
forall s. Decoder s Word64
decodeWord64
      case Word64
x of
        Word64
4 -> SizeRatio -> Decoder s SizeRatio
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SizeRatio
Four
        Word64
_ -> String -> Decoder s SizeRatio
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected 4, but found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
x)

-- WriteBufferAlloc

instance Encode WriteBufferAlloc where
  encode :: WriteBufferAlloc -> Encoding
encode (AllocNumEntries NumEntries
numEntries) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NumEntries -> Encoding
forall a. Encode a => a -> Encoding
encode NumEntries
numEntries

instance DecodeVersioned WriteBufferAlloc where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s WriteBufferAlloc
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> NumEntries -> WriteBufferAlloc
AllocNumEntries (NumEntries -> WriteBufferAlloc)
-> Decoder s NumEntries -> Decoder s WriteBufferAlloc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s NumEntries
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s NumEntries
decodeVersioned SnapshotVersion
v
        Word
_ -> String -> Decoder s WriteBufferAlloc
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[WriteBufferAlloc] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

-- NumEntries

instance Encode NumEntries where
  encode :: NumEntries -> Encoding
encode (NumEntries Int
x) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned NumEntries where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s NumEntries
decodeVersioned SnapshotVersion
V0 = Int -> NumEntries
NumEntries (Int -> NumEntries) -> Decoder s Int -> Decoder s NumEntries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

-- RunParams and friends

instance Encode RunParams where
  encode :: RunParams -> Encoding
encode RunParams { RunDataCaching
runParamCaching :: RunDataCaching
runParamCaching :: RunParams -> RunDataCaching
runParamCaching, RunBloomFilterAlloc
runParamAlloc :: RunBloomFilterAlloc
runParamAlloc :: RunParams -> RunBloomFilterAlloc
runParamAlloc, IndexType
runParamIndex :: IndexType
runParamIndex :: RunParams -> IndexType
runParamIndex } =
         Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunDataCaching -> Encoding
forall a. Encode a => a -> Encoding
encode RunDataCaching
runParamCaching
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunBloomFilterAlloc -> Encoding
forall a. Encode a => a -> Encoding
encode RunBloomFilterAlloc
runParamAlloc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> IndexType -> Encoding
forall a. Encode a => a -> Encoding
encode IndexType
runParamIndex

instance DecodeVersioned RunParams where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s RunParams
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
4, Word
0) -> do RunDataCaching
runParamCaching <- SnapshotVersion -> Decoder s RunDataCaching
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunDataCaching
decodeVersioned SnapshotVersion
v
                     RunBloomFilterAlloc
runParamAlloc   <- SnapshotVersion -> Decoder s RunBloomFilterAlloc
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunBloomFilterAlloc
decodeVersioned SnapshotVersion
v
                     IndexType
runParamIndex   <- SnapshotVersion -> Decoder s IndexType
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s IndexType
decodeVersioned SnapshotVersion
v
                     RunParams -> Decoder s RunParams
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunParams{IndexType
RunBloomFilterAlloc
RunDataCaching
runParamCaching :: RunDataCaching
runParamAlloc :: RunBloomFilterAlloc
runParamIndex :: IndexType
runParamCaching :: RunDataCaching
runParamAlloc :: RunBloomFilterAlloc
runParamIndex :: IndexType
..}
        (Int, Word)
_ -> String -> Decoder s RunParams
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RunParams] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

instance Encode RunDataCaching where
  encode :: RunDataCaching -> Encoding
encode RunDataCaching
CacheRunData   = Word -> Encoding
encodeWord Word
0
  encode RunDataCaching
NoCacheRunData = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned RunDataCaching where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s RunDataCaching
decodeVersioned SnapshotVersion
V0 = do
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      Word
0 -> RunDataCaching -> Decoder s RunDataCaching
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunDataCaching
CacheRunData
      Word
1 -> RunDataCaching -> Decoder s RunDataCaching
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunDataCaching
NoCacheRunData
      Word
_ -> String -> Decoder s RunDataCaching
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RunDataCaching] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

instance Encode IndexType where
  encode :: IndexType -> Encoding
encode IndexType
Ordinary = Word -> Encoding
encodeWord Word
0
  encode IndexType
Compact  = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned IndexType where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s IndexType
decodeVersioned SnapshotVersion
V0 = do
    Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
    case Word
tag of
      Word
0 -> IndexType -> Decoder s IndexType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexType
Ordinary
      Word
1 -> IndexType -> Decoder s IndexType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexType
Compact
      Word
_ -> String -> Decoder s IndexType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[IndexType] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

instance Encode RunBloomFilterAlloc where
  encode :: RunBloomFilterAlloc -> Encoding
encode (RunAllocFixed Word64
bits) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
encodeWord64 Word64
bits
  encode (RunAllocRequestFPR Double
fpr) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Double -> Encoding
encodeDouble Double
fpr

instance DecodeVersioned RunBloomFilterAlloc where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s RunBloomFilterAlloc
decodeVersioned SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
2, Word
0) -> Word64 -> RunBloomFilterAlloc
RunAllocFixed      (Word64 -> RunBloomFilterAlloc)
-> Decoder s Word64 -> Decoder s RunBloomFilterAlloc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
        (Int
2, Word
1) -> Double -> RunBloomFilterAlloc
RunAllocRequestFPR (Double -> RunBloomFilterAlloc)
-> Decoder s Double -> Decoder s RunBloomFilterAlloc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Double
forall s. Decoder s Double
decodeDouble
        (Int, Word)
_ -> String -> Decoder s RunBloomFilterAlloc
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RunBloomFilterAlloc] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- BloomFilterAlloc

instance Encode BloomFilterAlloc where
  encode :: BloomFilterAlloc -> Encoding
encode (AllocFixed Word64
x) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
encodeWord64 Word64
x
  encode (AllocRequestFPR Double
x) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Double -> Encoding
encodeDouble Double
x

instance DecodeVersioned BloomFilterAlloc where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s BloomFilterAlloc
decodeVersioned SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
2, Word
0) -> Word64 -> BloomFilterAlloc
AllocFixed (Word64 -> BloomFilterAlloc)
-> Decoder s Word64 -> Decoder s BloomFilterAlloc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
        (Int
2, Word
1) -> Double -> BloomFilterAlloc
AllocRequestFPR (Double -> BloomFilterAlloc)
-> Decoder s Double -> Decoder s BloomFilterAlloc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Double
forall s. Decoder s Double
decodeDouble
        (Int, Word)
_ -> String -> Decoder s BloomFilterAlloc
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[BloomFilterAlloc] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- FencePointerIndexType

instance Encode FencePointerIndexType where
  encode :: FencePointerIndexType -> Encoding
encode FencePointerIndexType
CompactIndex  = Word -> Encoding
encodeWord Word
0
  encode FencePointerIndexType
OrdinaryIndex = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned FencePointerIndexType where
   decodeVersioned :: forall s. SnapshotVersion -> Decoder s FencePointerIndexType
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> FencePointerIndexType -> Decoder s FencePointerIndexType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FencePointerIndexType
CompactIndex
        Word
1 -> FencePointerIndexType -> Decoder s FencePointerIndexType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FencePointerIndexType
OrdinaryIndex
        Word
_ -> String -> Decoder s FencePointerIndexType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[FencePointerIndexType] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

-- DiskCachePolicy

instance Encode DiskCachePolicy where
  encode :: DiskCachePolicy -> Encoding
encode DiskCachePolicy
DiskCacheAll =
         Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
  encode (DiskCacheLevelsAtOrBelow Int
x) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
encodeInt Int
x
  encode DiskCachePolicy
DiskCacheNone =
         Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
2

instance DecodeVersioned DiskCachePolicy where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s DiskCachePolicy
decodeVersioned SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
1, Word
0) -> DiskCachePolicy -> Decoder s DiskCachePolicy
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiskCachePolicy
DiskCacheAll
        (Int
2, Word
1) -> Int -> DiskCachePolicy
DiskCacheLevelsAtOrBelow (Int -> DiskCachePolicy)
-> Decoder s Int -> Decoder s DiskCachePolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt
        (Int
1, Word
2) -> DiskCachePolicy -> Decoder s DiskCachePolicy
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiskCachePolicy
DiskCacheNone
        (Int, Word)
_ -> String -> Decoder s DiskCachePolicy
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[DiskCachePolicy] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- MergeSchedule

instance Encode MergeSchedule where
  encode :: MergeSchedule -> Encoding
encode MergeSchedule
OneShot     = Word -> Encoding
encodeWord Word
0
  encode MergeSchedule
Incremental = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned MergeSchedule where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s MergeSchedule
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> MergeSchedule -> Decoder s MergeSchedule
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeSchedule
OneShot
        Word
1 -> MergeSchedule -> Decoder s MergeSchedule
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeSchedule
Incremental
        Word
_ -> String -> Decoder s MergeSchedule
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[MergeSchedule] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

{-------------------------------------------------------------------------------
  Encoding and decoding: SnapLevels
-------------------------------------------------------------------------------}

-- SnapLevels

instance Encode r => Encode (SnapLevels r) where
  encode :: SnapLevels r -> Encoding
encode (SnapLevels Vector (SnapLevel r)
levels) = Vector (SnapLevel r) -> Encoding
forall a. Encode a => a -> Encoding
encode Vector (SnapLevel r)
levels

instance DecodeVersioned r => DecodeVersioned (SnapLevels r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapLevels r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = Vector (SnapLevel r) -> SnapLevels r
forall r. Vector (SnapLevel r) -> SnapLevels r
SnapLevels (Vector (SnapLevel r) -> SnapLevels r)
-> Decoder s (Vector (SnapLevel r)) -> Decoder s (SnapLevels r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (Vector (SnapLevel r))
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (Vector (SnapLevel r))
decodeVersioned SnapshotVersion
v

-- SnapLevel

instance Encode r => Encode (SnapLevel r) where
  encode :: SnapLevel r -> Encoding
encode (SnapLevel SnapIncomingRun r
incomingRuns Vector r
residentRuns) =
         Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapIncomingRun r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapIncomingRun r
incomingRuns
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector r -> Encoding
forall a. Encode a => a -> Encoding
encode Vector r
residentRuns


instance DecodeVersioned r => DecodeVersioned (SnapLevel r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapLevel r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
      SnapIncomingRun r -> Vector r -> SnapLevel r
forall r. SnapIncomingRun r -> Vector r -> SnapLevel r
SnapLevel (SnapIncomingRun r -> Vector r -> SnapLevel r)
-> Decoder s (SnapIncomingRun r)
-> Decoder s (Vector r -> SnapLevel r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (SnapIncomingRun r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (SnapIncomingRun r)
decodeVersioned SnapshotVersion
v Decoder s (Vector r -> SnapLevel r)
-> Decoder s (Vector r) -> Decoder s (SnapLevel r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (Vector r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (Vector r)
decodeVersioned SnapshotVersion
v

-- Vector

instance Encode r => Encode (V.Vector r) where
  encode :: Vector r -> Encoding
encode = Vector r -> Encoding
forall r. Encode r => Vector r -> Encoding
encodeVector

instance DecodeVersioned r => DecodeVersioned (V.Vector r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (Vector r)
decodeVersioned = SnapshotVersion -> Decoder s (Vector r)
forall a s.
DecodeVersioned a =>
SnapshotVersion -> Decoder s (Vector a)
decodeVector

-- RunNumber

instance Encode RunNumber where
  encode :: RunNumber -> Encoding
encode (RunNumber Int
x) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned RunNumber where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s RunNumber
decodeVersioned SnapshotVersion
V0 = Int -> RunNumber
RunNumber (Int -> RunNumber) -> Decoder s Int -> Decoder s RunNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

-- SnapIncomingRun

instance Encode r => Encode (SnapIncomingRun r) where
  encode :: SnapIncomingRun r -> Encoding
encode (SnapIncomingMergingRun MergePolicyForLevel
mpfl NominalDebt
nd NominalCredits
nc SnapMergingRun LevelMergeType r
smrs) =
       Word -> Encoding
encodeListLen Word
5
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MergePolicyForLevel -> Encoding
forall a. Encode a => a -> Encoding
encode MergePolicyForLevel
mpfl
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NominalDebt -> Encoding
forall a. Encode a => a -> Encoding
encode NominalDebt
nd
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NominalCredits -> Encoding
forall a. Encode a => a -> Encoding
encode NominalCredits
nc
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapMergingRun LevelMergeType r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapMergingRun LevelMergeType r
smrs
  encode (SnapIncomingSingleRun r
x) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> r -> Encoding
forall a. Encode a => a -> Encoding
encode r
x

instance DecodeVersioned r => DecodeVersioned (SnapIncomingRun r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapIncomingRun r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
5, Word
0) -> MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType r
-> SnapIncomingRun r
forall r.
MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType r
-> SnapIncomingRun r
SnapIncomingMergingRun
                    (MergePolicyForLevel
 -> NominalDebt
 -> NominalCredits
 -> SnapMergingRun LevelMergeType r
 -> SnapIncomingRun r)
-> Decoder s MergePolicyForLevel
-> Decoder
     s
     (NominalDebt
      -> NominalCredits
      -> SnapMergingRun LevelMergeType r
      -> SnapIncomingRun r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s MergePolicyForLevel
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s MergePolicyForLevel
decodeVersioned SnapshotVersion
v Decoder
  s
  (NominalDebt
   -> NominalCredits
   -> SnapMergingRun LevelMergeType r
   -> SnapIncomingRun r)
-> Decoder s NominalDebt
-> Decoder
     s
     (NominalCredits
      -> SnapMergingRun LevelMergeType r -> SnapIncomingRun r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s NominalDebt
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s NominalDebt
decodeVersioned SnapshotVersion
v
                    Decoder
  s
  (NominalCredits
   -> SnapMergingRun LevelMergeType r -> SnapIncomingRun r)
-> Decoder s NominalCredits
-> Decoder s (SnapMergingRun LevelMergeType r -> SnapIncomingRun r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s NominalCredits
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s NominalCredits
decodeVersioned SnapshotVersion
v Decoder s (SnapMergingRun LevelMergeType r -> SnapIncomingRun r)
-> Decoder s (SnapMergingRun LevelMergeType r)
-> Decoder s (SnapIncomingRun r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (SnapMergingRun LevelMergeType r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s.
SnapshotVersion -> Decoder s (SnapMergingRun LevelMergeType r)
decodeVersioned SnapshotVersion
v
        (Int
2, Word
1) -> r -> SnapIncomingRun r
forall r. r -> SnapIncomingRun r
SnapIncomingSingleRun (r -> SnapIncomingRun r)
-> Decoder s r -> Decoder s (SnapIncomingRun r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s r
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s r
decodeVersioned SnapshotVersion
v
        (Int, Word)
_ -> String -> Decoder s (SnapIncomingRun r)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapIncomingRun] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- MergePolicyForLevel

instance Encode MergePolicyForLevel where
  encode :: MergePolicyForLevel -> Encoding
encode MergePolicyForLevel
LevelTiering   = Word -> Encoding
encodeWord Word
0
  encode MergePolicyForLevel
LevelLevelling = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned MergePolicyForLevel where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s MergePolicyForLevel
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> MergePolicyForLevel -> Decoder s MergePolicyForLevel
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergePolicyForLevel
LevelTiering
        Word
1 -> MergePolicyForLevel -> Decoder s MergePolicyForLevel
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergePolicyForLevel
LevelLevelling
        Word
_ -> String -> Decoder s MergePolicyForLevel
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[MergePolicyForLevel] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

-- SnapMergingRun

instance (Encode t, Encode r) => Encode (SnapMergingRun t r) where
  encode :: SnapMergingRun t r -> Encoding
encode (SnapCompletedMerge MergeDebt
md r
r) =
         Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MergeDebt -> Encoding
forall a. Encode a => a -> Encoding
encode MergeDebt
md
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> r -> Encoding
forall a. Encode a => a -> Encoding
encode r
r
  encode (SnapOngoingMerge RunParams
rp MergeCredits
mc Vector r
rs t
mt) =
         Word -> Encoding
encodeListLen Word
5
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RunParams -> Encoding
forall a. Encode a => a -> Encoding
encode RunParams
rp
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MergeCredits -> Encoding
forall a. Encode a => a -> Encoding
encode MergeCredits
mc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector r -> Encoding
forall a. Encode a => a -> Encoding
encode Vector r
rs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> t -> Encoding
forall a. Encode a => a -> Encoding
encode t
mt

instance (DecodeVersioned t, DecodeVersioned r) => DecodeVersioned (SnapMergingRun t r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapMergingRun t r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
3, Word
0) -> MergeDebt -> r -> SnapMergingRun t r
forall t r. MergeDebt -> r -> SnapMergingRun t r
SnapCompletedMerge (MergeDebt -> r -> SnapMergingRun t r)
-> Decoder s MergeDebt -> Decoder s (r -> SnapMergingRun t r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s MergeDebt
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s MergeDebt
decodeVersioned SnapshotVersion
v
                                     Decoder s (r -> SnapMergingRun t r)
-> Decoder s r -> Decoder s (SnapMergingRun t r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s r
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s r
decodeVersioned SnapshotVersion
v
        (Int
5, Word
1) -> RunParams -> MergeCredits -> Vector r -> t -> SnapMergingRun t r
forall t r.
RunParams -> MergeCredits -> Vector r -> t -> SnapMergingRun t r
SnapOngoingMerge (RunParams -> MergeCredits -> Vector r -> t -> SnapMergingRun t r)
-> Decoder s RunParams
-> Decoder s (MergeCredits -> Vector r -> t -> SnapMergingRun t r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s RunParams
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s RunParams
decodeVersioned SnapshotVersion
v Decoder s (MergeCredits -> Vector r -> t -> SnapMergingRun t r)
-> Decoder s MergeCredits
-> Decoder s (Vector r -> t -> SnapMergingRun t r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s MergeCredits
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s MergeCredits
decodeVersioned SnapshotVersion
v
                                   Decoder s (Vector r -> t -> SnapMergingRun t r)
-> Decoder s (Vector r) -> Decoder s (t -> SnapMergingRun t r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (Vector r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (Vector r)
decodeVersioned SnapshotVersion
v Decoder s (t -> SnapMergingRun t r)
-> Decoder s t -> Decoder s (SnapMergingRun t r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s t
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s t
decodeVersioned SnapshotVersion
v
        (Int, Word)
_ -> String -> Decoder s (SnapMergingRun t r)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapMergingRun] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- NominalDebt, NominalCredits, MergeDebt and MergeCredits

instance Encode NominalDebt where
  encode :: NominalDebt -> Encoding
encode (NominalDebt Int
x) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned NominalDebt where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s NominalDebt
decodeVersioned SnapshotVersion
V0 = Int -> NominalDebt
NominalDebt (Int -> NominalDebt) -> Decoder s Int -> Decoder s NominalDebt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

instance Encode NominalCredits where
  encode :: NominalCredits -> Encoding
encode (NominalCredits Int
x) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned NominalCredits where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s NominalCredits
decodeVersioned SnapshotVersion
V0 = Int -> NominalCredits
NominalCredits (Int -> NominalCredits)
-> Decoder s Int -> Decoder s NominalCredits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

instance Encode MergeDebt where
  encode :: MergeDebt -> Encoding
encode (MergeDebt (MergeCredits Int
x)) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned MergeDebt where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s MergeDebt
decodeVersioned SnapshotVersion
V0 = (MergeCredits -> MergeDebt
MergeDebt (MergeCredits -> MergeDebt)
-> (Int -> MergeCredits) -> Int -> MergeDebt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MergeCredits
MergeCredits) (Int -> MergeDebt) -> Decoder s Int -> Decoder s MergeDebt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

instance Encode MergeCredits where
  encode :: MergeCredits -> Encoding
encode (MergeCredits Int
x) = Int -> Encoding
encodeInt Int
x

instance DecodeVersioned MergeCredits where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s MergeCredits
decodeVersioned SnapshotVersion
V0 = Int -> MergeCredits
MergeCredits (Int -> MergeCredits) -> Decoder s Int -> Decoder s MergeCredits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeInt

-- MergeType

instance Encode MR.LevelMergeType  where
  encode :: LevelMergeType -> Encoding
encode LevelMergeType
MR.MergeMidLevel  = Word -> Encoding
encodeWord Word
0
  encode LevelMergeType
MR.MergeLastLevel = Word -> Encoding
encodeWord Word
1

instance DecodeVersioned MR.LevelMergeType where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s LevelMergeType
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
0 -> LevelMergeType -> Decoder s LevelMergeType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LevelMergeType
MR.MergeMidLevel
        Word
1 -> LevelMergeType -> Decoder s LevelMergeType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LevelMergeType
MR.MergeLastLevel
        Word
_ -> String -> Decoder s LevelMergeType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[LevelMergeType] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

-- | We start the tags for these merge types at an offset. This way, if we
-- serialise @MR.MergeMidLevel :: MR.LevelMergeType@ as 0 and then accidentally
-- try deserialising it as a @MR.TreeMergeType@, that will fail.
--
-- However, 'MR.LevelMergeType' and 'MR.TreeMergeType' are only different
-- (overlapping) subsets of 'MR.MergeType'. In particular, 'MR.MergeLastLevel'
-- and 'MR.MergeLevel' are semantically the same. Encoding them as the same
-- number leaves the door open to relaxing the restrictions on which merge types
-- can occur where, e.g. decoding them as a general 'MR.MergeType', without
-- having to change the file format.
instance Encode MR.TreeMergeType  where
  encode :: TreeMergeType -> Encoding
encode TreeMergeType
MR.MergeLevel = Word -> Encoding
encodeWord Word
1
  encode TreeMergeType
MR.MergeUnion = Word -> Encoding
encodeWord Word
2

instance DecodeVersioned MR.TreeMergeType where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s TreeMergeType
decodeVersioned SnapshotVersion
V0 = do
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case Word
tag of
        Word
1 -> TreeMergeType -> Decoder s TreeMergeType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeMergeType
MR.MergeLevel
        Word
2 -> TreeMergeType -> Decoder s TreeMergeType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeMergeType
MR.MergeUnion
        Word
_ -> String -> Decoder s TreeMergeType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[TreeMergeType] Unexpected tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag)

{-------------------------------------------------------------------------------
  Encoding and decoding: SnapMergingTree
-------------------------------------------------------------------------------}

-- SnapMergingTree

instance Encode r => Encode (SnapMergingTree r) where
  encode :: SnapMergingTree r -> Encoding
encode (SnapMergingTree SnapMergingTreeState r
tState) = SnapMergingTreeState r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapMergingTreeState r
tState

instance DecodeVersioned r => DecodeVersioned (SnapMergingTree r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapMergingTree r)
decodeVersioned ver :: SnapshotVersion
ver@SnapshotVersion
V0 = SnapMergingTreeState r -> SnapMergingTree r
forall r. SnapMergingTreeState r -> SnapMergingTree r
SnapMergingTree (SnapMergingTreeState r -> SnapMergingTree r)
-> Decoder s (SnapMergingTreeState r)
-> Decoder s (SnapMergingTree r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (SnapMergingTreeState r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (SnapMergingTreeState r)
decodeVersioned SnapshotVersion
ver

-- SnapMergingTreeState

instance Encode r => Encode (SnapMergingTreeState r) where
  encode :: SnapMergingTreeState r -> Encoding
encode (SnapCompletedTreeMerge r
x) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> r -> Encoding
forall a. Encode a => a -> Encoding
encode r
x
  encode (SnapPendingTreeMerge SnapPendingMerge r
x) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapPendingMerge r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapPendingMerge r
x
  encode (SnapOngoingTreeMerge SnapMergingRun TreeMergeType r
smrs) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapMergingRun TreeMergeType r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapMergingRun TreeMergeType r
smrs

instance DecodeVersioned r => DecodeVersioned (SnapMergingTreeState r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapMergingTreeState r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
2, Word
0) -> r -> SnapMergingTreeState r
forall r. r -> SnapMergingTreeState r
SnapCompletedTreeMerge (r -> SnapMergingTreeState r)
-> Decoder s r -> Decoder s (SnapMergingTreeState r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s r
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s r
decodeVersioned SnapshotVersion
v
        (Int
2, Word
1) -> SnapPendingMerge r -> SnapMergingTreeState r
forall r. SnapPendingMerge r -> SnapMergingTreeState r
SnapPendingTreeMerge (SnapPendingMerge r -> SnapMergingTreeState r)
-> Decoder s (SnapPendingMerge r)
-> Decoder s (SnapMergingTreeState r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (SnapPendingMerge r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s (SnapPendingMerge r)
decodeVersioned SnapshotVersion
v
        (Int
2, Word
2) -> SnapMergingRun TreeMergeType r -> SnapMergingTreeState r
forall r. SnapMergingRun TreeMergeType r -> SnapMergingTreeState r
SnapOngoingTreeMerge (SnapMergingRun TreeMergeType r -> SnapMergingTreeState r)
-> Decoder s (SnapMergingRun TreeMergeType r)
-> Decoder s (SnapMergingTreeState r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (SnapMergingRun TreeMergeType r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s.
SnapshotVersion -> Decoder s (SnapMergingRun TreeMergeType r)
decodeVersioned SnapshotVersion
v
        (Int, Word)
_ -> String -> Decoder s (SnapMergingTreeState r)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapMergingTreeState] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- SnapPendingMerge

instance Encode r => Encode (SnapPendingMerge r) where
  encode :: SnapPendingMerge r -> Encoding
encode (SnapPendingLevelMerge [SnapPreExistingRun r]
pe Maybe (SnapMergingTree r)
mt) =
      Word -> Encoding
encodeListLen Word
3
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [SnapPreExistingRun r] -> Encoding
forall a. Encode a => [a] -> Encoding
encodeList [SnapPreExistingRun r]
pe
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (SnapMergingTree r) -> Encoding
forall a. Encode a => Maybe a -> Encoding
encodeMaybe Maybe (SnapMergingTree r)
mt
  encode (SnapPendingUnionMerge [SnapMergingTree r]
mts) =
      Word -> Encoding
encodeListLen Word
2
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [SnapMergingTree r] -> Encoding
forall a. Encode a => [a] -> Encoding
encodeList [SnapMergingTree r]
mts

instance DecodeVersioned r => DecodeVersioned (SnapPendingMerge r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapPendingMerge r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
3, Word
0) -> [SnapPreExistingRun r]
-> Maybe (SnapMergingTree r) -> SnapPendingMerge r
forall r.
[SnapPreExistingRun r]
-> Maybe (SnapMergingTree r) -> SnapPendingMerge r
SnapPendingLevelMerge ([SnapPreExistingRun r]
 -> Maybe (SnapMergingTree r) -> SnapPendingMerge r)
-> Decoder s [SnapPreExistingRun r]
-> Decoder s (Maybe (SnapMergingTree r) -> SnapPendingMerge r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s [SnapPreExistingRun r]
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s [a]
decodeList SnapshotVersion
v Decoder s (Maybe (SnapMergingTree r) -> SnapPendingMerge r)
-> Decoder s (Maybe (SnapMergingTree r))
-> Decoder s (SnapPendingMerge r)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotVersion -> Decoder s (Maybe (SnapMergingTree r))
forall a s.
DecodeVersioned a =>
SnapshotVersion -> Decoder s (Maybe a)
decodeMaybe SnapshotVersion
v
        (Int
2, Word
1) -> [SnapMergingTree r] -> SnapPendingMerge r
forall r. [SnapMergingTree r] -> SnapPendingMerge r
SnapPendingUnionMerge ([SnapMergingTree r] -> SnapPendingMerge r)
-> Decoder s [SnapMergingTree r] -> Decoder s (SnapPendingMerge r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s [SnapMergingTree r]
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s [a]
decodeList SnapshotVersion
v
        (Int, Word)
_ -> String -> Decoder s (SnapPendingMerge r)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapPendingMerge] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- SnapPreExistingRun

instance Encode r => Encode (SnapPreExistingRun r) where
  encode :: SnapPreExistingRun r -> Encoding
encode (SnapPreExistingRun r
x) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> r -> Encoding
forall a. Encode a => a -> Encoding
encode r
x
  encode (SnapPreExistingMergingRun SnapMergingRun LevelMergeType r
smrs) =
       Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapMergingRun LevelMergeType r -> Encoding
forall a. Encode a => a -> Encoding
encode SnapMergingRun LevelMergeType r
smrs

instance DecodeVersioned r => DecodeVersioned (SnapPreExistingRun r) where
  decodeVersioned :: forall s. SnapshotVersion -> Decoder s (SnapPreExistingRun r)
decodeVersioned v :: SnapshotVersion
v@SnapshotVersion
V0 = do
      Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
      Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
      case (Int
n, Word
tag) of
        (Int
2, Word
0) -> r -> SnapPreExistingRun r
forall r. r -> SnapPreExistingRun r
SnapPreExistingRun (r -> SnapPreExistingRun r)
-> Decoder s r -> Decoder s (SnapPreExistingRun r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s r
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s r
decodeVersioned SnapshotVersion
v
        (Int
2, Word
1) -> SnapMergingRun LevelMergeType r -> SnapPreExistingRun r
forall r. SnapMergingRun LevelMergeType r -> SnapPreExistingRun r
SnapPreExistingMergingRun (SnapMergingRun LevelMergeType r -> SnapPreExistingRun r)
-> Decoder s (SnapMergingRun LevelMergeType r)
-> Decoder s (SnapPreExistingRun r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s (SnapMergingRun LevelMergeType r)
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s.
SnapshotVersion -> Decoder s (SnapMergingRun LevelMergeType r)
decodeVersioned SnapshotVersion
v
        (Int, Word)
_ -> String -> Decoder s (SnapPreExistingRun r)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[SnapPreExistingRun] Unexpected combination of list length and tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word) -> String
forall a. Show a => a -> String
show (Int
n, Word
tag))

-- Utilities for encoding/decoding Maybe values

--Note: the Maybe encoding cannot be nested like (Maybe (Maybe a)), but it is
-- ok for fields of records.
encodeMaybe :: Encode a => Maybe a -> Encoding
encodeMaybe :: forall a. Encode a => Maybe a -> Encoding
encodeMaybe = \case
  Maybe a
Nothing -> Encoding
encodeNull
  Just a
en -> a -> Encoding
forall a. Encode a => a -> Encoding
encode a
en

decodeMaybe :: DecodeVersioned a => SnapshotVersion -> Decoder s (Maybe a)
decodeMaybe :: forall a s.
DecodeVersioned a =>
SnapshotVersion -> Decoder s (Maybe a)
decodeMaybe v :: SnapshotVersion
v@SnapshotVersion
V0 = do
    TokenType
tok <- Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType
    case TokenType
tok of
      TokenType
TypeNull -> Maybe a
forall a. Maybe a
Nothing Maybe a -> Decoder s () -> Decoder s (Maybe a)
forall a b. a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder s ()
forall s. Decoder s ()
decodeNull
      TokenType
_        -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder s a -> Decoder s (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotVersion -> Decoder s a
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s a
decodeVersioned SnapshotVersion
v

encodeList :: Encode a => [a] -> Encoding
encodeList :: forall a. Encode a => [a] -> Encoding
encodeList [a]
xs =
    Word -> Encoding
encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs))
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> [a] -> Encoding
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Encoding
r -> a -> Encoding
forall a. Encode a => a -> Encoding
encode a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
forall a. Monoid a => a
mempty [a]
xs

decodeList :: DecodeVersioned a => SnapshotVersion -> Decoder s [a]
decodeList :: forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s [a]
decodeList SnapshotVersion
v = do
    Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Int -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
decodeSequenceLenN ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Int
n (SnapshotVersion -> Decoder s a
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s a
decodeVersioned SnapshotVersion
v)

encodeVector :: Encode a => V.Vector a -> Encoding
encodeVector :: forall r. Encode r => Vector r -> Encoding
encodeVector Vector a
xs =
    Word -> Encoding
encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs))
 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> Vector a -> Encoding
forall a b. (a -> b -> b) -> b -> Vector a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Encoding
r -> a -> Encoding
forall a. Encode a => a -> Encoding
encode a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
forall a. Monoid a => a
mempty Vector a
xs

decodeVector :: DecodeVersioned a => SnapshotVersion -> Decoder s (V.Vector a)
decodeVector :: forall a s.
DecodeVersioned a =>
SnapshotVersion -> Decoder s (Vector a)
decodeVector SnapshotVersion
v = do
    Int
n <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    ([a] -> a -> [a])
-> [a]
-> ([a] -> Vector a)
-> Int
-> Decoder s a
-> Decoder s (Vector a)
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
decodeSequenceLenN ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] (Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse (Vector a -> Vector a) -> ([a] -> Vector a) -> [a] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList)
                       Int
n (SnapshotVersion -> Decoder s a
forall a s. DecodeVersioned a => SnapshotVersion -> Decoder s a
forall s. SnapshotVersion -> Decoder s a
decodeVersioned SnapshotVersion
v)