typehash 1.4.0.2 → 1.4.0.3
raw patch · 2 files changed
+20/−10 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
- src/Data/TypeHash.hs +18/−8
- typehash.cabal +2/−2
src/Data/TypeHash.hs view
@@ -17,12 +17,14 @@ module Data.TypeHash(TypeCode, typeCode, convertibleIso, convertibleWithReadShow, convertibleWithJSON, TypeHash, typeHash) where-import Data.Char(isAlpha)+import Control.Arrow((***)) import Control.Monad.State-import Data.Generics import Data.Binary-import Data.Digest.Pure.MD5(MD5Digest, md5) import Data.ByteString.Lazy(pack)+import Data.Char(isAlpha)+import Data.Digest.Pure.MD5(MD5Digest, md5)+import Data.Generics+import Data.Typeable.Internal(tyConModule, tyConName) --import Debug.Trace @@ -65,12 +67,20 @@ f = do modify (gType tns (undefined :: d) :); return undefined -- Replace unqualified type name by qualified type name.--- XXX Only does it on the top level, because I don't know how to get deeper.+-- XXX ?not yet? Also replace some ghc specific names with more portable ones. fullTypeOf :: (Data a) => a -> TypeRep-fullTypeOf a | not $ isAlpha $ head $ tyConString $ typeRepTyCon $ ta = ta- | otherwise = mkTyConApp (mkTyCon $ dataTypeName $ dataTypeOf a)- (typeRepArgs ta)- where ta = typeOf a+fullTypeOf = fixup . typeOf+ where fixup = uncurry mkTyConApp . (fixupTyCon *** map fixup) . splitTyConApp+ fixupTyCon c = mkTyCon $+ case (tyConModule c, tyConName c) of+{-+ ("GHC.Types", s) -> "Prelude." ++ s+ ("GHC.Tuple", s) -> "Prelude." ++ s+ ("GHC.Unit", "()") -> "Prelude.()"+ ("GHC.Integer.Type", "Integer") -> "Prelude.Integer"+-}+ (m, s) -> m ++ "." ++ s+ ------------
typehash.cabal view
@@ -1,6 +1,6 @@ Name: typehash Cabal-Version: >= 1.2-Version: 1.4.0.2+Version: 1.4.0.3 License: BSD3 Author: Lennart Augustsson Maintainer: Lennart Augustsson@@ -14,5 +14,5 @@ Library Hs-Source-Dirs: src- Build-Depends: base >= 4 && < 4.4, syb, mtl, bytestring, pureMD5, binary+ Build-Depends: base >= 4 && < 4.5, syb, mtl, bytestring, pureMD5, binary Exposed-modules: Data.TypeHash