泛型：带有类的 syb 的当前状态

Question

我正在尝试使用论文Scrap Your Boilerplate with class 中描述的泛型编程。也就是说，能够向下“递归”用户定义类的成员，而不是编写遍历代码时已知的一组固定类型。

似乎相应的hackage包http://hackage.haskell.org/package/syb-with-class可以用于此目的，但大多数在线讨论（例如7年前的这个问题：Does the current SYB permit extension of generic functions with new types?）暗示当前GHC.Generics是首选。特别是，该实现似乎早于使用约束类型，这应该使这种编程更容易。但是，GHC.Generics 框架似乎不允许使用可扩展函数进行遍历。

如今，使用可扩展类型执行泛型函数的最佳选择是什么？如果可能的话，我想避免使用“内部”表示（即任何类型的K1、M1 等组合符）并且希望能够使用类似Uniplate 的接口。任何指向论文、博客文章或一般建议的指针都将不胜感激。

Answer 1

嗯，这是给你的一篇博文……

如果您想按照“Scrap Your Boilerplate with class”论文中所述进行通用编程，那么推荐的方法是使用 syb-with-class 包，尽管有 Stack Overflow 的回答，因为 syb-with-class 包是活跃的维护和工作得很好。

如果您想直接使用GHC.Generics 对可扩展类型进行泛型编程，那么——就像任何其他直接使用GHC.Generic 一样——你无法避免使用K1、M1、等表示。不幸的是，文档使这种表示听起来像是内部实现细节，随时可能发生变化。

GHC.Generics 的潜在优势在于它自然是基于类型类的，因此您可以免费获得类型可扩展性。例如，以 SYB with class 论文中的gsize 示例为例，您可以在GHC.Generics 中直接使用一对类来实现它，一个用于处理泛型结构，另一个用于处理沿途的具体类型：

-- Handle the generic structure
class Size' f where
  size' :: f p -> Int
instance (Size' f) => Size' (M1 i c f) where
  size' (M1 x) = size' x
instance (Size' f, Size' g) => Size' (f :+: g) where
  size' (L1 x) = size' x
  size' (R1 x) = size' x
instance (Size' f, Size' g) => Size' (f :*: g) where
  size' (f :*: g) = size' f + size' g
instance (Size' U1) where
  size' U1 = 0  -- constructor already counted by Size class
instance (Size' V1) where
  size' _ = undefined
instance (Size c) => Size' (K1 i c) where
  size' (K1 x) = size x

-- Handle the types
class Size t where
  size :: t -> Int
  default size :: (Generic t, Size' (Rep t)) => t -> Int
  size t = 1 + size' (from t)

一般来说，没有必要扩展Size'，因为它是——通过构造——一个与类型无关的通用实现，它将具有详尽（或几乎详尽）的一组实例。但是，Size 类型类显然是开放的，可以随意扩展：

data Name = N String
instance Size Name where
    size (N _) = 1

-- a fanciful example of a custom recursive type
newtype Negative a = Neg a
instance Size a => Size (Negative a) where
  size (Neg x) = -size x

-- a user-defined type using a default instance
data Something = Something Int (Name, Name) Bool deriving (Generic)
instance Size Something

-- needs some supporting default instances:
instance Size Bool
instance (Size a, Size b) => Size (a,b)
-- and a custom instance.  This could be defaulted, but
-- then we'd need an instance for unboxed Int#
instance Size Int where size _ = 1

main = do
  print $ size (Something 10 (N "John", N "Doe") False)
  print $ size (Neg (1 :: Int, 2 :: Int), True)

因为泛型Size' 类确实是泛型的，所以可以将其泛化为类似“SYB with class”的查询，我们可以使用ConstraintKinds 使语法更清晰一些：

class Query' cls f where
  gmapQm :: Monoid a => Proxy cls -> (forall t. cls t => t -> a) -> f p -> a
instance (Query' cls f) => Query' cls (M1 i c f) where
  gmapQm p h (M1 x) = gmapQm p h x
instance (Query' cls f, Query' cls g) => Query' cls (f :+: g) where
  gmapQm p h (L1 x) = gmapQm p h x
  gmapQm p h (R1 x) = gmapQm p h x
instance (Query' cls U1) where
  gmapQm _ _ U1 = mempty
instance (Query' cls f, Query' cls g) => Query' cls (f :*: g) where
  gmapQm p h (f :*: g) = gmapQm p h f <> gmapQm p h g
instance (cls c) => Query' cls (K1 i c) where
  gmapQm p h (K1 x) = h x

然后定义多个可扩展的通用查询：

class Size2 t where
  size2 :: t -> Sum Int
  default size2 :: (Generic t, Query' Size2 (Rep t)) => t -> Sum Int
  size2 t = Sum 1 <> gmapQm @Size2 Proxy size2 (from t)
instance Size2 Something
instance (Size2 a, Size2 b) => Size2 (a,b)
instance Size2 Bool
instance Size2 Int where size2 _ = 1
instance Size2 Name where size2 (N _) = 1

class Tags t where
  tags :: t -> [String]
  default tags :: (Generic t, Query' Tags (Rep t)) => t -> [String]
  tags t = gmapQm @Tags Proxy tags (from t)
instance Tags Something
instance (Tags a, Tags b) => Tags (a,b)
instance Tags Name where tags (N str) = ["Name", str]
instance Tags Int where tags _ = ["Int"]
instance Tags Double where tags _ = ["Double"]
instance Tags Bool where
  tags True  = ["Bool:True"]
  tags False = ["Bool:False"]

main2 = do
  print $ size2 (Something 10 (N "John", N "Doe") False)
  print $ tags (Something 10 (N "John", N "Doe") False)

带有奖励gmapT实现和示例的完整代码：

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}

import GHC.Generics
import Data.Proxy
import Data.Monoid

--
-- Size'/Size directly implemented with GHC.Generics
---

-- Handle the generic structure
class Size' f where
  size' :: f p -> Int
instance (Size' f) => Size' (M1 i c f) where
  size' (M1 x) = size' x
instance (Size' f, Size' g) => Size' (f :+: g) where
  size' (L1 x) = size' x
  size' (R1 x) = size' x
instance (Size' f, Size' g) => Size' (f :*: g) where
  size' (f :*: g) = size' f + size' g
instance (Size' U1) where
  size' U1 = 0
instance (Size' V1) where
  size' _ = undefined
instance (Size c) => Size' (K1 i c) where
  size' (K1 x) = size x

-- Handle the types
class Size t where
  size :: t -> Int
  default size :: (Generic t, Size' (Rep t)) => t -> Int
  size t = 1 + size' (from t)

data Name = N String deriving (Show)
instance Size Name where
    size (N _) = 1

-- a fanciful example of a custom recursive type
newtype Negative a = Neg a
instance Size a => Size (Negative a) where
  size (Neg x) = -size x

-- a user-defined type using a default instance
data Something = Something Int (Name, Name) Bool deriving (Show, Generic)
instance Size Something

-- needs some supporting default instances:
instance Size Bool
instance (Size a, Size b) => Size (a,b)
-- and a custom instance.  This could be defaulted, but
-- then we'd need an instance for unboxed Int#
instance Size Int where size _ = 1

--
-- gmapQm "with class" implemented using GHC.Generics and ConstraintKinds
--

class SYB cls f where
  gmapQm :: Monoid a => Proxy cls -> (forall t. cls t => t -> a) -> f p -> a
  gmapT :: Proxy cls -> (forall t. cls t => t -> t) -> f p -> f p
instance (SYB cls f) => SYB cls (M1 i c f) where
  gmapQm p h (M1 x) = gmapQm p h x
  gmapT p h (M1 x) = M1 $ gmapT p h x
instance (SYB cls f, SYB cls g) => SYB cls (f :+: g) where
  gmapQm p h (L1 x) = gmapQm p h x
  gmapQm p h (R1 x) = gmapQm p h x
  gmapT p h (L1 x) = L1 $ gmapT p h x
  gmapT p h (R1 x) = R1 $ gmapT p h x
instance (SYB cls U1) where
  gmapQm _ _ U1 = mempty
  gmapT _ _ U1 = U1
instance (SYB cls f, SYB cls g) => SYB cls (f :*: g) where
  gmapQm p h (f :*: g) = gmapQm p h f <> gmapQm p h g
  gmapT p h (f :*: g) = gmapT p h f :*: gmapT p h g
instance (cls c) => SYB cls (K1 i c) where
  gmapQm p h (K1 x) = h x
  gmapT p h (K1 x) = K1 (h x)

-- Size query using gmapQm

class Size2 t where
  size2 :: t -> Sum Int
  default size2 :: (Generic t, SYB Size2 (Rep t)) => t -> Sum Int
  size2 t = Sum 1 <> gmapQm @Size2 Proxy size2 (from t)
instance Size2 Something
instance (Size2 a, Size2 b) => Size2 (a,b)
instance Size2 Bool
instance Size2 Int where size2 _ = 1
instance Size2 Name where size2 (N _) = 1

-- another generic query using gmapQm

class Tags t where
  tags :: t -> [String]
  default tags :: (Generic t, SYB Tags (Rep t)) => t -> [String]
  tags t = gmapQm @Tags Proxy tags (from t)
instance Tags Something
instance (Tags a, Tags b) => Tags (a,b)
instance Tags Name where tags (N str) = ["Name", str]
instance Tags Int where tags _ = ["Int"]
instance Tags Double where tags _ = ["Double"]
instance Tags Bool where
  tags True  = ["Bool:True"]
  tags False = ["Bool:False"]

-- a generic transform

class Zero t where
  zero :: t -> t
  default zero :: (Generic t, SYB Zero (Rep t)) => t -> t
  zero t = to $ gmapT @Zero Proxy zero (from t)
instance Zero Something
instance (Zero a, Zero b) => Zero (a,b)
instance Zero String where zero _ = []  -- zero strings
instance Zero Name where zero = id -- but don't zero names!
instance Zero Bool where zero _ = False
instance Zero Int where zero _ = 0
instance Zero Double where zero _ = 0

-- some tests

main = do
  let s = Something 10 (N "John", N "Doe") False
  print $ size s
  print $ size (Neg (1 :: Int, 2 :: Int), True)
  print $ size2 s
  print $ tags s
  print $ zero (s, "this string will be zeroed")