根据参数和请求的返回类型返回部分产品或记录的函数

以下是如何获取所有兼容字段的列表:

import Data.Data
import Data.Typeable
import Data.Maybe (maybeToList)

fields :: (Data a, Typeable b) => a -> [b]
fields = gmapQr (++) [] (maybeToList . cast)

您使用的产品类型应该派生 Data . 这可以用 {-# LANGUAGE DeriveDataTypeable #-}

data MyProduct = MyProduct String Int Bool
    deriving (Typeable, Data)

参见文档 gmapQr 和 cast .

唯一的警告是我想不出一个方法 编译时 请求不存在的字段时出错。我们需要某种编译时版本的 Data.Data . 我没有意识到任何这样的事情,尽管我怀疑这是可能的(这可能会更痛苦,尽管 deriving Data 为我们做了很多重担!).

一个解决方案是 generic-lens . 特别地, getTyped @T :: P -> T 将访问类型为的字段 T 在任何产品类型中 P (这是 Generic ). 下面是GHCi中的一个示例(有关更多详细信息,请参阅自述文件):

> :set -XDeriveGeneric -XTypeApplications
> import Data.Generics.Product
> import GHC.Generics
> data MyProduct = MyProduct String Int Bool deriving Generic
> getTyped @Int (MyProduct "Hello" 33 True)
33
> getTyped @Int (0 :: Int, "hello")
0

根据@Li-yao庠Xia的回答,这是有可能的 GHC.Generics (这就是 generic-lens 在幕后使用)。密码输入 普通透镜 可能有点难理解,下面是如何从头开始。

方法 仿制药 它表示一种特定类型,例如:

data MyProduct = MyProduct String Int Bool deriving (Generic)

通过同构型 Rep MyProduct 看起来是这样的:

> :kind! Rep MyProduct
Rep MyProduct :: * -> *
= D1
    ('MetaData "MyProduct" "GenericFetch3" "main" 'False)
    (C1
       ('MetaCons "MyProduct" 'PrefixI 'False)
       (S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 String)
        :*: (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 Int)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 Bool))))

无可否认,这有点疯狂,但这种嵌套类型的大多数都包含由 D1 , C1 ,和 S1 类型。如果你去掉包装纸,它可以归结为:

Rep MyProduct = Rec0 String :*: Rec0 Int :*: Rec0 Bool

这有助于显示表示的结构。

无论如何,要编写泛型函数,您可以创建一个类型类,它可以处理 Rep a 使用实例处理元数据包装器和用于表示产品、总和等的一组类型构造函数。

在我们的例子中,我们将定义一个类型类 Fetch' 这样我们就可以获取类型的第一个值 b 代表之外 t (即,如此 t型 将 代表我的产品 或者类似的东西):

class Fetch' t b where
  fetch' :: t p -> Maybe b

现在,我们不需要 t型 实际上包含一个 乙 ,这就是为什么我们允许 fetch' 返回 Nothing .

我们需要一个实例来处理元数据:

instance Fetch' t b => Fetch' (M1 i m t) b where
  fetch' (M1 x) = fetch' x

因为所有的元数据包装器( D1号 , 第一节 ,和 C1类 )实际上是化名( M1 D , M1 S , M1 C 我们可以用一个 M1 通过 取回 穿过包装纸。

我们还需要一个来处理产品:

instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
  fetch' (s :*: t) = fetch' s <|> fetch' t

这只会把 乙 从产品的左边出来,或者——如果不行——从右边出来。

我们需要一个实例来获取 乙 在匹配类型(与 Rec0 上面,因为那只是 K1 R ):

instance Fetch' (K1 i b) b where
  fetch' (K1 x) = Just x

以及将处理错误类型字段的重叠catch all:

instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
  fetch' (K1 _) = Nothing

我们还可以选择在这些表示中处理其他可能的类型构造函数(即, V1 , U1 ,和 :+: )我在下面完整的例子中做过。

总之,有了这些实例,我们可以写:

fetch1 :: (Generic t, Fetch' (Rep t) b) => t -> b
fetch1 = fromJust . fetch' . from

这很管用:

> fetch1 prod :: String
"yes"
> fetch1 prod :: Int
0
> fetch1 prod :: Bool
False

但正如@luqui基于 Data 泛型,它不会在编译时捕获坏字段,而是在运行时崩溃:

> fetch1 prod :: Double
*** Exception: Maybe.fromJust: Nothing

为了解决这个问题,我们可以引入一个类型族来计算数据结构 Rep )实际上包含所需字段,如下所示:

type family Has t b where
  Has (s :*: t) b = Or (Has s b) (Has t b)
  Has (K1 i b) b = 'True
  Has (K1 i a) b = 'False
  Has (M1 i m t) b = Has t b

使用类型族的常用定义 Or . 现在,我们可以在 fetch :

fetch :: ( Generic t
         , Has (Rep t) b ~ 'True
         , Fetch' (Rep t) b)
      => t -> b
fetch = fromJust . fetch' . from

现在我们得到一个错误字段的编译时错误:

> fetch prod :: String
"yes"
> fetch prod :: Double

<interactive>:83:1: error:
    • Couldn't match type ‘'False’ with ‘'True’
        arising from a use of ‘fetch’
    • In the expression: fetch prod :: Double
      In an equation for ‘it’: it = fetch prod :: Double
>

总之,把所有的东西放在一起,添加实例和 Has 对于所有构造函数的定义,我们得到以下版本。注意,对于sum类型(即。, (:+:) ),它只允许在sum中的所有术语中都可以找到字段类型(因此保证存在)。不像 typed 功能 普通透镜 ,此版本允许一个产品中有多个目标类型的字段,只选择第一个。

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module GenericFetch where

import Control.Applicative
import Data.Maybe
import GHC.Generics

data MyProduct = MyProduct String Int Bool deriving (Generic)
prod :: MyProduct
prod = MyProduct "yes" 0 False

data AnotherProduct = AP (Maybe Int) Char deriving (Generic)
ap :: AnotherProduct
ap = AP Nothing 'C'

data ASum = A Int String | B Int Double deriving (Generic)
asum :: ASum
asum = A 10 "hello"

class Fetch' t b where
  fetch' :: t p -> Maybe b
instance Fetch' V1 b where
  fetch' _ = Nothing
instance Fetch' U1 b where
  fetch' _ = Nothing
instance (Fetch' s b, Fetch' t b) => Fetch' (s :+: t) b where
  fetch' (L1 s) = fetch' s
  fetch' (R1 t) = fetch' t
instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
  fetch' (s :*: t) = fetch' s <|> fetch' t
instance Fetch' (K1 i b) b where
  fetch' (K1 x) = Just x
instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
  fetch' (K1 _) = Nothing
instance Fetch' t b => Fetch' (M1 i m t) b where
  fetch' (M1 x) = fetch' x

type family Has t b where
  Has V1 b = 'False
  Has U1 b = 'False
  Has (s :+: t) b = And (Has s b) (Has t b)
  Has (s :*: t) b = Or (Has s b) (Has t b)
  Has (K1 i b) b = 'True
  Has (K1 i a) b = 'False
  Has (M1 i m t) b = Has t b
type family Or a b where
  Or 'False 'False = 'False
  Or a b = 'True
type family And a b where
  And 'True 'True = 'True
  And a b = 'False

fetch :: ( Generic t
         , Has (Rep t) b ~ 'True
         , Fetch' (Rep t) b)
      => t -> b
fetch = fromJust . fetch' . from

给:

> :l GenericFetch
> fetch prod :: Int
0
> fetch prod :: Double
...type error...
> fetch ap :: Maybe Int
Nothing
> fetch ap :: Int
...type error...
> fetch asum :: Int
10
> fetch asum :: String
... type error: no string in `B` constructor...
> 

根据Haskell 98标准,这是不可能的。通常,参数化函数不能基于它变成的具体类型更改行为。它必须保持通用性。

作为一个思考过程,为什么会出现这种情况:

data MpProduct a = My Product Int Int String [a]

什么应该 func 返回要求Int?什么时候呢 a 是查尔吗?

现在,我并不是说一个对GHC扩展有着深厚知识的程序员的一些妙招无法实现这一点,但是使用标准的Hindley Milner typechecker是不可能的。