store 0.3.1 → 0.4.0

raw patch · 6 files changed

+171/−31 lines, 6 filesdep ~store-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: store-core

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• bench/Bench.hs +26/−0
• src/Data/Store/Internal.hs +89/−17
• store.cabal +5/−5
• test/Allocations.hs +24/−8
• test/Data/StoreSpec.hs +11/−1

@@ -1,5 +1,21 @@ # ChangeLog +## 0.4.0++* Breaking change in the encoding of Map / Set / IntMap / IntSet,+  to use ascending key order. Attempting to decode data written by+  prior versions of store (and vice versa) will almost always fail+  with a decent error message. If you're unlucky enough to have a+  collision in the data with a random Word32 magic number, then the+  error may not be so clear, or in extremely rare cases,+  successfully decode, yielding incorrect results. See+  [#97](https://github.com/fpco/store/issues/97) and+  [#101](https://github.com/fpco/store/pull/101).+++* Performance improvement of the 'Peek' monad, by introducing more+  strictness.  This required a change to the internal API.+ ## 0.3.1  * Fix to derivation of primitive vectors, only relevant when built with

@@ -13,6 +13,10 @@ import           Criterion.Main import qualified Data.ByteString as BS import           Data.Int+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set import           Data.Store import           Data.Typeable import qualified Data.Vector as V@@ -71,6 +75,16 @@                        _ -> error "This does not compute."                ) <$> V.enumFromTo 1 (100 :: Int)         nestedTuples = (\i -> ((i,i+1),(i+2,i+3))) <$> V.enumFromTo (1::Int) 100++        ints = [1..100] :: [Int]+        pairs = map (\x -> (x, x)) ints+        strings = show <$> ints+        intsSet = Set.fromDistinctAscList ints+        intSet = IntSet.fromDistinctAscList ints+        intsMap = Map.fromDistinctAscList pairs+        intMap = IntMap.fromDistinctAscList pairs+        stringsSet = Set.fromList strings+        stringsMap = Map.fromList (zip strings ints) #endif     defaultMain         [ bgroup "encode"@@ -80,6 +94,12 @@             , benchEncode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))             , benchEncode' "1kb normal" (V.fromList ([1..256] :: [Int32]))             , benchEncode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))+            , benchEncode intsSet+            , benchEncode intSet+            , benchEncode intsMap+            , benchEncode intMap+            , benchEncode stringsSet+            , benchEncode stringsMap #endif             , benchEncode smallprods             , benchEncode smallmanualprods@@ -95,6 +115,12 @@             , benchDecode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))             , benchDecode' "1kb normal" (V.fromList ([1..256] :: [Int32]))             , benchDecode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))+            , benchDecode intsSet+            , benchDecode intSet+            , benchDecode intsMap+            , benchDecode intMap+            , benchDecode stringsSet+            , benchDecode stringsMap #endif             , benchDecode smallprods             , benchDecode smallmanualprods

@@ -46,6 +46,8 @@     , sizeSet, pokeSet, peekSet     -- ** Store instances in terms of IsMap     , sizeMap, pokeMap, peekMap+    -- *** Utilities for ordered maps+    , sizeOrdMap, pokeOrdMap, peekOrdMapWith     -- ** Store instances in terms of IArray     , sizeArray, pokeArray, peekArray     -- ** Store instances in terms of Generic@@ -81,9 +83,12 @@ import           Data.HashSet (HashSet) import           Data.Hashable (Hashable) import           Data.IntMap (IntMap)+import qualified Data.IntMap.Strict as IntMap import           Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet import qualified Data.List.NonEmpty as NE import           Data.Map (Map)+import qualified Data.Map.Strict as Map import           Data.MonoTraversable import           Data.Monoid import           Data.Orphans ()@@ -92,6 +97,7 @@ import           Data.Sequence (Seq) import           Data.Sequences (IsSequence, Index, replicateM) import           Data.Set (Set)+import qualified Data.Set as Set import           Data.Store.Impl import           Data.Store.Core import           Data.Store.TH.Internal@@ -216,11 +222,7 @@     :: (Store (ContainerKey t), Store (MapValue t), IsMap t)     => t     -> Poke ()-pokeMap t = do-    poke (olength t)-    ofoldl' (\acc (k, x) -> poke k >> poke x >> acc)-            (return ())-            (mapToList t)+pokeMap = pokeSequence . mapToList {-# INLINE pokeMap #-}  -- | Implement 'peek' for an 'IsMap' of where both 'ContainerKey' and@@ -231,6 +233,61 @@ peekMap = mapFromList <$> peek {-# INLINE peekMap #-} +------------------------------------------------------------------------+-- Utilities for defining 'Store' instances for ordered containers like+-- 'IntMap' and 'Map'++-- | Marker for maps that are encoded in ascending order instead of the+-- descending order mistakenly implemented in 'peekMap' in store versions+-- < 0.4.+--+-- See https://github.com/fpco/store/issues/97.+markMapPokedInAscendingOrder :: Word32+markMapPokedInAscendingOrder = 1217678090++-- | Ensure the presence of a given magic value.+--+-- Throws a 'PeekException' if the value isn't present.+peekMagic+    :: (Eq a, Show a, Store a)+    => a -> Peek ()+peekMagic x = do+    x' <- peek+    when (x' /= x) $+        fail ("Expected marker: " ++ show x ++ " but got: " ++ show x')+{-# INLINE peekMagic #-}++-- | Like 'sizeMap' but should only be used for ordered containers where+-- 'Data.Containers.mapToList' returns an ascending list.+sizeOrdMap+    :: forall t.+       (Store (ContainerKey t), Store (MapValue t), IsMap t)+    => Size t+sizeOrdMap =+    combineSizeWith (const markMapPokedInAscendingOrder) id size sizeMap+{-# INLINE sizeOrdMap #-}++-- | Like 'pokeMap' but should only be used for ordered containers where+-- 'Data.Containers.mapToList' returns an ascending list.+pokeOrdMap+    :: (Store (ContainerKey t), Store (MapValue t), IsMap t)+    => t -> Poke ()+pokeOrdMap x = poke markMapPokedInAscendingOrder >> pokeMap x+{-# INLINE pokeOrdMap #-}++-- | Decode the results of 'pokeOrdMap' using a given function to construct+-- the map.+peekOrdMapWith+    :: (Store (ContainerKey t), Store (MapValue t))+    => ([(ContainerKey t, MapValue t)] -> t)+       -- ^ A function to construct the map from an ascending list such as+       -- 'Map.fromDistinctAscList'.+    -> Peek t+peekOrdMapWith f = do+    peekMagic markMapPokedInAscendingOrder+    f <$> peek+{-# INLINE peekOrdMapWith #-}+ {- ------------------------------------------------------------------------ -- Utilities for defining list-like 'Store' instances in terms of Foldable@@ -279,7 +336,7 @@         remaining = peekStateEndPtr ps `minusPtr` ptr     when (len > remaining) $ -- Do not perform the check on the new pointer, since it could have overflowed         tooManyBytes len remaining "skip"-    return (ptr2, ())+    return $ PeekResult ptr2 ()  -- | Isolate the input to n bytes, skipping n bytes forward. Fails if @m@ -- advances the offset beyond the isolated region.@@ -291,10 +348,10 @@         remaining = end `minusPtr` ptr     when (len > remaining) $ -- Do not perform the check on the new pointer, since it could have overflowed         tooManyBytes len remaining "isolate"-    (ptr', x) <- runPeek m ps ptr+    PeekResult ptr' x <- runPeek m ps ptr     when (ptr' > end) $         throwIO $ PeekException (ptr' `minusPtr` end) "Overshot end of isolated bytes"-    return (ptr2, x)+    return $ PeekResult ptr2 x  ------------------------------------------------------------------------ -- Instances for types based on flat representations@@ -461,9 +518,14 @@     {-# INLINE poke #-}  instance (Store a, Ord a) => Store (Set a) where-    size = sizeSet+    size =+        VarSize $ \t ->+            sizeOf (undefined :: Int) ++            case size of+                ConstSize n -> n * Set.size t+                VarSize f -> Set.foldl' (\acc a -> acc + f a) 0 t     poke = pokeSet-    peek = peekSet+    peek = Set.fromDistinctAscList <$> peek     {-# INLINE size #-}     {-# INLINE peek #-}     {-# INLINE poke #-}@@ -471,23 +533,32 @@ instance Store IntSet where     size = sizeSet     poke = pokeSet-    peek = peekSet+    peek = IntSet.fromDistinctAscList <$> peek     {-# INLINE size #-}     {-# INLINE peek #-}     {-# INLINE poke #-}  instance Store a => Store (IntMap a) where-    size = sizeMap-    poke = pokeMap-    peek = peekMap+    size = sizeOrdMap+    poke = pokeOrdMap+    peek = peekOrdMapWith IntMap.fromDistinctAscList     {-# INLINE size #-}     {-# INLINE peek #-}     {-# INLINE poke #-}  instance (Ord k, Store k, Store a) => Store (Map k a) where-    size = sizeMap-    poke = pokeMap-    peek = peekMap+    size =+        VarSize $ \t ->+            sizeOf markMapPokedInAscendingOrder + sizeOf (undefined :: Int) ++            case (size, size) of+                (ConstSize nk, ConstSize na) -> (nk + na) * Map.size t+                (szk, sza) ->+                    Map.foldlWithKey'+                        (\acc k a -> acc + getSizeWith szk k + getSizeWith sza a)+                        0+                        t+    poke = pokeOrdMap+    peek = peekOrdMapWith Map.fromDistinctAscList     {-# INLINE size #-}     {-# INLINE peek #-}     {-# INLINE poke #-}@@ -753,3 +824,4 @@ $(reifyManyWithoutInstances ''Store [''Info] (const True) >>= --   mapM (\name -> deriveStore [] (ConT name) .dtCons =<< reifyDataType name))    mapM (\name -> return (deriveGenericInstance [] (ConT name))))+

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           store-version:        0.3.1+version:        0.4.0 synopsis:       Fast binary serialization category:       Serialization, Data homepage:       https://github.com/fpco/store#readme@@ -37,7 +37,7 @@   ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2   build-depends:       base >=4.7 && <5-    , store-core >=0.3 && <0.4+    , store-core >=0.4 && <0.5     , th-utilities >=0.2     , primitive >=0.6     , th-reify-many >=0.1.6@@ -102,7 +102,7 @@   ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , store-core >=0.3 && <0.4+    , store-core >=0.4 && <0.5     , th-utilities >=0.2     , primitive >=0.6     , th-reify-many >=0.1.6@@ -160,7 +160,7 @@   ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T -O2   build-depends:       base >=4.7 && <5-    , store-core >=0.3 && <0.4+    , store-core >=0.4 && <0.5     , th-utilities >=0.2     , primitive >=0.6     , th-reify-many >=0.1.6@@ -218,7 +218,7 @@   ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N1 -with-rtsopts=-s -with-rtsopts=-qg   build-depends:       base >=4.7 && <5-    , store-core >=0.3 && <0.4+    , store-core >=0.4 && <0.5     , th-utilities >=0.2     , primitive >=0.6     , th-reify-many >=0.1.6

@@ -7,8 +7,11 @@ module Main where  import           Control.DeepSeq-import           Data.List+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet as IntSet import qualified Data.Serialize as Cereal+import qualified Data.Set as Set+import qualified Data.Map.Strict as Map import qualified Data.Store as Store import qualified Data.Vector as Boxed import qualified Data.Vector.Serialize ()@@ -19,26 +22,39 @@ -- | Main entry point. main :: IO () main =-  mainWith encoding+  mainWith weighing --- | Weigh encoding with Store vs Cereal.-encoding :: Weigh ()-encoding =+-- | Weigh weighing with Store vs Cereal.+weighing :: Weigh ()+weighing =   do fortype "[Int]" (\n -> replicate n 0 :: [Int])      fortype "Boxed Vector Int" (\n -> Boxed.replicate n 0 :: Boxed.Vector Int)      fortype "Storable Vector Int"              (\n -> Storable.replicate n 0 :: Storable.Vector Int)+     fortype "Set Int" (Set.fromDistinctAscList . ints)+     fortype "IntSet" (IntSet.fromDistinctAscList . ints)+     fortype "Map Int Int" (Map.fromDistinctAscList . intpairs)+     fortype "IntMap Int" (IntMap.fromDistinctAscList . intpairs)   where fortype label make =           scale (\(n,nstr) ->                    do let title :: String -> String                           title for = printf "%12s %-20s %s" nstr (label :: String) for+                          encodeDecode en de =+                            (return . (`asTypeOf` make n) . de . force . en . make) n                       action (title "Allocate")                              (return (make n))                       action (title "Encode: Store")                              (return (Store.encode (force (make n))))                       action (title "Encode: Cereal")-                             (return (Cereal.encode (force (make n)))))-        scale func =-          mapM_ func+                             (return (Cereal.encode (force (make n))))+                      action (title "Encode/Decode: Store")+                             (encodeDecode Store.encode Store.decodeEx)+                      action (title "Encode/Decode: Cereal")+                             (encodeDecode Cereal.encode (fromRight . Cereal.decode)))+        scale f =+          mapM_ f                 (map (\x -> (x,commas x))                      [1000000,2000000,10000000])+        ints n = [1..n] :: [Int]+        intpairs = map (\x -> (x, x)) . ints+        fromRight = either (error "Left") id

@@ -307,7 +307,7 @@             , [t| X |]             ])     describe "Manually listed polymorphic store instances"-        $(smallcheckManyStore verbose 2+        $(smallcheckManyStore verbose 4             [ [t| SV.Vector Int8 |]             , [t| V.Vector  Int8 |]             , [t| SerialRatio     Int8 |]@@ -396,6 +396,12 @@         assertRoundtrip verbose (250 :: Word8, 40918 :: Word16, 120471416 :: Word32)         assertRoundtrip verbose (250 :: Word8, 10.1 :: Float, 8697.65 :: Double)         (return () :: IO ())+    it "Expects the right marker when deserializing ordered maps (#97)" $ do+        let m = mapFromList [(1, ()), (2, ()), (3, ())] :: HashMap Int ()+            bs = encode m+        (decodeEx bs :: HashMap Int ()) `shouldBe` m+        evaluate (decodeEx bs :: Map Int ()) `shouldThrow` isUnexpectedMarkerException+        evaluate (decodeEx bs :: IntMap ()) `shouldThrow` isUnexpectedMarkerException  isPokeException :: Test.Hspec.Selector PokeException isPokeException = const True@@ -405,3 +411,7 @@  isTooManyBytesException :: Test.Hspec.Selector PeekException isTooManyBytesException (PeekException _ t) = "Attempted to read too many bytes" `T.isPrefixOf` t++isUnexpectedMarkerException :: Test.Hspec.Selector PeekException+isUnexpectedMarkerException (PeekException _ t) =+    "Expected marker: " `T.isPrefixOf` t