泛型:syb与类的当前状态

别名

我正在尝试使用“使用class废弃您的样板”一文中所述的通用编程也就是说,与编写遍历代码时已知的一组固定类型相反,能够与用户定义的类的成员一起“递归”。

似乎相应的hackage软件包http://hackage.haskell.org/package/syb-with-class可以用于此目的,但是大多数在线讨论(例如7年前的问题:当前的SYB是否允许使用新类型扩展通用函数?)表示当前GHC.Generics是首选。特别是,该实现似乎早于使用约束类型,这被认为可以简化此类编程。但是,该GHC.Generics框架似乎不允许使用可扩展功能进行遍历。

如今,使用可扩展类型执行泛型函数的最佳替代方法是什么?如果有可能,我想避免使用“内部”表示形式(即,任何一种K1M1等等。组合器),并且希望能够使用类似Uniplate的界面。任何指向论文,博客文章或一般建议的指针将不胜感激。

卡尔·布尔

好吧,这是给您的博客文章...

如果您要按照“用类替换样板”中的说明进行通用编程,则syb-with-class尽管有Stack Overflow的答案,但推荐的方法还是使用该程序包,因为该syb-with-class程序包可以得到积极维护并且可以正常工作。

如果你想要做泛型编程与可扩展类型直接GHC.Generics,然后-与其他任何直接使用GHC.Generic-你真的不能避免使用K1M1等表示。不幸的是,文档使此表示听起来像是内部实现细节,随时可能更改。

它的潜在优势GHC.Generics是它自然地基于类型类,因此您可以免费获得类型可扩展性。例如,以SYB中带有类文件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”的查询,并且我们可以使用它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")

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章