type-cereal 0.1.1 → 0.2

raw patch · 3 files changed

+38/−53 lines, 3 filesdep ~bytestringdep ~cerealdep ~data-hash

Dependency ranges changed: bytestring, cereal, data-hash, type-digits, type-spine

Files

• Type/Serialize.hs +7/−16
• Type/Serialize/Base.hs +25/−33
• type-cereal.cabal +6/−4

@@ -10,29 +10,20 @@ Stability   :  experimental Portability :  see LANGUAGE pragmas (... GHC) -Type-level serialization for the basic types (Bool, Char, Either, etc.) as well-as the @type-spine@ default case for type-applications.+Type-level serialization for the basic types: Bool, Char, Either, etc.  -} module Type.Serialize (module Type.Serialize.Base) where  import Type.Serialize.Base--import Type.Spine.Stage0 (kTypeG)-import Language.Haskell.TH-import Type.Digits (toType_, digit, radix)-+import Type.Spine+import Type.Digits  -fmap concat $ mapM serializeTypeAsHash+fmap concat $ mapM serializeTypeAsHash_data   [''Bool, ''Char, ''Double, ''Float, ''Int, ''Integer, ''Ordering,    ''(), ''(,), ''(,,), ''(,,,), ''(,,,,),-   ''IO, ''[], ''Maybe, ''(->), ''Either]-+   ''IO, ''[], ''Maybe, ''(->), ''Either,+   ''(:@), ''Atom, ''Digit] -sequence [- let k2 = kTypeG $ ArrowK StarK StarK-     n = conT $ digit d-     v = return $ toType_ [digit d]- in tySynInstD ''Serialize [k2 `appT` n] v- | d <- [0..radix-1]]+fmap concat $ mapM serializeTypeAsHash_pro $ digitStopName : digitNames

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, ViewPatterns #-}+{-# LANGUAGE TemplateHaskell, TypeFamilies, ViewPatterns, DataKinds, PolyKinds #-}  {- | @@ -13,12 +13,9 @@ Type-level serialization (i.e. type -> @type-digit@ type-level numeral).  -}-module Type.Serialize.Base-  (Serialize, encode, serializeType, serializeTypeAsHash, serializeTypeAsHash_) where+module Type.Serialize.Base where -import Type.Spine.TH (tyConSignature)-import Type.Spine.Stage0 (kTypeG)-import Type.Digits (toDigits, toDigits_, fixed, flexible, exactly)+import Type.Digits (Digit, toDigits, toDigits_, fixed, flexible, exactly)  import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -32,7 +29,7 @@   -- | @Serialize@ maps a type to its unique type-level serialization.-type family Serialize a+type family Serialize (a :: k) :: Digit  -- | Encode uses the @cereal@ package serializer to encode the value and then -- uses @type-digits@ to reflect it as a type-level numeral.@@ -41,36 +38,31 @@  -- | Generates the @Serialize@ instance corresponding to the serialization of -- the type constructor's globally unique name (i.e. TH's @NameG@).-serializeType :: Name -> Q [Dec]-serializeType n@(Name (occString -> occ)-                (NameG _ (pkgString -> pkg) (modString -> mod))) = do-  (ks, k) <- tyConSignature n+serializeType_data :: Name -> Q [Dec]+serializeType_data = serializeType_ ConT -  let qk = kTypeG $ foldr ArrowK k ks-      uid = (occ, mod, pkg)-      base128 = return .-                toDigits (exactly 3 . take 3 . flexible) (H.asWord64 $ H.hash uid) .+serializeType_pro :: Name -> Q [Dec]+serializeType_pro = serializeType_ PromotedT++serializeType_ inj n@(Name (occString -> occ)+                     (NameG _ (pkgString -> pkg) (modString -> mod))) =+  let uid = (occ, mod, pkg)+      base128 = toDigits (exactly 3 . take 3 . flexible) (H.asWord64 $ H.hash uid) .                 encode $ uid-  (:[]) `fmap` tySynInstD ''Serialize [qk `appT` conT n] base128-serializeType n = fail $ "serializeType expects a global name: " ++ show n+  in return [TySynInstD ''Serialize [inj n] base128]+serializeType_ _ n = fail $ "serializeType expects a global name: " ++ show n  -- | @serializeType@ can result in very large types, so we prefer the -- @data-hash@ hash of the @NameG@'s serialization.-serializeTypeAsHash :: Name -> Q [Dec]-serializeTypeAsHash n = do-  (ks, k) <- tyConSignature n-  serializeTypeAsHash_ n ks k+serializeTypeAsHash_data :: Name -> Q [Dec]+serializeTypeAsHash_data = serializeTypeAsHash_ ConT --- | @serializeType@ can result in very large types, so we prefer the--- @data-hash@ hash of the @NameG@'s serialization.-serializeTypeAsHash_ :: Name -> [Kind] -> Kind -> Q [Dec]-serializeTypeAsHash_ n@(Name (occString -> occ)-                (NameG _ (pkgString -> pkg) (modString -> mod))) ks k = do-  let qk = kTypeG $ foldr ArrowK k ks-      uid = (occ, mod, pkg)-      base128 = return . toDigits_ flexible . H.asWord64 . H.hash $ uid-  (:[]) `fmap` tySynInstD ''Serialize [qk `appT` conT n] base128-serializeTypeAsHash_ n _ _ = fail $ "serializeTypeAsHash expects a global name: " ++ show n+serializeTypeAsHash_pro :: Name -> Q [Dec]+serializeTypeAsHash_pro = serializeTypeAsHash_ PromotedT -tvb_kind (PlainTV _) = StarK-tvb_kind (KindedTV _ k) = k+serializeTypeAsHash_ inj n@(Name (occString -> occ)+                (NameG _ (pkgString -> pkg) (modString -> mod))) =+  let uid = (occ, mod, pkg)+      base128 = toDigits_ flexible . H.asWord64 . H.hash $ uid+  in return [TySynInstD ''Serialize [inj n] base128]+serializeTypeAsHash_ _ n = fail $ "serializeTypeAsHash expects a global name: " ++ show n

@@ -1,5 +1,5 @@ Name:           type-cereal-Version:        0.1.1+Version:        0.2 License:        BSD3 License-File:   LICENSE Author:         Nicolas Frisby <nicolas.frisby@gmail.com>@@ -19,8 +19,10 @@   Library-  Build-Depends: base >= 4 && < 5, template-haskell-  Build-Depends: cereal >= 0.3 && < 0.4, bytestring >= 0.9 && < 0.10, data-hash < 0.2-  Build-Depends: type-spine < 0.2, type-digits < 0.2+  Build-Depends: base >= 4 && < 5, template-haskell, bytestring++  Build-Depends: cereal, data-hash++  Build-Depends: type-spine >= 0.2, type-digits >= 0.2    Exposed-Modules: Type.Serialize, Type.Serialize.Base