Merge pull request #616 from IntersectMBO/wenkokke/remove-deserialiseValueN

fix: remove unused `deserialiseValueN`

Author: jorisdral

bench/micro/Bench/Database/LSMTree/Normal.hs

@@ -52,7 +52,6 @@ instance NFData V1 where
 instance SerialiseValue V1 where
   serialiseValue (V1 x s) = serialiseValue x <> serialiseValue s
   deserialiseValue rb = V1 (deserialiseValue $ RB.take 8 rb) (deserialiseValue $ RB.drop 8 rb)
-  deserialiseValueN _ = error "deserialiseValueN: unused"
 
 newtype B1 = B1 Void
   deriving newtype (Show, Eq, Ord, NFData, SerialiseValue)

src-extras/Database/LSMTree/Extras/Orphans.hs

@@ -58,7 +58,6 @@ instance SerialiseValue Word256 where
   deserialiseValue (RawBytes (VP.Vector off len ba)) =
     requireBytesExactly "Word256" 32 len $
       indexWord8ArrayAsWord256 ba off
-  deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary Word256 where
   arbitrary = Word256 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -116,7 +115,6 @@ instance SerialiseValue Word128 where
   deserialiseValue (RawBytes (VP.Vector off len ba)) =
     requireBytesExactly "Word128" 16 len $
       indexWord8ArrayAsWord128 ba off
-  deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary Word128 where
   arbitrary = Word128 <$> arbitrary <*> arbitrary
@@ -162,7 +160,6 @@ instance SerialiseKey RawBytes where
 instance SerialiseValue RawBytes where
   serialiseValue = id
   deserialiseValue = id
-  deserialiseValueN = mconcat
 
 {-------------------------------------------------------------------------------
   SerialisedKey/Value/Blob

src-extras/Database/LSMTree/Extras/UTxO.hs

@@ -114,7 +114,6 @@ instance SerialiseValue UTxOValue where
                 (indexWord8ArrayAsWord128 ba (off + 32))
                 (indexWord8ArrayAsWord64  ba (off + 48))
                 (indexWord8ArrayAsWord32  ba (off + 56))
-  deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary UTxOValue where
   arbitrary = UTxOValue <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -150,4 +149,3 @@ newtype UTxOBlob = UTxOBlob BS.ByteString
 instance SerialiseValue UTxOBlob where
   serialiseValue (UTxOBlob bs) = Class.serialiseValue bs
   deserialiseValue = error "deserialiseValue: UTxOBlob"
-  deserialiseValueN = error "deserialiseValueN: UTxOBlob"

src/Database/LSMTree/Internal/Serialise/Class.hs

@@ -8,7 +8,6 @@ module Database.LSMTree.Internal.Serialise.Class (
   , SerialiseValue (..)
   , serialiseValueIdentity
   , serialiseValueIdentityUpToSlicing
-  , serialiseValueConcatDistributes
   , RawBytes (..)
   , packSlice
     -- * Errors
@@ -21,7 +20,6 @@ import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Short.Internal as SBS
 import           Data.Monoid (Sum (..))
 import qualified Data.Primitive as P
-import           Data.Proxy (Proxy)
 import qualified Data.Vector.Primitive as VP
 import           Data.Void (Void, absurd)
 import           Data.Word
@@ -80,14 +78,9 @@ serialiseKeyMinimalSize x = RB.size (serialiseKey x) >= 8
 --
 -- [Identity] @'deserialiseValue' ('serialiseValue' x) == x@
 -- [Identity up to slicing] @'deserialiseValue' ('packSlice' prefix ('serialiseValue' x) suffix) == x@
--- [Concat distributes] @'deserialiseValueN' xs == 'deserialiseValue' ('mconcat' xs)@
 class SerialiseValue v where
   serialiseValue :: v -> RawBytes
   deserialiseValue :: RawBytes -> v
-  -- | Deserialisation when bytes are split into multiple chunks.
-  --
-  -- TODO: Unused so far, we might not need it.
-  deserialiseValueN :: [RawBytes] -> v
 
 
 -- | An instance for 'Sum' which is transparent to the serialisation of @a@.
@@ -99,8 +92,6 @@ instance SerialiseValue a => SerialiseValue (Sum a) where
 
   deserialiseValue = Sum . deserialiseValue
 
-  deserialiseValueN = Sum . deserialiseValueN
-
 -- | Test the __Identity__ law for the 'SerialiseValue' class
 serialiseValueIdentity :: (Eq v, SerialiseValue v) => v -> Bool
 serialiseValueIdentity x = deserialiseValue (serialiseValue x) == x
@@ -112,10 +103,6 @@ serialiseValueIdentityUpToSlicing ::
 serialiseValueIdentityUpToSlicing prefix x suffix =
     deserialiseValue (packSlice prefix (serialiseValue x) suffix) == x
 
--- | Test the __Concat distributes__ law for the 'SerialiseValue' class
-serialiseValueConcatDistributes :: forall v. (Eq v, SerialiseValue v) => Proxy v -> [RawBytes] -> Bool
-serialiseValueConcatDistributes _ xs = deserialiseValueN @v xs == deserialiseValue (mconcat xs)
-
 {-------------------------------------------------------------------------------
   RawBytes
 -------------------------------------------------------------------------------}
@@ -159,7 +146,6 @@ instance SerialiseValue Word64 where
 
   deserialiseValue (RawBytes (VP.Vector off len ba)) =
     requireBytesExactly "Word64" 8 len $ indexWord8ArrayAsWord64 ba off
-  deserialiseValueN = deserialiseValue . mconcat
 
 {-------------------------------------------------------------------------------
   ByteString
@@ -178,14 +164,12 @@ instance SerialiseKey BS.ByteString where
 -- | Placeholder instance, not optimised
 instance SerialiseValue LBS.ByteString where
   serialiseValue = serialiseValue . LBS.toStrict
-  deserialiseValue = deserialiseValueN . pure
-  deserialiseValueN = B.toLazyByteString . foldMap RB.builder
+  deserialiseValue = B.toLazyByteString . RB.builder
 
 -- | Placeholder instance, not optimised
 instance SerialiseValue BS.ByteString where
   serialiseValue = RB.fromShortByteString . SBS.toShort
-  deserialiseValue = deserialiseValueN . pure
-  deserialiseValueN = LBS.toStrict . deserialiseValueN
+  deserialiseValue = LBS.toStrict . deserialiseValue
 
 {-------------------------------------------------------------------------------
  ShortByteString
@@ -198,7 +182,6 @@ instance SerialiseKey SBS.ShortByteString where
 instance SerialiseValue SBS.ShortByteString where
   serialiseValue = RB.fromShortByteString
   deserialiseValue = byteArrayToSBS . RB.force
-  deserialiseValueN = byteArrayToSBS . foldMap RB.force
 
 {-------------------------------------------------------------------------------
  ByteArray
@@ -210,7 +193,6 @@ instance SerialiseValue SBS.ShortByteString where
 instance SerialiseValue P.ByteArray where
   serialiseValue ba = RB.fromByteArray 0 (P.sizeofByteArray ba) ba
   deserialiseValue = RB.force
-  deserialiseValueN = foldMap RB.force
 
 {-------------------------------------------------------------------------------
 Void
@@ -222,4 +204,3 @@ Void
 instance SerialiseValue Void where
   serialiseValue = absurd
   deserialiseValue = error "panic"
-  deserialiseValueN = error "panic"

test/Test/Database/LSMTree/Internal/Serialise/Class.hs

@@ -8,12 +8,10 @@ import           Data.ByteString (ByteString)
 import           Data.ByteString.Lazy (LazyByteString)
 import           Data.ByteString.Short (ShortByteString)
 import           Data.Primitive (ByteArray)
-import           Data.Proxy (Proxy (Proxy))
 import           Data.WideWord (Word128, Word256)
 import           Data.Word
 import           Database.LSMTree.Extras.Generators ()
 import           Database.LSMTree.Extras.UTxO (UTxOKey, UTxOValue)
-import qualified Database.LSMTree.Internal.RawBytes as RB
 import           Database.LSMTree.Internal.Serialise.Class
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
@@ -51,8 +49,6 @@ valueProperties =
         prop_roundtripSerialiseValue @a
     , testProperty "prop_roundtripSerialiseValueUpToSlicing" $
         prop_roundtripSerialiseValueUpToSlicing @a
-    , testProperty "prop_concatDistributesSerialiseValue" $
-        prop_concatDistributesSerialiseValue @a
     ]
 
 prop_roundtripSerialiseKey :: forall k. (Eq k, Show k, SerialiseKey k) => k -> Property
@@ -99,27 +95,3 @@ prop_roundtripSerialiseValueUpToSlicing prefix x suffix =
     v = serialiseValue x
     v' = packSlice prefix v suffix
     x' = deserialiseValue v'
-
-prop_concatDistributesSerialiseValue :: forall v. (Ord v, Show v, SerialiseValue v) => v -> Property
-prop_concatDistributesSerialiseValue v =
-    forAllShrink (genChunks bytes) shrinkChunks $ (. map (RB.pack)) $ \chs ->
-      counterexample ("from chunks: " <> show (deserialiseValueN @v chs)) $
-      counterexample ("from whole: " <> show (deserialiseValue @v (mconcat chs))) $
-        serialiseValueConcatDistributes (Proxy @v) chs
-  where
-    bytes = RB.unpack (serialiseValue v)
-
--- | Randomly splits the input list into non-empty chunks.
-genChunks :: [a] -> Gen [[a]]
-genChunks [] = pure []
-genChunks xs = do
-    n <- chooseInt (1, length xs)
-    let (pre, post) = splitAt n xs
-    (pre :) <$> genChunks post
-
--- | Shrinks by appending chunks where possible
-shrinkChunks :: [[a]] -> [[[a]]]
-shrinkChunks (x : y : ys) =
-      ((x <> y) : ys)
-    : map (x :) (shrinkChunks (y : ys))
-shrinkChunks _ = []