Question

有谁知道为什么这段代码：

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 splice扩展对我来说是正确的。如果我注释掉第二个构造函数（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

Answer 1

上述@ 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]]

模板Haskell Show实例无法正常工作

1 个答案: