typehash (empty) → 1.0.0.0

raw patch · 3 files changed

+71/−0 lines, 3 filesdep +basedep +mtlsetup-changed

Dependencies added: base, mtl

Files

• Setup.hs +3/−0
• src/Data/TypeHash.hs +53/−0
• typehash.cabal +15/−0

@@ -0,0 +1,3 @@+module Main where+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,53 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}+-- | Produce a /hash/ for a type that is unique for that type.+-- The hash takes both actual type names and type structure into account.+--+-- The purpose of the hash of a type is to be able to store the type+-- of a persisted value together with the value.+-- By comparing the type hash of a persisted value and the expected value+-- we can know if the persistened value is of the correct type.+--+-- The current implementation is not really a hash, but a string representation+-- of the type structure.+module Data.TypeHash where+import Data.Char(isAlpha)+import Control.Monad.State+import Data.Generics++-- | The type of a hashed type.+newtype TypeHash = TypeHash String+    deriving (Eq, Ord, Typeable, Data, Show, Read)++-- | Turn the type of the value into a type hash.+typeHash :: (Data a) => a -> TypeHash+typeHash = TypeHash . show . gType []++data Type+    = Name { typeName :: String }            -- Abstract type, or recursive reference+    | Data { typeName :: String, constrs :: [(String, [Field])] }+    deriving (Eq, Ord, Show)++type Field = (String, Type)  -- a "_" string for missing field names++gType :: (Data a) => [String] -> a -> Type+gType tns x =+    let tn = show $ fullTypeOf x+    in  case dataTypeRep $ dataTypeOf x of+        AlgRep cs | tn `notElem` tns ->+            Data { typeName = tn, constrs = map (gConstr (tn:tns) x) cs }+        _ -> Name { typeName = tn }++gConstr :: (Data a) => [String] -> a -> Constr -> (String, [Field])+gConstr tns x c = (showConstr c,+                   zip fs (reverse $ execState (fromConstrM f c `asTypeOf` return x) []))+  where fs = constrFields c ++ repeat "_"+        f :: forall d . (Data d) => State [Type] d+        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.+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

@@ -0,0 +1,15 @@+Name:		typehash+Version:	1.0.0.0+License:	BSD3+Author:		Lennart Augustsson+Maintainer:	Lennart Augustsson+Category:	Reflection+Synopsis:	Create a unique hash value for a type.+Stability:      experimental+Build-type:	Simple+Description:	Produce a hash for a type that is unique for that type.+		The hash takes both actual type names and type structure into account.+		This is useful for checking the type of persisted values.+Hs-Source-Dirs: src+Build-Depends:	base, mtl+Exposed-modules:	Data.TypeHash