我有一个包含不同类型字段的记录，以及适用于所有这些类型的函数。作为一个小（愚蠢）的例子：
data Rec = Rec { flnum :: Float, intnum :: Int } deriving (Show)
说，我想定义一个为每个字段添加两条记录的函数：
addR :: Rec -> Rec -> Rec
addR a b = Rec { flnum = (flnum a) + (flnum b), intnum = (intnum a) + (intnum b) }
有没有一种方法可以不用对每个字段重复操作（记录中可能有很多字段）来表达这一点？
实际上，我有一条完全由Maybe 字段组成的记录，我想将实际数据与包含某些字段默认值的记录结合起来，以便在实际数据为Nothing 时使用。
（我猜应该可以使用模板 haskell，但我对“可移植”实现更感兴趣。）
【问题讨论】：
标签： haskell data-structures record
还有一种方法是使用GHC.Generics:
{-# LANGUAGE FlexibleInstances, FlexibleContexts,
UndecidableInstances, DeriveGeneric, TypeOperators #-}
import GHC.Generics
class AddR a where
addR :: a -> a -> a
instance (Generic a, GAddR (Rep a)) => AddR a where
addR a b = to (from a `gaddR` from b)
class GAddR f where
gaddR :: f a -> f a -> f a
instance GAddR a => GAddR (M1 i c a) where
M1 a `gaddR` M1 b = M1 (a `gaddR` b)
instance (GAddR a, GAddR b) => GAddR (a :*: b) where
(al :*: bl) `gaddR` (ar :*: br) = gaddR al ar :*: gaddR bl br
instance Num a => GAddR (K1 i a) where
K1 a `gaddR` K1 b = K1 (a + b)
-- Usage
data Rec = Rec { flnum :: Float, intnum :: Int } deriving (Show, Generic)
t1 = Rec 1.0 2 `addR` Rec 3.0 4
【讨论】：
您可以为此使用gzipWithT。
我不是专家，所以我的版本有点傻。应该可以只调用一次gzipWithT，例如使用extQ 和extT，但我没能找到方法。无论如何，这是我的版本：
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Generics
data Test = Test {
test1 :: Int,
test2 :: Float,
test3 :: Int,
test4 :: String,
test5 :: String
}
deriving (Typeable, Data, Eq, Show)
t1 :: Test
t1 = Test 1 1.1 2 "t1" "t11"
t2 :: Test
t2 = Test 3 2.2 4 "t2" "t22"
merge :: Test -> Test -> Test
merge a b = let b' = gzipWithT mergeFloat a b
b'' = gzipWithT mergeInt a b'
in gzipWithT mergeString a b''
mergeInt :: (Data a, Data b) => a -> b -> b
mergeInt = mkQ (mkT (id :: Int -> Int)) (\a -> mkT (\b -> a + b :: Int))
mergeFloat :: (Data a, Data b) => a -> b -> b
mergeFloat = mkQ (mkT (id :: Float -> Float)) (\a -> mkT (\b -> a + b :: Float))
mergeString :: (Data a, Data b) => a -> b -> b
mergeString = mkQ (mkT (id :: String -> String)) (\a -> mkT (\b -> a ++ b :: String))
main :: IO ()
main = print $ merge t1 t2
输出：
Test {test1 = 4, test2 = 3.3000002, test3 = 6, test4 = "t1t2", test5 = "t11t22"}
代码晦涩难懂，但思路很简单，gzipWithT 将指定的泛型函数（mergeInt、mergeString 等）应用于对应的字段对。
【讨论】：
使用vinyl（“可扩展记录”包）：
import Data.Vinyl
-- `vinyl` exports `Rec`
type Nums = Rec Identity [Float, Int]
相当于
data Nums' = Nums' (Identity Float) (Identity Int)
它本身等价于
data Nums'' = Nums'' Float Int
那么addR就是简单
-- vinyl defines `recAdd`
addR :: Nums -> Nums -> Nums
addR = recAdd
如果你添加一个新字段
type Nums = Rec Identity [Float, Int, Word]
您无需触摸addR。
顺便说一句，recAdd 很容易定义你自己，如果你想“提升”你自己的自定义数字操作，它只是
-- the `RecAll f rs Num` constraint means "each field satisfies `Num`"
recAdd :: RecAll f rs Num => Rec f rs -> Rec f rs -> Rec f rs
recAdd RNil RNil = RNil
recAdd (a :& as) (b :& bs) = (a + b) :& recAdd as bs
为方便起见，您可以定义自己的构造函数：
nums :: Float -> Int -> Num
nums a b = Identity a :& Identity b :& RNil
甚至是用于构造和匹配值的模式：
-- with `-XPatternSynonyms`
pattern Nums :: Float -> Int -> Num
pattern Nums a b = Identity a :& Identity b :& RNil
用法：
main = do
let r1 = nums 1 2
let r2 = nums 3 4
print $ r1 `addR` r2
let (Nums a1 _) = r1
print $ a1
let r3 = i 5 :& i 6 :& i 7 :& z -- inferred
print $ r1 `addR` (rcast r3) -- drop the last field
由于r3 被推断为
(Num a, Num b, Num c) => Rec Identity [a, b, c]
您可以（安全地）将其上载到
rcast r3 :: (Num a, Num b) => Rec Identity [a, b]
然后你专攻它
rcast r3 :: Nums
https://hackage.haskell.org/package/vinyl-0.5.2/docs/Data-Vinyl-Class-Method.html#v:recAdd
https://hackage.haskell.org/package/vinyl-0.5.2/docs/Data-Vinyl-Tutorial-Overview.html
【讨论】：
我不认为有任何方法可以做到这一点，因为要从字段中获取值，您需要指定它们的名称，或者对其进行模式匹配 - 类似地设置字段，您指定它们的名称，或者使用常规的构造函数语法来设置它们——语法顺序很重要。
也许稍微简化一下就是使用常规的构造函数语法并为操作添加一个闭包
addR' :: Rec -> Rec -> Rec
addR' a b = Rec (doAdd flnum) (doAdd intnum)
where doAdd f = (f a) + (f b)
doAdd 的类型为 (Num a) => (Rec -> a) -> a。
此外，如果您计划对记录执行多个操作 - 例如，subR，它的作用几乎相同，但会减去 - 您可以使用 RankNTypes 将行为抽象为一个函数。
{-# LANGUAGE RankNTypes #-}
data Rec = Rec { flnum :: Float, intnum :: Int } deriving (Show)
opRecFields :: (forall a. (Num a) => a -> a -> a) -> Rec -> Rec -> Rec
opRecFields op a b = Rec (performOp flnum) (performOp intnum)
where performOp f = (f a) `op` (f b)
addR = opRecFields (+)
subR = opRecFields (-)
【讨论】：