向Haskell数据类型添加maybeness(使用记录语法)

Question

看看这个问题的答案：

https://stackoverflow.com/a/34164251/1052117

我看到它定义了一个用于解析JSON对象的数据类型。

data Address = Address
{ house  :: Integer
, street :: String
, city   :: String
, state  :: Maybe String
, zip    :: String -- here I change the original, zip codes are strings, they have leading zeros.
} deriving (Show, Eq)
$(deriveJSON defaultOptions ''Address)

这很有帮助，但我想知道：如何更改Address数据类型，使所有json字段都可以为null？具体来说，我在状态字段之前看到了一个"也许"，但我想象的是一个更大的数据结构，将所有字段修改为"也许"字段会很乏味。例如，当我/可以/将上面的内容重写为：

data Address = Address
{ house  :: Maybe Integer
, street :: Maybe String
, city   :: Maybe String
, state  :: Maybe String
, zip    :: Maybe String
} deriving (Show, Eq)

在不重写所有代码和手动插入Maybes的情况下，我可以将什么函数应用于代码中的地址数据类型以实现相同的结果？

Answer 1

正如评论中所讨论的，使用函子函子只需对原始数据类型进行很小的更改即可实现此目的。

如果你从开始

data Address = Address
{ house  :: Integer
, street :: String
, city   :: String
, state  :: Maybe String
, zip    :: String
} deriving (Show, Eq)

那么它就相当于

import Data.Functor.Identity
data AddressF f = Address
{ house  :: f Integer 
, street :: f String
, city   :: f String
, state  :: Maybe String
, zip    :: f String 
} deriving (Show, Eq)
type Address = AddressF Identity

然后你可以通过写得到第二个

type Address' = AddressF Maybe

为了回到最初的定义，你可以写

toOriginal (AddressF (Identity house) (Identity street) (Identity city) mbState (Identity zip)) = Address house street city mbState zip

Answer 2

在不重写所有代码和手动的情况下实现相同的结果插入Maybes

为了避免对记录类型进行侵入性更改，我们可以通过分析其结构来处理另一个从记录派生的类型，这需要相对高级的泛型和类型级编程。这个答案使用泛型sop包。

一些必需的杂注和导入：

{-# LANGUAGE DataKinds, TypeFamilies, FlexibleInstances, UndecidableInstances, 
ScopedTypeVariables, TypeApplications, TypeOperators, 
DeriveGeneric, StandaloneDeriving, MultiParamTypeClasses,
FunctionalDependencies, AllowAmbiguousTypes, FlexibleContexts #-}
import           Data.Kind (Type)
import           Data.Type.Equality (type (==))
import           GHC.TypeLits
import qualified GHC.Generics as GHC
import           Generics.SOP -- from package "generics-sop"
import qualified Generics.SOP.Type.Metadata as M

这个newtype表示从记录派生的字段值的n元乘积，每个值都封装在函子f中。字段名称的类型级别列表ns保留为幻影类型变量：

newtype Wrapped f (ns :: [Symbol]) (xs :: [Type]) = Wrapped { unwrap :: NP f xs }
deriving instance All (Generics.SOP.Compose Show f) xs => Show (Wrapped f ns xs)
type family FieldNamesOf (a :: M.DatatypeInfo) :: [Symbol] where
FieldNamesOf ('M.ADT moduleName datatypeName '[ 'M.Record constructorName fields ]) = 
ExtractFieldNames fields
type family ExtractFieldNames (a :: [M.FieldInfo]) :: [Symbol] where
ExtractFieldNames '[] = '[]
ExtractFieldNames (('M.FieldInfo n) ': xs) = n ': ExtractFieldNames xs
fromRecord :: forall r ns xs.  (IsProductType r xs, 
HasDatatypeInfo r, 
FieldNamesOf (DatatypeInfoOf r) ~ ns)
=> r 
-> Wrapped I ns xs 
fromRecord r = let (SOP (Z np)) = from r in Wrapped np
toRecord :: forall r ns xs.  (IsProductType r xs, 
HasDatatypeInfo r, 
FieldNamesOf (DatatypeInfoOf r) ~ ns)
=> Wrapped I ns xs 
-> r
toRecord (Wrapped np) = to (SOP (Z np))

如果我们不需要保留字段名，那么newtype就变得多余了，最好直接使用n元乘积NP，用泛型sop提供的一组丰富的函数来操作它。

但是，如果我们确实想保持按名称选择字段的能力，那么我们需要在newtype上定义一个函数，由一对typeclasses支持：

getWrappedField :: forall n f ns xs x. HasField ns n xs x => Wrapped f ns xs -> f x
getWrappedField (Wrapped np) = getHasField @ns @n np  
class HasField (ns :: [Symbol]) (n :: Symbol) 
(xs :: [Type])   (x :: Type)   | ns n xs -> x where 
getHasField :: NP f xs -> f x 
instance ((e == n) ~ flag, HasField' flag (e : ns) n xs x) => HasField (e : ns) n xs x where
getHasField = getHasField' @flag @(e : ns) @n
class HasField' (flag :: Bool) 
(ns :: [Symbol]) (n :: Symbol) 
(xs :: [Type]) (x :: Type)     | ns n xs -> x where 
getHasField' :: NP f xs -> f x 
instance HasField' True (n : ns) n (x : xs) x where
getHasField' (v :* _) = v
instance HasField ns n xs x => HasField' False (nz : ns) n (xz : xs) x where
getHasField' (_ :* rest) = getHasField @ns @n rest

给定这个派生出必要的支持类型类的示例记录：

data Person = Person { name :: String, age :: Int } deriving (Show, GHC.Generic)
instance Generic Person
instance HasDatatypeInfo Person

我们可以构造它的广义表示(其中所有域最初都包裹在恒等函子I中)，然后得到其中一个域，如下所示：

ghci> getWrappedField @"age" (fromRecord (Person "Jimmy" 25))
I 25

字段的名称使用类型应用程序作为类型级别Symbol传递。