Systematically applying a function to all fields o

问题:

I have a record with fields of different types, and a function that is applicable to all of those types. As a small (silly) example:

data Rec = Rec  { flnum :: Float, intnum :: Int } deriving (Show)

Say, I want to define a function that adds two records per-field:

addR :: Rec -> Rec -> Rec
addR a b = Rec { flnum = (flnum a) + (flnum b), intnum = (intnum a) + (intnum b) }

Is there a way to express this without repeating the operation for every field (there may be many fields in the record)?

In reality, I have a record comprised exclusively of Maybe fields, and I want to combine the actual data with a record containing default values for some of the fields, to be used when the actual data was Nothing.

(I guess it should be possible with template haskell, but I am more interested in a "portable" implementation.)

回答1:

You can use gzipWithT for that.

I'm not an expert, so my version it a bit silly. It should be possible to call gzipWithT only once, e.g. using extQ and extT, but I failed to find the way to do that. Anyway, here is my version:

{-# 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

Output:

Test {test1 = 4, test2 = 3.3000002, test3 = 6, test4 = "t1t2", test5 = "t11t22"}

The code is obscure, but the idea is simple, gzipWithT applies the specified generic function (mergeInt, mergeString, etc) to pair of corresponding fields.

回答2:

Yet another way is to use 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

回答3:

with vinyl (an "extensible records" package):

import Data.Vinyl
-- `vinyl` exports `Rec`

type Nums = Rec Identity [Float, Int]

which is equivalent to

data Nums' = Nums' (Identity Float) (Identity Int)

which is itself equivalent to

data Nums'' = Nums'' Float Int

then addR is simply

-- vinyl defines `recAdd`
addR :: Nums -> Nums -> Nums
addR = recAdd

and if you add a new field

type Nums = Rec Identity [Float, Int, Word]

you don't need to touch addR.

btw, recAdd is easy to define yourself, if you want to "lift" your own custom numeric operations, it's just

-- 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

For convenience, you can define your own constructor:

nums :: Float -> Int -> Num
nums a b = Identity a :& Identity b :& RNil

and even a pattern for both constructing and matching values:

-- with `-XPatternSynonyms`
pattern Nums :: Float -> Int -> Num
pattern Nums a b = Identity a :& Identity b :& RNil

usage:

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

Since r3 is inferred as

(Num a, Num b, Num c) => Rec Identity [a, b, c]

you can (safely) upcast it to

rcast r3 :: (Num a, Num b) => Rec Identity [a, b]

you then specialize it

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

回答4:

I don't think there's any way to do this, as to get the values from the fields, you need to specify their names, or pattern match on them - and similarly to set the fields, you specify their names, or use the regular constructor syntax to set them - where the syntax order matters.

Perhaps a slight simplification would be to use the regular constructor syntax and add a closure for the operation

addR' :: Rec -> Rec -> Rec
addR' a b = Rec (doAdd flnum) (doAdd intnum)
  where doAdd f = (f a) + (f b)

doAdd has the type (Num a) => (Rec -> a) -> a.

Additionally, if you plan on doing more than one operation on the record - for example, a subR, which does almost the same but subtracts - you can abstract away the behavior into a function by using 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 (-)