模板 Haskell 显示实例不工作

Template Haskell Show instance not working

有谁知道为什么这个代码:

module Language.P4.UtilTest where

import Language.P4.Util (mkShow)

data Dummy = Bogus    Char
           | Nonsense Int

$(mkShow ''Dummy)

产生此错误:

Davids-Air-2:P4 dbanas$ stack ghc -- UtilTest.hs -ddump-splices
[1 of 1] Compiling Language.P4.UtilTest ( UtilTest.hs, UtilTest.o )
UtilTest.hs:24:3-16: Splicing declarations
    mkShow ''Dummy
  ======>
    instance Show Dummy where
      show (Bogus x) = show x
      show (Nonsense x) = show x

UtilTest.hs:24:3: error:
    Conflicting definitions for ‘show’
    Bound at: UtilTest.hs:24:3-16
              UtilTest.hs:24:3-16
   |
24 | $(mkShow ''Dummy)
   |   ^^^^^^^^^^^^^^

?

TH 拼接扩展在我看来是正确的。 如果我注释掉第二个构造函数 (Nonsense Int),代码编译时不会出错。此外,如果我手动将显示的 TH 拼接扩展输入到代码中(当然,注释掉 $(mkShow ''Dummy) 行),它编译时不会出错。

mkShow :: Name -> Q [Dec]
mkShow typName = do
  t@(TyConI (DataD _ _ _ _ constructors _)) <- reify typName  -- Get all the information on the type.
  let func_name = mkName "show"
  let var_name  = mkName "x"
  let func_decs = map ( \c@(NormalC nm _) -> FunD func_name
                                                  [ Clause [ConP (simpleName nm) [VarP var_name]]
                                                           (NormalB (AppE (VarE func_name) (VarE var_name)))
                                                           []
                                                  ]
                      )
                      constructors
  return [InstanceD Nothing [] (AppT (ConT (mkName "Show")) (ConT (simpleName typName))) func_decs]

simpleName :: Name -> Name
simpleName nm =
   let s = nameBase nm
   in case dropWhile (/=':') s of
        []          -> mkName s
        _:[]        -> mkName s
        _:t         -> mkName t

上面@user2407038 的评论给出了答案。这是 mkShow():

的更正代码
mkShow :: Name -> Q [Dec]
mkShow typName = do
  t@(TyConI (DataD _ _ _ _ constructors _)) <- reify typName  -- Get all the information on the type.
  let func_name = mkName "show"
  let var_name  = mkName "x"
  let clause_decs = map ( \c@(NormalC nm _) ->
                            Clause [ConP (simpleName nm) [VarP var_name]]
                                   (NormalB (AppE (VarE func_name) (VarE var_name)))
                                   []
                        )
                        constructors
  return [InstanceD Nothing [] (AppT (ConT (mkName "Show")) (ConT (simpleName typName))) [FunD func_name clause_decs]]