我正在尝试使用“使用class废弃您的样板”一文中所述的通用编程。也就是说,与编写遍历代码时已知的一组固定类型相反,能够与用户定义的类的成员一起“递归”。
似乎相应的hackage软件包http://hackage.haskell.org/package/syb-with-class可以用于此目的,但是大多数在线讨论(例如7年前的问题:当前的SYB是否允许使用新类型扩展通用函数?)表示当前GHC.Generics
是首选。特别是,该实现似乎早于使用约束类型,这被认为可以简化此类编程。但是,该GHC.Generics
框架似乎不允许使用可扩展功能进行遍历。
如今,使用可扩展类型执行泛型函数的最佳替代方法是什么?如果有可能,我想避免使用“内部”表示形式(即,任何一种K1
,M1
等等。组合器),并且希望能够使用类似Uniplate的界面。任何指向论文,博客文章或一般建议的指针将不胜感激。
好吧,这是给您的博客文章...
如果您要按照“用类替换样板”中的说明进行通用编程,则syb-with-class
尽管有Stack Overflow的答案,但推荐的方法还是使用该程序包,因为该syb-with-class
程序包可以得到积极维护并且可以正常工作。
如果你想要做泛型编程与可扩展类型直接GHC.Generics
,然后-与其他任何直接使用GHC.Generic
-你真的不能避免使用K1
,M1
等表示。不幸的是,文档使此表示听起来像是内部实现细节,随时可能更改。
它的潜在优势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] 删除。
我来说两句