store 0.7.9 → 0.7.10

raw patch · 9 files changed

+129/−137 lines, 9 filesdep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• bench/Bench.hs +0/−5
• src/Data/Store/Impl.hs +0/−5
• src/Data/Store/Internal.hs +60/−74
• src/Data/Store/TH/Internal.hs +0/−12
• src/Data/Store/TypeHash/Internal.hs +0/−1
• src/Data/Store/Version.hs +0/−1
• store.cabal +5/−5
• test/Data/StoreSpec.hs +51/−34

@@ -1,5 +1,18 @@ # ChangeLog +## 0.7.10++* Adds `Store` instances for all serializable datatypes exported by+  the `time` library. See [#158].++[#158]: https://github.com/mgsloan/store/issues/158++## 0.7.9++* Attempts to fix build on ghc-7.8.4. See [#157].++[#157]: https://github.com/mgsloan/store/issues/157+ ## 0.7.8  * Adds a `Store` instance for `Natural`. See [#154][].

@@ -24,7 +24,6 @@ import           Data.Word import           GHC.Generics --- TODO: add packer #if COMPARISON_BENCH import qualified Data.Binary as Binary import qualified Data.Serialize as Cereal@@ -160,8 +159,6 @@ benchDecode :: Ctx a => a -> Benchmark benchDecode = benchDecode' "" --- TODO: comparison bench for decode- benchDecode' :: forall a. Ctx a => String -> a -> Benchmark #if COMPARISON_BENCH benchDecode' prefix x0 =@@ -234,8 +231,6 @@     poke (SSM2 x) = poke (1 :: Word8) >> poke x     poke (SSM3 x) = poke (2 :: Word8) >> poke x     poke (SSM4 x) = poke (3 :: Word8) >> poke x---- TODO: add TH generation of the above, and add LargeSum / LargeProduct cases  #if COMPARISON_BENCH instance Binary.Binary SmallProduct

@@ -39,8 +39,6 @@ ------------------------------------------------------------------------ -- Store class --- TODO: write down more elaborate laws- -- | The 'Store' typeclass provides efficient serialization and -- deserialization to raw pointer addresses. --@@ -261,9 +259,6 @@     {-# INLINE gpeek #-}  -- The machinery for sum types is why UndecidableInstances is necessary.---- FIXME: check that this type level stuff dosen't get turned into--- costly runtime computation  instance (FitsInByte (SumArity (a :+: b)), GStoreSizeSum 0 (a :+: b))          => GStoreSize (a :+: b) where

@@ -109,6 +109,7 @@ import qualified Data.Text.Foreign as T import qualified Data.Text.Internal as T import qualified Data.Time as Time+import qualified Data.Time.Clock.TAI as Time import           Data.Typeable (Typeable) import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV@@ -120,13 +121,6 @@ import           Foreign.Ptr (plusPtr, minusPtr) import           Foreign.Storable (Storable, sizeOf) import           GHC.Generics (Generic)-#ifdef INTEGER_GMP-import qualified GHC.Integer.GMP.Internals as I-import           GHC.Types (Int (I#))-#else-import           GHC.Types (Word (W#))-import qualified GHC.Integer.Simple.Internals as I-#endif import           GHC.Real (Ratio(..)) import           GHC.TypeLits import           Instances.TH.Lift ()@@ -139,6 +133,24 @@ import           Prelude import           TH.Derive +#if MIN_VERSION_time(1,8,0)+import qualified Data.Time.Clock.System as Time+#endif+#if MIN_VERSION_time(1,9,0)+import qualified Data.Time.Format.ISO8601 as Time+#endif+#if MIN_VERSION_time(1,11,0)+import qualified Data.Time.Calendar.Quarter as Time+#endif++#ifdef INTEGER_GMP+import qualified GHC.Integer.GMP.Internals as I+import           GHC.Types (Int (I#))+#else+import           GHC.Types (Word (W#))+import qualified GHC.Integer.Simple.Internals as I+#endif+ -- Conditional import to avoid warning #ifdef INTEGER_GMP #if MIN_VERSION_integer_gmp(1,0,0)@@ -301,26 +313,7 @@     f <$> peek {-# INLINE peekOrdMapWith #-} -{- --------------------------------------------------------------------------- Utilities for defining list-like 'Store' instances in terms of Foldable---- | Implement 'size' for a 'Foldable' of 'Store' instances. Note that--- this assumes the extra 'Foldable' structure is discardable - this--- only serializes the elements.-sizeListLikeFoldable :: forall t a. (Foldable t, Store a) => Size (t a)-sizeListLikeFoldable = VarSize $ \t ->-    case size :: Size e of-        ConstSize n ->  n * length x + sizeOf (undefined :: Int)-        VarSize f -> foldl' (\acc x -> acc + f x) (sizeOf (undefined :: Int))-{-# INLINE sizeSequence #-}--pokeListLikeFoldable :: forall t a. Foldable t => t a -> Poke ()-pokeListLikeFoldable x = do-    poke (length x)--}-------------------------------------------------------------------------- -- Utilities for implementing 'Store' instances for list-like mutable things  -- | Implementation of peek for mutable sequences. The user provides a@@ -430,14 +423,10 @@         return (SBS.SBS array)  instance Store LBS.ByteString where-    -- FIXME: faster conversion? Is this ever going to be a problem?-    ---    -- I think on 64 bit systems, Int will have 64 bits. On 32 bit-    -- systems, we'll never exceed the range of Int by this conversion.     size = VarSize $ \x ->          sizeOf (undefined :: Int)  +          fromIntegral (LBS.length x)-    -- FIXME: more efficient implementation that avoids the double copy+    -- TODO: more efficient implementation that avoids the double copy     poke = poke . LBS.toStrict     peek = fmap LBS.fromStrict peek @@ -457,9 +446,6 @@ ------------------------------------------------------------------------ -- Known size instances --- TODO: this doesn't scale nicely to 'Text'. Force it to be byte size?--- 'StaticByteSize'?- newtype StaticSize (n :: Nat) a = StaticSize { unStaticSize :: a }     deriving (Eq, Show, Ord, Data, Typeable, Generic) @@ -482,7 +468,6 @@ instance KnownNat n => Store (StaticSize n BS.ByteString) where     size = ConstSize (fromInteger (natVal (Proxy :: Proxy n)))     poke (StaticSize x) = do-        -- TODO: worth it to put an assert here?         let (sourceFp, sourceOffset, sourceLength) = BS.toForeignPtr x         pokeFromForeignPtr sourceFp sourceOffset sourceLength     peek = do@@ -564,13 +549,11 @@     peek = peekSet  instance (A.Ix i, Store i, Store e) => Store (A.Array i e) where-    -- TODO: Speed up poke and peek     size = sizeArray     poke = pokeArray     peek = peekArray  instance (A.Ix i, A.IArray A.UArray e, Store i, Store e) => Store (A.UArray i e) where-    -- TODO: Speed up poke and peek     size = sizeArray     poke = pokeArray     peek = peekArray@@ -724,15 +707,6 @@           then peekException "Encountered negative integer when expecting a Natural"           else return $ fromIntegral x --- instance Store GHC.Fingerprint.Types.Fingerprint where--instance Store (Fixed a) where-    size = contramap (\(MkFixed x) -> x) (size :: Size Integer)-    poke (MkFixed x) = poke x-    peek = MkFixed <$> peek---- instance Store a => Store (Tree a) where- ------------------------------------------------------------------------ -- Other instances @@ -752,30 +726,15 @@ -- Similarly, manual implementation due to no Generic instance for -- Complex and Identity in GHC-7.10 and earlier. -instance Store a => Store (Complex a) where-    size = combineSize (\(x :+ _) -> x) (\(_ :+ y) -> y)-    poke (x :+ y) = poke (x, y)-    peek = uncurry (:+) <$> peek--instance Store a => Store (Identity a) where-    size = contramap (\(Identity x) -> x) size-    poke (Identity x) = poke x-    peek = Identity <$> peek--instance Store Time.Day where-    size = contramap Time.toModifiedJulianDay (size :: Size Integer)-    poke = poke . Time.toModifiedJulianDay-    peek = Time.ModifiedJulianDay <$> peek- instance Store Time.DiffTime where-    size = contramap (realToFrac :: Time.DiffTime -> Pico) (size :: Size Pico)-    poke = (poke :: Pico -> Poke ()) . realToFrac-    peek = Time.picosecondsToDiffTime <$> peek+    size = contramap (realToFrac :: Time.DiffTime -> Pico) size+    poke = poke . (realToFrac :: Time.DiffTime -> Pico)+    peek = (realToFrac :: Pico -> Time.DiffTime) <$> peek -instance Store Time.UTCTime where-    size = combineSize Time.utctDay Time.utctDayTime-    poke (Time.UTCTime day time) = poke (day, time)-    peek = uncurry Time.UTCTime <$> peek+instance Store Time.NominalDiffTime where+    size = contramap (realToFrac :: Time.NominalDiffTime -> Pico) size+    poke = poke . (realToFrac :: Time.NominalDiffTime -> Pico)+    peek = (realToFrac :: Pico -> Time.NominalDiffTime) <$> peek  instance Store () instance Store a => Store (Dual a)@@ -786,19 +745,48 @@ instance Store a => Store (Maybe a) instance Store a => Store (Const a b) --- FIXME: have TH deriving handle unboxed fields?- ------------------------------------------------------------------------ -- Instances generated by TH  $($(derive [d|-    -- TODO-    -- instance Deriving (Store ())+    instance Store a => Deriving (Store (Complex a))+    instance Store a => Deriving (Store (Identity a))+     instance Deriving (Store All)     instance Deriving (Store Any)     instance Deriving (Store Void)     instance Deriving (Store Bool)     instance (Store a, Store b) => Deriving (Store (Either a b))++    instance Deriving (Store (Fixed a))++    instance Deriving (Store Time.AbsoluteTime)+    instance Deriving (Store Time.Day)+    instance Deriving (Store Time.LocalTime)+    instance Deriving (Store Time.TimeOfDay)+    instance Deriving (Store Time.TimeZone)+    instance Deriving (Store Time.UTCTime)+    instance Deriving (Store Time.UniversalTime)+    instance Deriving (Store Time.ZonedTime)+    instance Deriving (Store Time.TimeLocale)++#if MIN_VERSION_time(1,8,0)+    instance Deriving (Store Time.SystemTime)+#endif++#if MIN_VERSION_time(1,9,0)+    instance Deriving (Store Time.CalendarDiffDays)+    instance Deriving (Store Time.CalendarDiffTime)+    instance Deriving (Store Time.FormatExtension)+#endif++#if MIN_VERSION_time(1,11,0)+    instance Deriving (Store Time.DayOfWeek)+    instance Deriving (Store Time.FirstWeekType)+    instance Deriving (Store Time.Quarter)+    instance Deriving (Store Time.QuarterOfYear)+#endif+     |]))  -- TODO: higher arities?  Limited now by Generics instances for tuples@@ -832,7 +820,6 @@ $(deriveManyStorePrimVector)  $(reifyManyWithoutInstances ''Store [''ModName, ''NameSpace, ''PkgName] (const True) >>=---   mapM (\name -> deriveStore [] (ConT name) .dtCons =<< reifyDataType name))    mapM (\name -> return (deriveGenericInstance [] (ConT name))))  -- Explicit definition needed because in template-haskell <= 2.9 (GHC@@ -877,5 +864,4 @@ #endif  $(reifyManyWithoutInstances ''Store [''Info] (const True) >>=---   mapM (\name -> deriveStore [] (ConT name) .dtCons =<< reifyDataType name))    mapM (\name -> return (deriveGenericInstance [] (ConT name))))

@@ -195,18 +195,6 @@     pokeTag ix = noBindS [| poke (ix :: $(conT tagType)) |]     pokeField (fn, _) = noBindS [| poke $(varE fn) |] --- FIXME: make this work even when there are too many fields---- FIXME: make the ConstSize stuff explicit in the API. Have an option--- that always errors at runtime if it isn't ConstSize?---- TODO: It would be really awesome, though a bit tricky, to know at--- compile time if we have a static size.---- TODO: make sure that this tends to optimize even with tons of fields.--- It should also optimize when some fields are known to be , but others--- are unknown (determined by polymorphic var)- {- What the generated code looks like  data Foo = Foo Int Double Float

@@ -64,7 +64,6 @@ instance Lift TypeHash where     lift = staticByteStringExp . unStaticSize . unTypeHash --- TODO: move into th-reify-many reifyManyTyDecls :: ((Name, Info) -> Q (Bool, [Name]))                  -> [Name]                  -> Q [(Name, Info)]

@@ -105,7 +105,6 @@         Nothing -> return ()         Just expectedHash -> do             let shownType = showsQualTypeRep (vcRenames vc) 0 (typeRep proxy) ""-            -- FIXME: sanitize expected and handle null             path <- storeVersionedPath expectedHash             if hashb64 == expectedHash                 then writeVersionInfo path shownType info

@@ -4,14 +4,14 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2b5f970ccccd93023ea3a855fe64f3795f9150e050cc73dd8abadc088320a0a4+-- hash: 49d04753317b8547f1c577aa466486464ac89127477c99f27fa87ff973f90176  name:           store-version:        0.7.9+version:        0.7.10 synopsis:       Fast binary serialization category:       Serialization, Data-homepage:       https://github.com/fpco/store#readme-bug-reports:    https://github.com/fpco/store/issues+homepage:       https://github.com/mgsloan/store#readme+bug-reports:    https://github.com/mgsloan/store/issues maintainer:     Michael Sloan <mgsloan@gmail.com> copyright:      2016 FP Complete license:        MIT@@ -23,7 +23,7 @@  source-repository head   type: git-  location: https://github.com/fpco/store+  location: https://github.com/mgsloan/store  flag comparison-bench   manual: True

@@ -23,6 +23,7 @@ import qualified Data.ByteString.Short as SBS import           Data.Complex (Complex(..)) import           Data.Containers (mapFromList, setFromList)+import           Data.Fixed (Pico) import           Data.Generics (listify) import           Data.HashMap.Strict (HashMap) import           Data.HashSet (HashSet)@@ -33,9 +34,6 @@ import qualified Data.List.NonEmpty as NE import           Data.Map (Map) import           Data.Monoid-#if !MIN_VERSION_primitive(0,7,0)-import           Data.Primitive.Types (Addr)-#endif import           Data.Proxy (Proxy(..)) import           Data.Sequence (Seq) import           Data.Sequences (fromList)@@ -49,6 +47,7 @@ import           Data.Text (Text) import qualified Data.Text as T import qualified Data.Time as Time+import qualified Data.Time.Clock.TAI as Time import           Data.Typeable (Typeable) import qualified Data.Vector as V import qualified Data.Vector.Primitive as PV@@ -66,12 +65,26 @@ import           Network.Socket import           Numeric.Natural (Natural) import           Prelude-import           System.Clock (TimeSpec)+import           System.Clock (TimeSpec(..)) import           System.Posix.Types import           Test.Hspec hiding (runIO) import           Test.SmallCheck.Series import           TH.Utilities (unAppsT) +#if !MIN_VERSION_primitive(0,7,0)+import           Data.Primitive.Types (Addr)+#endif++#if MIN_VERSION_time(1,8,0)+import qualified Data.Time.Clock.System as Time+#endif+#if MIN_VERSION_time(1,9,0)+import qualified Data.Time.Format.ISO8601 as Time+#endif+#if MIN_VERSION_time(1,11,0)+import qualified Data.Time.Calendar.Quarter as Time+#endif+ #if !MIN_VERSION_smallcheck(1,2,0) import           Data.Void (Void) #endif@@ -79,9 +92,6 @@ ------------------------------------------------------------------------ -- Instances for base types --- TODO: should be possible to do something clever where it only defines--- instances that don't already exist.  For now, just doing it manually.- addMinAndMaxBounds :: forall a. (Bounded a, Eq a) => [a] -> [a] addMinAndMaxBounds xs =     (if (minBound :: a) `notElem` xs then [minBound] else []) ++@@ -158,32 +168,6 @@                       series = fmap PV.fromList series |]      concat <$> mapM f (filter (\ty -> length (unAppsT ty) == 1) tys)) -{---- Instances for TH are not currently needed, because the tests for--- serialization roundtripping are disabled due to Bytes' Eq instance,--- see issue #150.---- Needs to be done manually because in GHC 7.8's TH, NameFlavour uses--- unboxed values and cannot use generic deriving. So we skip having an--- instance for it.-instance Monad m => Serial m Name where series = fmap mkName series--instance Monad m => Serial m Bytes where-  series = fmap ((\(BS.PS p o l) -> Bytes p (fromIntegral o) (fromIntegral l)) . BS.pack) series---- Serial instances for (Generic a) types.---- FIXME: generating for TH instances is probably just adding--- unnecessary compiletime + runtime overhead.-$(do thNames <- reifyManyWithoutInstances-         ''Serial-         [''Info, ''Loc, ''ModName, ''PkgName, ''NameSpace, ''OccName]-         (`notElem` [''NameFlavour])-     let ns = [ ''Any, ''All ] ++ thNames-         f n = [d| instance Monad m => Serial m $(conT n) |]-     concat <$> mapM f ns)--}- $(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)@@ -256,6 +240,9 @@ instance Monad m => Serial m Time.DiffTime where     series = Time.picosecondsToDiffTime <$> series +instance Monad m => Serial m Time.NominalDiffTime where+    series = (realToFrac :: Integer -> Time.NominalDiffTime) <$> series+ instance Monad m => Serial m Time.UTCTime where     series = uncurry Time.UTCTime <$> (series >< series) @@ -271,6 +258,9 @@     series = generate (\_ -> []) #endif +instance Monad m => Serial m TimeSpec where+    series = uncurry TimeSpec <$> (series >< series)+ -- We define our own Serial instance for 'Ratio' because of <https://github.com/feuerbach/smallcheck/pull/34>  newtype SerialRatio a = SerialRatio (Ratio a)@@ -331,7 +321,34 @@ #if MIN_VERSION_base(4,10,0)                  , [t| CTimer |] #endif-                 , [t| TimeSpec |]++-- Assume the TH generated instances for Time work, to avoid defining+-- Serial instances. Also some lack Show / Eq.++                 , [t| Time.AbsoluteTime |]+                 , [t| Time.Day |]+                 , [t| Time.LocalTime |]+                 , [t| Time.TimeOfDay |]+                 , [t| Time.TimeZone |]+                 , [t| Time.UTCTime |]+                 , [t| Time.UniversalTime |]+                 , [t| Time.ZonedTime |]+                 , [t| Time.TimeLocale |]+#if MIN_VERSION_time(1,8,0)+                 , [t| Time.SystemTime |]+#endif+#if MIN_VERSION_time(1,9,0)+                 , [t| Time.FormatExtension |]+                 , [t| Time.CalendarDiffDays |]+                 , [t| Time.CalendarDiffTime |]+#endif+#if MIN_VERSION_time(1,11,0)+                 , [t| Time.DayOfWeek |]+                 , [t| Time.FirstWeekType |]+                 , [t| Time.Quarter |]+                 , [t| Time.QuarterOfYear |]+#endif+                  ]              omitTys <- (omitTys0 ++) <$> mapM (\ty -> [t| PV.Vector $(pure ty) |]) omitTys0              let f ty = isMonoType ty && ty `notElem` omitTys && null (listify isThName ty)