diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/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][]. diff --git a/src/Data/Store/Internal.hs b/src/Data/Store/Internal.hs --- a/src/Data/Store/Internal.hs +++ b/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.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 @@ 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) + @@ -776,6 +791,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 diff --git a/src/Data/Store/TH/Internal.hs b/src/Data/Store/TH/Internal.hs --- a/src/Data/Store/TH/Internal.hs +++ b/src/Data/Store/TH/Internal.hs @@ -363,8 +363,12 @@ 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" @@ -403,6 +407,10 @@ -- See issue #174 skippedUnboxConstructors :: [String] skippedUnboxConstructors = ["MV_UnboxAs", "V_UnboxAs", "MV_UnboxViaPrim", "V_UnboxViaPrim"] + +-- See issue #179 +doNotUnboxConstructors :: [String] +doNotUnboxConstructors = ["DoNotUnboxLazy","DoNotUnboxStrict","DoNotUnboxNormalForm"] ------------------------------------------------------------------------ -- Utilities diff --git a/store.cabal b/store.cabal --- a/store.cabal +++ b/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 diff --git a/test/Allocations.hs b/test/Allocations.hs --- a/test/Allocations.hs +++ b/test/Allocations.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} @@ -14,6 +15,9 @@ 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 = 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) diff --git a/test/Data/StoreSpec.hs b/test/Data/StoreSpec.hs --- a/test/Data/StoreSpec.hs +++ b/test/Data/StoreSpec.hs @@ -53,6 +53,9 @@ 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 @@ 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) => 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 @@ $(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 @@ , [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 @@ 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