diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+module Main where
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Data/TypeHash.hs b/src/Data/TypeHash.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/TypeHash.hs
@@ -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
diff --git a/typehash.cabal b/typehash.cabal
new file mode 100644
--- /dev/null
+++ b/typehash.cabal
@@ -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