store 0.1.0.0 → 0.1.0.1

raw patch · 3 files changed

+37/−45 lines, 3 filesdep ~basedep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• src/Data/Store/Internal.hs +1/−8
• src/Data/Store/TH/Internal.hs +32/−33
• store.cabal +4/−4

@@ -91,7 +91,7 @@ import qualified Data.Text.Foreign as T import qualified Data.Text.Internal as T import qualified Data.Time as Time-import           Data.Typeable.Internal (Typeable, Fingerprint)+import           Data.Typeable.Internal (Typeable) import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Storable as SV@@ -638,13 +638,6 @@ instance Store a => Store (Last a) instance Store a => Store (Maybe a) instance (Store a, Store b) => Store (Either a b)---- Explicit definition needed because in base <= 4.7 (GHC 7.8),--- Fingerprint is not Typeable.-instance Store Fingerprint where-    size = sizeStorableTy "GHC.Fingerprint.Type.Fingerprint"-    poke = pokeStorable-    peek = peekStorableTy "GHC.Fingerprint.Type.Fingerprint"  -- FIXME: have TH deriving handle unboxed fields? 

@@ -33,7 +33,6 @@ import           Data.Store.Impl import qualified Data.Text as T import           Data.Traversable (forM)-import           Data.Typeable (Typeable) import qualified Data.Vector.Primitive as PV import qualified Data.Vector.Unboxed as UV import           Data.Word@@ -46,7 +45,7 @@ import           Safe (headMay) import           TH.Derive (Deriver(..)) import           TH.ReifyDataType-import           TH.Utilities (freeVarsT, expectTyCon1, dequalify)+import           TH.Utilities (expectTyCon1, dequalify, plainInstanceD)  instance Deriver (Store a) where     runDeriver _ preds ty = do@@ -256,7 +255,7 @@ #endif  deriveGenericInstance :: Cxt -> Type -> Dec-deriveGenericInstance cs ty = InstanceD cs (AppT (ConT ''Store) ty) []+deriveGenericInstance cs ty = plainInstanceD cs (AppT (ConT ''Store) ty) []  ------------------------------------------------------------------------ -- Storable@@ -269,24 +268,15 @@     stores <- postprocess . instancesMap <$> getInstances ''Store     return $ M.elems $ flip M.mapMaybe (storables `M.difference` stores) $         \(TypeclassInstance cs ty _) ->-        let argTy = head (tail (unAppsT ty)) in+        let argTy = head (tail (unAppsT ty))+            tyNameLit = LitE (StringL (pprint ty)) in         if p argTy-            then Just $ makeStoreInstance (cs ++ everythingTypeable ty)-                                          argTy-                                          (VarE 'sizeStorable)-                                          (VarE 'peekStorable)-                                          (VarE 'pokeStorable)+            then Just $ makeStoreInstance cs argTy+                (AppE (VarE 'sizeStorableTy) tyNameLit)+                (AppE (VarE 'peekStorableTy) tyNameLit)+                (VarE 'pokeStorable)             else Nothing --- Necessitated by the Typeable constraint on peekStorable-everythingTypeable :: Type -> Cxt-everythingTypeable =-#if MIN_VERSION_template_haskell(2,10,0)-  map (AppT (ConT ''Typeable) . VarT) . freeVarsT-#else-  map (ClassP ''Typeable . (:[]) . VarT) . freeVarsT-#endif- ------------------------------------------------------------------------ -- Vector @@ -345,8 +335,13 @@                     filter (not . isMonoType) $                     concatMap (map snd . dcFields) cons             -}-            let extraPreds =-                    map (AppT (ConT ''Store) . AppT (ConT ''UV.Vector)) $ listify isVarT ty+            let extraPreds = map (storePred . AppT (ConT ''UV.Vector)) $ listify isVarT ty+                storePred =+#if MIN_VERSION_template_haskell(2,10,0)+                    AppT (ConT ''Store)+#else+                    ClassP ''Store . (:[])+#endif             deriveStore (nub (preds ++ extraPreds)) ty cons         _ -> fail "impossible case in deriveManyStoreUnboxVector" @@ -357,10 +352,13 @@     FamilyI _ insts <- reify ''UV.Vector     return (map (everywhere (id `extT` dequalVarT) . go) insts)   where-    go (NewtypeInstD preds _ [ty] con _) =-        (preds, ty, conToDataCons con)-    go (DataInstD preds _ [ty] cons _) =-        (preds, ty, concatMap conToDataCons cons)+#if MIN_VERSION_template_haskell(2,11,0)+    go (NewtypeInstD preds _ [ty] _ con _) = (preds, ty, conToDataCons con)+    go (DataInstD preds _ [ty] _ cons _) = (preds, ty, concatMap conToDataCons cons)+#else+    go (NewtypeInstD preds _ [ty] con _) = (preds, ty, conToDataCons con)+    go (DataInstD preds _ [ty] cons _) = (preds, ty, concatMap conToDataCons cons)+#endif     go x = error ("Unexpected result from reifying Unboxed Vector instances: " ++ pprint x)     dequalVarT (VarT n) = VarT (dequalify n)     dequalVarT ty = ty@@ -379,15 +377,16 @@  makeStoreInstance :: Cxt -> Type -> Exp -> Exp -> Exp -> Dec makeStoreInstance cs ty sizeExpr peekExpr pokeExpr =-    InstanceD cs-              (AppT (ConT ''Store) ty)-              [ ValD (VarP 'size) (NormalB sizeExpr) []-              , PragmaD (InlineP 'size Inline FunLike AllPhases)-              , ValD (VarP 'peek) (NormalB peekExpr) []-              , PragmaD (InlineP 'peek Inline FunLike AllPhases)-              , ValD (VarP 'poke) (NormalB pokeExpr) []-              , PragmaD (InlineP 'poke Inline FunLike AllPhases)-              ]+    plainInstanceD+        cs+        (AppT (ConT ''Store) ty)+        [ ValD (VarP 'size) (NormalB sizeExpr) []+        , PragmaD (InlineP 'size Inline FunLike AllPhases)+        , ValD (VarP 'peek) (NormalB peekExpr) []+        , PragmaD (InlineP 'peek Inline FunLike AllPhases)+        , ValD (VarP 'poke) (NormalB pokeExpr) []+        , PragmaD (InlineP 'poke Inline FunLike AllPhases)+        ]  -- TODO: either generate random types that satisfy instances with -- variables in them, or have a check that there's at least a manual

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:                store-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Fast binary serialization homepage:            https://github.com/fpco/store#readme bug-reports:         https://github.com/fpco/store/issues@@ -68,7 +68,7 @@     , text     , th-lift     , th-lift-instances >= 0.1.6-    , th-utilities+    , th-utilities >= 0.1.1.0     , th-reify-many     , time     , transformers@@ -117,7 +117,7 @@     , text     , th-lift     , th-lift-instances >= 0.1.6-    , th-utilities+    , th-utilities >= 0.1.1.0     , th-reify-many     , time     , transformers@@ -166,7 +166,7 @@     , text     , th-lift     , th-lift-instances >= 0.1.6-    , th-utilities+    , th-utilities >= 0.1.1.0     , th-reify-many     , time     , transformers