如何用GHC.Generics替换Data.Generics？

Question

因此，我已经使用syb很长一段时间了，并且经常使用如下函数

friendlyNames :: Data a => a -> a
friendlyNames = everywhere (mkT (\(Name x _) -> Name x NameS))

假设泛型为a，那么使用GHC.Generics的等价物是什么？

Answer 1

这可能是用GHC.Generics解决的错误问题，但现在你可以这么做了！

{-# Language TypeOperators #-}
{-# Language DeriveGeneric #-}
{-# Language DefaultSignatures #-}
{-# Language FlexibleContexts #-}
module Demo where

import GHC.Generics
import Language.Haskell.TH
import Language.Haskell.TH.Syntax

data Record = Record { field0 :: Int, field1 :: Maybe Record, field2 :: Name } deriving Generic

instance FriendlyNames Record -- body omitted and derived with GHC.Generics
instance FriendlyNames a => FriendlyNames (Maybe a)
instance FriendlyNames Int where friendlyNames = id -- no-op

------------------------------------------------------------------------

-- | Class for types that can be made friendly
class FriendlyNames a where
  friendlyNames :: a -> a
  default friendlyNames :: (GFriendlyNames (Rep a), Generic a) => a -> a
  friendlyNames = to . gfriendlyNames . from

-- | Replaces the second component of a name with 'NameS'
instance FriendlyNames Name where
  friendlyNames (Name x _) = Name x NameS

------------------------------------------------------------------------

-- | Class for generic structures that can have names made friendly
class GFriendlyNames f where
  gfriendlyNames :: f p -> f p

-- | Case for metadata (type constructor, data constructor, field selector)
instance GFriendlyNames f => GFriendlyNames (M1 i c f) where
  gfriendlyNames (M1 x) = M1 (gfriendlyNames x)

-- | Case for product types
instance (GFriendlyNames f, GFriendlyNames g) => GFriendlyNames (f :*: g) where
  gfriendlyNames (x :*: y) = gfriendlyNames x :*: gfriendlyNames y

-- | Case for sum types
instance (GFriendlyNames f, GFriendlyNames g) => GFriendlyNames (f :+: g) where
  gfriendlyNames (L1 x) = L1 (gfriendlyNames x)
  gfriendlyNames (R1 y) = R1 (gfriendlyNames y)

-- | Case for datatypes without any data constructors (why not?)
instance GFriendlyNames V1 where
  gfriendlyNames v1 = v1 `seq` error "gfriendlyNames.V1"

-- | Case for datatypes without any fields
instance GFriendlyNames U1 where
  gfriendlyNames U1 = U1

-- | Case for data constructor fields
instance FriendlyNames a => GFriendlyNames (K1 i a) where
  gfriendlyNames (K1 x) = K1 (friendlyNames x)

GHC.Generics方法更适合这样的情况:这种复杂性只需编写一次，就可以隐藏在库中。虽然SYB方法依赖于运行时检查，但观察为使记录值友好的friendlyNames生成的GHC核心。

-- RHS size: {terms: 14, types: 18, coercions: 0}
recordFriendlyNames
recordFriendlyNames =
  \ w_s63w ->
    case w_s63w of _ { Record ww1_s63z ww2_s63A ww3_s63B ->
    case $recordFriendlyNames ww1_s63z ww2_s63A ww3_s63B
    of _ { (# ww5_s63H, ww6_s63I, ww7_s63J #) ->
    Record ww5_s63H ww6_s63I ww7_s63J
    }
    }

-- RHS size: {terms: 19, types: 19, coercions: 0}
$recordFriendlyNames
$recordFriendlyNames =
  \ ww_s63z ww1_s63A ww2_s63B ->
    (# ww_s63z,
       case ww1_s63A of _ {
         Nothing -> Nothing;
         Just g1_a601 -> Just (recordFriendlyNames g1_a601)
       },
       case ww2_s63B of _ { Name x_a3Z3 ds_d5Z5 -> Name x_a3Z3 NameS } #)

Answer 2

我终于对这个问题有了一个令人满意的答案。它的核心取自glguy上面的答案，但我将添加一些包装器和解释，帮助我将这些点联系起来。我还将使它更通用，以便它与Data.Data提供的工具更紧密地对应。

everywhere函数将对参数值中出现的某个Typeable类型b应用一个函数，该参数值表示为a类型。Typeable实例用于确定在递归过程中何时执行a ~ b。请注意，由于everywhere是类Everywhere的方法，并且提供了默认实例，因此它将接受满足类约束的任何类型

{-# LANGUAGE UndecidableInstances #-}

import Data.Typeable (cast, Typeable)
import GHC.Generics
import Data.Ratio (Ratio)
import Data.Word (Word8)

class (Typeable b, Typeable a) => Everywhere b a where
  everywhere :: (b -> b) -> a -> a

这是Everywhere的基本实例，它可以应用于满足其约束的任何类型，特别是下面为Generic的任何实例定义的GEverywhere。OVERLAPPABLE允许我们为不是Generic实例的其他类型提供实例。

instance {-# OVERLAPPABLE #-} (Typeable b, Typeable a, Generic a, GEverywhere b (Rep a))
  => Everywhere b a where
  everywhere f = to . geverywhere f . from

现在我们编写一个类GEverywhere，它包含了覆盖类型表示的实例。最终，此代码的任务是递归此值中的字段的值。

class GEverywhere b f where
  geverywhere :: (b -> b) -> f p -> f p
instance GEverywhere b f => GEverywhere b (M1 i c f) where
  geverywhere f (M1 x) = M1 (geverywhere f x)
instance (GEverywhere b f, GEverywhere b g) => GEverywhere b (f :*: g) where
  geverywhere f (x :*: y) = geverywhere f x :*: geverywhere f y
instance (GEverywhere b f, GEverywhere b g) => GEverywhere b (f :+: g) where
  geverywhere f (L1 x) = L1 (geverywhere f x)
  geverywhere f (R1 y) = R1 (geverywhere f y)
instance GEverywhere b V1 where geverywhere _ v1 =
  v1 `seq` error "geverywhere.V1"
instance GEverywhere b U1 where geverywhere _ U1 = U1

最后一个实例就是遇到子类型的地方。我们使用Data.Typeable中的cast函数检查它是否是我们要查找的类型

instance Everywhere b a => GEverywhere b (K1 i a) where
  geverywhere f (K1 x) =
    case cast x :: Maybe b of
      Nothing -> K1 (everywhere f x)
      Just x' -> case cast (f x') :: Maybe a of
                   -- This should never happen - we got here because a ~ b
                   Nothing -> K1 (everywhere f x)
                   Just x'' -> K1 x''

最后，在我们感兴趣的类型中可能会出现没有泛型实例的基元类型。

instance (Typeable b, Typeable a) => Everywhere b (Ratio a) where everywhere _ r = r
instance (Typeable b) => Everywhere b Char where everywhere _ r = r
instance (Typeable b) => Everywhere b Integer where everywhere _ r = r
instance (Typeable b) => Everywhere b Word8 where everywhere _ r = r
instance (Typeable b) => Everywhere b Int where everywhere _ r = r

就是这样，现在我们可以使用everywhere进行泛型修改：

λ> everywhere (succ :: Char -> Char) ("abc", 123)
("bcd",123)
λ> everywhere @Int succ ("abc", 123 :: Int)
("abc",124)