仅使用名称的 Show 的替代方案

Alternative of Show that only uses name

是否有类似 Show(派生 Show)的东西只使用代数数据类型的构造函数? (请不要介意我使用的是构造函数这个词,我不知道正确的名称...)

这个问题的原因是,对于我的许多代数数据类型,我不想费心让它们的内容也派生 Show,但我仍然想获得一些关于所用构造函数的调试信息,而不必实现显示每个构造函数...

另一种方法是给我构造函数名称的函数,我可以在自己的 show 实现中使用它。

这当然需要做一些编译器魔术(自动派生),因为背后的整个想法是不必显式地实现每个数据构造函数字符串表示。

对于具有 Data.Data.Data 实例的类型,此函数很简单:它仅仅是

showConstr . toConstr :: Data a => a -> String

例如,

Prelude Data.Data> showConstr . toConstr $ Just 5
"Just"

对于没有实现 Data 的类型,这是相当绝望的,因为您无法查看类型内部以了解它是如何实现的。但是由于您自己定义了这些类型,您只需确保它们有一个 Data 实例。如果您启用了 DeriveDataTypeable.

,它会使用 deriving Data 自动导出

请注意,Data仅适用于代数和透明的类型。您将无法为某个类型派生实例,例如,在其字段之一中包含一个函数。因此,这可能并没有像您希望的那样缓解 Show 的暴政:许多 Show 无法支持的类型也将被 Data 拒绝。 Generic 可以提供更通用的解决方案。我不是仿制药方面的专家,但 conNameOf 看起来很有前途。

更明确的方法是通过 TemplateHaskell 创建自定义派生。以下代码描述了为给定数据类型生成自定义 Show 实例的逻辑:

genShow :: Name -> Q [Dec]
genShow typName =
  do  -- Getting type definition
     (TyConI d) <- reify typName -- Get all the information on the type

     -- Extracting interesting info: type name, args and constructors
     let unpackConstr c = case c of
           NormalC cname args -> (cname, length args)
           InfixC _ cname _ -> (cname, 2)
           RecC cname args -> (cname, length args)
           ForallC _ _ c -> unpackConstr c
           _ -> error "you need to figure out GADTs yourself"

     (type_name, targs, constructors) <-
       case d of
         d@(DataD _ name targs _ cs _) ->
           return (name, targs, map unpackConstr cs)
         d@(NewtypeD _ name targs _ con _) ->
           return (name, targs, [unpackConstr con])
         _ -> error ("derive: not a data type declaration: " ++ show d)

     -- Extracting name from type args
     let targName targ = case targ of
           PlainTV tvname _ -> tvname
           KindedTV tvname _ _ -> tvname

     -- Manually building AST for an instance. 
     -- Essentially, we match on every constructor and make our `show`
     -- return it as a string result.
     i_dec <- instanceD (cxt [])
       (appT (conT (mkName "Show")) (foldl appT (conT type_name) 
         (map (varT . targName) targs)))
       [funD (mkName "show") (flip map constructors $ \constr ->
         let myArgs = [conP (fst constr) $ map (const wildP) [1..snd constr]]
             myBody = normalB $ stringE $ nameBase $ fst constr
         in clause myArgs myBody []
       )]
     return [i_dec]

那么,你只需要做

data MyData = D Int | X

$(genShow ''MyData)

...你可以愉快地 show 它。请注意,两个代码片段 必须 放在单独的模块中,并且您需要使用 TemplateHaskell 扩展名。


我从 this article 中获得了很多灵感。

你可以通过

-- >> Anonymous 120320
-- Anonymous
-- >> User "Iðunn" 242424
-- User
data User
 = User String Int
 | Anonymous Int
 deriving
 stock Generic

 deriving Show
 via OnlyConstructors User

给出

type    OnlyConstructors :: Type -> Type
newtype OnlyConstructors a = OnlyConstructors a

instance (Generic a, GNames (GHC.Generics.Rep a)) => Show (OnlyConstructors a) where
  showsPrec :: Int -> OnlyConstructors a -> ShowS
  showsPrec _ (OnlyConstructors a) = gnames (from a)

type  GNames :: (Type -> Type) -> Constraint
class GNames rep where
  gnames :: rep () -> ShowS

instance GNames rep => GNames (D1 meta rep) where
  gnames :: D1 meta rep () -> ShowS
  gnames (M1 rep) = gnames rep

instance GNames V1 where
  gnames :: V1 () -> ShowS
  gnames = \case

instance (GNamesProd rep, GNames rep') => GNames (rep :+: rep') where
  gnames :: (rep :+: rep') () -> ShowS
  gnames (L1 as) = gnamesProd as
  gnames (R1 bs) = gnames bs

instance GNamesProd (C1 meta rep) => GNames (C1 meta rep) where
  gnames :: C1 meta rep () -> ShowS
  gnames = gnamesProd

type  GNamesProd :: (Type -> Type) -> Constraint
class GNamesProd rep where
  gnamesProd :: rep () -> ShowS

instance (KnownSymbol cons, meta ~ MetaCons cons fixity sel) => GNamesProd (C1 meta rep) where
  gnamesProd :: C1 (MetaCons cons fixity sel) rep () -> ShowS
  gnamesProd (M1 as) = showString (symbolVal @cons Proxy)