module Type.Serialize.Base where
import Type.Digits (Digit, toDigits, toDigits_, fixed, flexible, exactly)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import qualified Data.Hash as H
import qualified Data.Serialize as V
import qualified Data.ByteString as BS
type family Serialize (a :: k) :: Digit
encode :: V.Serialize a => a -> Type
encode = toDigits_ (BS.foldl' ((. fixed) . (++)) []) . V.encode
serializeType_data :: Name -> Q [Dec]
serializeType_data = serializeType_ ConT
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
in return [TySynInstD ''Serialize [inj n] base128]
serializeType_ _ n = fail $ "serializeType expects a global name: " ++ show n
serializeTypeAsHash_data :: Name -> Q [Dec]
serializeTypeAsHash_data = serializeTypeAsHash_ ConT
serializeTypeAsHash_pro :: Name -> Q [Dec]
serializeTypeAsHash_pro = serializeTypeAsHash_ PromotedT
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