Haskell динамически устанавливает поле записи на основе строки имени поля?

Скажем, у меня есть следующая запись:

data Rec = Rec {
   field1 :: Int,
   field2 :: Int
}

Как написать функцию:

changeField :: Rec -> String -> Int -> Rec
changeField rec fieldName value

чтобы я мог передать строки "field1" или "field2" в аргумент fieldName и обновить ли он соответствующее поле? Я понимаю, что Data.Data и Data.Typeable - это то, что нужно использовать здесь, но я не могу определить эти два пакета.

Пример библиотеки, которую я видел, это cmdArgs. Ниже приведена выдержка из публикации в блоге о том, как использовать эту библиотеку:

{-# LANGUAGE DeriveDataTypeable #-}
import System.Console.CmdArgs

data Guess = Guess {min :: Int, max :: Int, limit :: Maybe Int} deriving (Data,Typeable,Show)

main = do
    x <- cmdArgs $ Guess 1 100 Nothing
    print x

Теперь у нас есть простой синтаксический анализатор командной строки. Некоторые примеры взаимодействия:

$ guess --min=10
NumberGuess {min = 10, max = 100, limit = Nothing}

Ответ 1

ОК, здесь решение, которое не использует шаблон haskell, или требует, чтобы вы вручную управляли картой поля.

Я реализовал более общий modifyField, который принимает функцию мутатора и реализовал setField (nee changeField), используя его с const value.

Подпись modifyField и setField является общей как для типа записи, так и для мутатора/значения; однако, чтобы избежать двусмысленности Num, числовые константы в примере вызова должны иметь явные подписи :: Int.

Я также изменил порядок параметров, так что rec приходит последним, позволяя создать цепочку из modifyField/setField с помощью обычной композиции функций (см. последний пример вызова).

modifyField построен поверх примитива gmapTi, который является "отсутствующей" функцией из Data.Data. Это крест между gmapT и gmapQi.

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}

import Data.Typeable (Typeable, typeOf)
import Data.Data (Data, gfoldl, gmapQi, ConstrRep(AlgConstr),
                  toConstr, constrRep, constrFields)
import Data.Generics (extT, extQ)
import Data.List (elemIndex)
import Control.Arrow ((&&&))

data Rec = Rec {
    field1 :: Int,
    field2 :: String
} deriving(Show, Data, Typeable)

main = do
  let r = Rec { field1 = 1, field2 = "hello" }
  print r
  let r' = setField "field1" (10 :: Int) r
  print r'
  let r'' = setField "field2" "world" r'
  print r''
  print . modifyField "field1" (succ :: Int -> Int) . setField "field2" "there" $ r
  print (getField "field2" r' :: String)

---------------------------------------------------------------------------------------

data Ti a = Ti Int a

gmapTi :: Data a => Int -> (forall b. Data b => b -> b) -> a -> a
gmapTi i f x = case gfoldl k z x of { Ti _ a -> a }
  where
    k :: Data d => Ti (d->b) -> d -> Ti b
    k (Ti i' c) a = Ti (i'+1) (if i==i' then c (f a) else c a)
    z :: g -> Ti g
    z = Ti 0

---------------------------------------------------------------------------------------

fieldNames :: (Data r) => r -> [String]
fieldNames rec =
  case (constrRep &&& constrFields) $ toConstr rec of
    (AlgConstr _, fs) | not $ null fs -> fs
    otherwise                         -> error "Not a record type"

fieldIndex :: (Data r) => String -> r -> Int
fieldIndex fieldName rec =
  case fieldName `elemIndex` fieldNames rec of
    Just i  -> i
    Nothing -> error $ "No such field: " ++ fieldName

modifyField :: (Data r, Typeable v) => String -> (v -> v) -> r -> r
modifyField fieldName m rec = gmapTi i (e `extT` m) rec
  where
    i = fieldName `fieldIndex` rec
    e x = error $ "Type mismatch: " ++ fieldName ++
                             " :: " ++ (show . typeOf $ x) ++
                           ", not " ++ (show . typeOf $ m undefined)

setField :: (Data r, Typeable v) => String -> v -> r -> r
setField fieldName value = modifyField fieldName (const value)

getField :: (Data r, Typeable v) => String -> r -> v
getField fieldName rec = gmapQi i (e `extQ` id) rec
  where
    i = fieldName `fieldIndex` rec
    e x = error $ "Type mismatch: " ++ fieldName ++
                             " :: " ++ (show . typeOf $ x) ++
                           ", not " ++ (show . typeOf $ e undefined)

Ответ 2

Вы можете построить карту с именами полей на свои линзы:

{-# LANGUAGE TemplateHaskell #-}
import Data.Lens
import Data.Lens.Template
import qualified Data.Map as Map

data Rec = Rec {
    _field1 :: Int,
    _field2 :: Int
} deriving(Show)

$( makeLens ''Rec )

recMap = Map.fromList [ ("field1", field1)
                      , ("field2", field2)
                      ]

changeField :: Rec -> String -> Int -> Rec
changeField rec fieldName value = set rec
    where set = (recMap Map.! fieldName) ^= value

main = do
  let r = Rec { _field1 = 1, _field2 = 2 }
  print r
  let r' = changeField r "field1" 10
  let r'' = changeField r' "field2" 20
  print r''

или без объективов:

import qualified Data.Map as Map

data Rec = Rec {
    field1 :: Int,
    field2 :: Int
} deriving(Show)

recMap = Map.fromList [ ("field1", \r v -> r { field1 = v })
                      , ("field2", \r v -> r { field2 = v })
                      ]

changeField :: Rec -> String -> Int -> Rec
changeField rec fieldName value =
    (recMap Map.! fieldName) rec value

main = do
  let r = Rec { field1 = 1, field2 = 2 }
  print r
  let r' = changeField r "field1" 10
  let r'' = changeField r' "field2" 20
  print r''