Template haskell/Instance deriving example
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
type Func_name = Name
type Constructor = (Name, [(Maybe Name, Type)])
type Cons_vars = [ExpQ]
type Function_body = ExpQ
type Gen_func = Constructor -> Cons_vars -> Function_body
type Funcs = [(Func_name, Gen_func)]
-- construct an instance of class class_name for type for_type
-- funcs is a list of instance method names with a corresponding
-- function to build the method body
gen_instance :: Name -> TypeQ -> [Constructor] -> Funcs -> DecQ
gen_instance class_name for_type constructors funcs =
instanceD (cxt [])
(appT (conT class_name) for_type)
(map func_def funcs)
where func_def (func_name, gen_func)
= funD func_name -- method name
-- generate function body for each constructor
(map (gen_clause gen_func) constructors)
-- Generate the pattern match and function body for a given method and
-- a given constructor. func_body is a function that generations the
-- function body
gen_clause :: (Constructor -> [ExpQ] -> ExpQ) -> Constructor -> ClauseQ
gen_clause func_body data_con@(con_name, components) =
-- create a parameter for each component of the constructor
do vars <- mapM var components
-- function (unnamed) that pattern matches the constructor
-- mapping each component to a value.
(clause [(conP con_name (map varP vars))]
(normalB (func_body data_con (map varE vars))) [])
-- create a unique name for each component.
where var (_, typ)
= newName
$ case typ of
(ConT name) -> toL $ nameBase name
otherwise -> "parm"
where toL (x:y) = (toLower x):y
unCapalize :: [Char] -> [Char]
unCapalize (x:y) = (toLower x):y
-- Generate an intance of the class TH_Render for the type typName
gen_render :: Name -> Q [Dec]
gen_render typName =
do (TyConI d) <- reify typName -- Get all the information on the type
(type_name,_,_,constructors) <- typeInfo (return d) -- extract name and constructors
i_dec <- gen_instance (mkName "TH_Render") (conT type_name) constructors
-- generation function for method "render"
[(mkName "render", gen_render)]
return [i_dec] -- return the instance declaration
-- function to generation the function body for a particular function
-- and constructor
where gen_render (conName, components) vars
-- function name is based on constructor name
= let funcName = makeName $ unCapalize $ nameBase conName
-- choose the correct builder function
headFunc = case vars of
[] -> "func_out"
otherwise -> "build"
-- build 'funcName parm1 parm2 parm3 ...
in appsE $ (varE $ mkName headFunc):funcName:vars -- put it all together
-- equivalent to 'funcStr where funcStr CONTAINS the name to be returned
makeName funcStr = (appE (varE (mkName "mkName")) (litE $ StringL funcStr))