Haskell中的DRYer通用类型

Question

假如我有以下类型。

newtype AddressID = {unAddressId :: UUID } deriving (Generic, Show, Eq)
newtype PersonID = {unPersonId :: UUID } deriving (Generic, Show, Eq)
data Address = { addressId :: AddressID} deriving (Generic, Show, Eq)
data Person  = { personId :: PersonID } deriving (Generic, Show, Eq)
data AddressDto = AddressDto { addressDtoId :: !UUID } deriving (Generic, Show, Eq)

data PersonDto = PersonDto { personDtoId :: !UUID } deriving (Generic, Show, Eq)

type AddressListDto = HashMap UUID AddressDto

type PersonListDto = HashMap UUID PersonDto

instance FromJSON PersonDto where
  parseJSON = genericParseJSON $ apiOptions "personDto"

instance ToJSON PersonDto where
  toJSON     = genericToJSON $ apiOptions "personDto"
  toEncoding = genericToEncoding $ apiOptions "personDto"

instance FromJSON AddressDto where
  parseJSON = genericParseJSON $ apiOptions "addressDto"

instance ToJSON AddressDto where
  toJSON     = genericToJSON $ apiOptions "addressDto"
  toEncoding = genericToEncoding $ apiOptions "addressDto"

有以下的实用函数。

fromAddress :: Address -> AddressDto
fromAddress Address{..} = AddressDto {addresDtoId = unAddressId addressId}

fromPerson :: Person -> PersonDto
fromAddress Person{..} = PersonDto {personDtoId = unPersonId personId}

appendPerson :: PersonListDto -> Person -> PersonListDto
appendPerson pld per = insert (personDtoId $ fromPerson per) (fromPolicy per) pld


fromPersonList :: [Person] -> PersonListDto
fromPersonList = foldl appendPerson empty


appendAddress :: AddressListDto -> Address -> AddressListDto
appendAddress ald addr = insert (addressDtoId $ fromAddress addr) (fromAddress addr) ald


fromAddressList :: [Address] -> AddressListDto
fromAddressList = foldl appendAddress empty

这段代码工作得很好，但是它非常重复，并且随着内部类型的数量增加而膨胀。这些函数是相同的，但却在不同的对象上操作，关于帮助函数的命名约定是唯一能将不同实现分开的东西。

Haskell 的方法是什么，可以跨这些类型创建更多的通用可重用的帮助函数？我如何去创建一个 fromEntity, fromDto, appendEntityToDtoList 和 fromEntityList 函数？有没有一种方法可以让我不重复地对ToFromJSON实例进行编码（几乎相同）？Typeclasses在这里合适吗？有没有一些好的材料来介绍如何将它们用于这个目的？

Answer 1

对于JSON实例，是的，你绝对可以减少模板，但要付出一些设置的代价。最大的技巧是一个比较新的GHC功能。DerivingVia. 这让你可以用另一个类型的实例来解释如何为一个类型创建实例。

{-# language DeriveGeneric, DerivingVia, StandaloneDeriving
 , TypeFamilies, UndecidableInstances, ScopedTypeVariables
 , PolyKinds, TypeApplications #-}

-- A newtype wrapper for the type we want an instance for
newtype Optionish a = Optionish a

-- A FromJSON instance for Optionish
instance
  ( Generic a
  , Rep a ~ M1 i c f
  , Datatype c
  , GFromJSON Zero f
  )
  => FromJSON (Optionish a) where
  parseJSON v = Optionish <$> genericParseJSON (apiOptions (lower name)) v
    where
      name = datatypeName (Proxy3 @c)

data Proxy3 d f a = Proxy3

lower :: String -> String
lower "" = ""
lower (x:xs) = toLower x : xs

我们可以这样使用。

deriving via Optionish PersonDto
  instance FromJSON PersonDto

你可以为以下类型做同样的事情 ToJSON.