module Data.TypeHash(TypeHash, typeHash) where
import Data.Char(isAlpha)
import Control.Monad.State
import Data.Generics
newtype TypeHash = TypeHash String
deriving (Eq, Ord, Typeable, Data, Show, Read)
typeHash :: (Data a) => a -> TypeHash
typeHash = TypeHash . show . gType []
data Type
= Name { typeName :: String }
| Data { typeName :: String, constrs :: [(String, [Field])] }
deriving (Eq, Ord, Show)
type Field = (String, Type)
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
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