Commit 94518cdb authored by Iustin Pop's avatar Iustin Pop

TH: Abstract function for computing constructor names

We'll need this in another place shortly, so let's abstract it and add
proper verification of whether we were passed a type name correctly;
the previous version would have failed with a pattern match failure,
instead of an explicit message.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent f2374060
......@@ -369,6 +369,15 @@ constructorName (NormalC name _) = return name
constructorName (RecC name _) = return name
constructorName x = fail $ "Unhandled constructor " ++ show x
-- | Extract all constructor names from a given type.
reifyConsNames :: Name -> Q [String]
reifyConsNames name = do
reify_result <- reify name
case reify_result of
TyConI (DataD _ _ _ cons _) -> mapM (liftM nameBase . constructorName) cons
o -> fail $ "Unhandled name passed to reifyConsNames, expected\
\ type constructor but got '" ++ show o ++ "'"
-- | Builds the generic constructor-to-string function.
--
-- This generates a simple function of the following form:
......@@ -382,8 +391,7 @@ constructorName x = fail $ "Unhandled constructor " ++ show x
-- 'genToRaw' to actually generate the function
genConstrToStr :: (String -> String) -> Name -> String -> Q [Dec]
genConstrToStr trans_fun name fname = do
TyConI (DataD _ _ _ cons _) <- reify name
cnames <- mapM (liftM nameBase . constructorName) cons
cnames <- reifyConsNames name
let svalues = map (Left . trans_fun) cnames
genToRaw ''String (mkName fname) name $ zip cnames svalues
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment