Fix #179. Support for vector-0.13.2.0

ChangeLog.md

@@ -1,5 +1,11 @@
 # ChangeLog
 
+## 0.7.19
+
+* Adds support for `vector-0.13.2.0`. See [#179][].
+
+[#174]: https://github.com/mgsloan/store/issues/179
+
 ## 0.7.16
 
 * Adds support for `vector-0.13.0.0`. See [#174][].

package.yaml

@@ -1,5 +1,5 @@
 name: store
-version: "0.7.18"
+version: "0.7.19"
 synopsis: Fast binary serialization
 maintainer: Michael Sloan <[email protected]>
 license: MIT

src/Data/Store/Internal.hs

@@ -4,13 +4,16 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes#-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -116,6 +119,11 @@ import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Storable as SV
 import qualified Data.Vector.Storable.Mutable as MSV
+import qualified Data.Vector.Unboxed as UV
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as SCV
+import qualified Data.Vector.Strict.Mutable as MSCV
+#endif
 import           Data.Void
 import           Data.Word
 import           Foreign.C.Types ()
@@ -379,6 +387,13 @@ instance Store a => Store (V.Vector a) where
     poke = pokeSequence
     peek = V.unsafeFreeze =<< peekMutableSequence MV.new MV.write
 
+#if MIN_VERSION_vector(0,13,2)
+instance Store a => Store (SCV.Vector a) where
+    size = sizeSequence
+    poke = pokeSequence
+    peek = SCV.unsafeFreeze =<< peekMutableSequence MSCV.new MSCV.write
+#endif
+
 instance Storable a => Store (SV.Vector a) where
     size = VarSize $ \x ->
         sizeOf (undefined :: Int) +
@@ -777,6 +792,12 @@ instance Store a => Store (Last a)
 instance Store a => Store (Maybe a)
 instance Store a => Store (Const a b)
 
+#if MIN_VERSION_vector(0,13,2)
+deriving newtype instance Store a => Store (UV.DoNotUnboxLazy a)
+deriving newtype instance Store a => Store (UV.DoNotUnboxStrict a)
+deriving newtype instance Store a => Store (UV.DoNotUnboxNormalForm a)
+#endif
+
 ------------------------------------------------------------------------
 -- Instances generated by TH
 

src/Data/Store/TH/Internal.hs

@@ -363,8 +363,12 @@ deriveManyStoreUnboxVector = do
               Nothing -> do
                 reportWarning $ "No Unbox instance found for " ++ pprint headTy
                 return ([], ty)
-              Just (TypeclassInstance cs (AppT _ ty') _) ->
-                return (map substituteConstraint cs, AppT (ConT ''UV.Vector) ty')
+              Just (TypeclassInstance cs (AppT _ ty') _) -> case ty' of
+                AppT (ConT conName) arg ->
+                  if nameBase conName `elem` doNotUnboxConstructors
+                    then return ([AppT (ConT ''Store) arg], AppT (ConT ''UV.Vector) ty')
+                    else return (map substituteConstraint cs, AppT (ConT ''UV.Vector) ty')
+                _ -> return (map substituteConstraint cs, AppT (ConT ''UV.Vector) ty')
               Just _ -> fail "Impossible case"
             deriveStore preds ty' cons
         _ -> fail "impossible case in deriveManyStoreUnboxVector"
@@ -404,6 +408,10 @@ getUnboxInfo = do
 skippedUnboxConstructors :: [String]
 skippedUnboxConstructors = ["MV_UnboxAs", "V_UnboxAs", "MV_UnboxViaPrim", "V_UnboxViaPrim"]
 
+-- See issue #179
+doNotUnboxConstructors :: [String]
+doNotUnboxConstructors = ["DoNotUnboxLazy","DoNotUnboxStrict","DoNotUnboxNormalForm"]
+
 ------------------------------------------------------------------------
 -- Utilities
 

store.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           store
-version:        0.7.18
+version:        0.7.19
 synopsis:       Fast binary serialization
 category:       Serialization, Data
 homepage:       https://github.com/mgsloan/store#readme

test/Allocations.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
 
@@ -14,6 +15,9 @@ 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
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector as BoxedStrict
+#endif
 import qualified Data.Vector.Serialize ()
 import qualified Data.Vector.Storable as Storable
 import           Text.Printf
@@ -29,6 +33,9 @@ weighing :: Weigh ()
 weighing =
   do fortype "[Int]" (\n -> replicate n 0 :: [Int])
      fortype "Boxed Vector Int" (\n -> Boxed.replicate n 0 :: Boxed.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+     fortype "Boxed Strict Vector Int" (\n -> BoxedStrict.replicate n 0 :: BoxedStrict.Vector Int)
+#endif
      fortype "Storable Vector Int"
              (\n -> Storable.replicate n 0 :: Storable.Vector Int)
      fortype "Set Int" (Set.fromDistinctAscList . ints)

test/Data/StoreSpec.hs

@@ -53,6 +53,9 @@ import qualified Data.Vector as V
 import qualified Data.Vector.Primitive as PV
 import qualified Data.Vector.Storable as SV
 import qualified Data.Vector.Unboxed as UV
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as SCV
+#endif
 import           Data.Word
 import           Foreign.C.Types
 import           Foreign.Ptr
@@ -178,6 +181,21 @@ $(do let ns = [ ''Dual, ''Sum, ''Product, ''First, ''Last ]
          f n = [d| instance (Monad m, Serial m a) => Serial m ($(conT n) a) |]
      concat <$> mapM f ns)
 
+-- Instances for DoNotUnbox types introduced in vector-0.13.2.0
+#if MIN_VERSION_vector(0,13,2)
+$(do let ns = [ ''UV.DoNotUnboxLazy, ''UV.DoNotUnboxStrict, ''UV.DoNotUnboxNormalForm ]
+         f n = [d| instance (Monad m, Serial m a) => Serial m ($(conT n) a) |]
+     concat <$> mapM f ns)
+
+deriving instance Eq a => Eq (UV.DoNotUnboxLazy a)
+deriving instance Eq a => Eq (UV.DoNotUnboxNormalForm a)
+deriving instance Eq a => Eq (UV.DoNotUnboxStrict a)
+
+deriving instance Show a => Show (UV.DoNotUnboxLazy a)
+deriving instance Show a => Show (UV.DoNotUnboxNormalForm a)
+deriving instance Show a => Show (UV.DoNotUnboxStrict a)
+#endif
+
 instance Monad m => Serial m Any where
     series = fmap Any series
 
@@ -202,6 +220,11 @@ instance (Monad m, Serial m a, Storable a) => Serial m (SV.Vector a) where
 instance (Monad m, Serial m a) => Serial m (V.Vector a) where
     series = fmap V.fromList series
 
+#if MIN_VERSION_vector(0,13,2)
+instance (Monad m, Serial m a) => Serial m (SCV.Vector a) where
+    series = fmap SCV.fromList series
+#endif
+
 instance (Monad m, Serial m k, Serial m a, Ord k) => Serial m (Map k a) where
     series = fmap mapFromList series
 
@@ -395,6 +418,12 @@ spec = do
         $(smallcheckManyStore verbose 4
             [ [t| SV.Vector Int8 |]
             , [t| V.Vector  Int8 |]
+#if MIN_VERSION_vector(0,13,2)
+            , [t| SCV.Vector Int8 |]
+            , [t| UV.DoNotUnboxLazy Int8 |]
+            , [t| UV.DoNotUnboxStrict Int8 |]
+            , [t| UV.DoNotUnboxNormalForm Int8 |]
+#endif
             , [t| SerialRatio     Int8 |]
             , [t| Complex   Int8 |]
             , [t| Dual      Int8 |]
@@ -406,6 +435,12 @@ spec = do
             , [t| Either    Int8 Int8 |]
             , [t| SV.Vector Int64 |]
             , [t| V.Vector  Int64 |]
+#if MIN_VERSION_vector(0,13,2)
+            , [t| SCV.Vector Int64 |]
+            , [t| UV.DoNotUnboxLazy Int64 |]
+            , [t| UV.DoNotUnboxStrict Int64 |]
+            , [t| UV.DoNotUnboxNormalForm Int64 |]
+#endif
             , [t| SerialRatio     Int64 |]
             , [t| Complex   Int64 |]
             , [t| Dual      Int64 |]
@@ -445,6 +480,9 @@ spec = do
         assertRoundtrip False $ BS.drop 3 $ BS.take 3 "Hello world!"
         assertRoundtrip False $ SV.drop 3 $ SV.take 3 (SV.fromList [1..10] :: SV.Vector Int32)
         assertRoundtrip False $ UV.drop 3 $ UV.take 3 (UV.fromList [1..10] :: UV.Vector Word8)
+#if MIN_VERSION_vector(0,13,2)
+        assertRoundtrip False $ SCV.drop 3 $ SCV.take 3 (SCV.fromList [1..10] :: SCV.Vector Word8)
+#endif
         (return () :: IO ())
     it "StaticSize roundtrips" $ do
         let x :: StaticSize 17 BS.ByteString