为Haskell数据类型添加可能性（使用记录语法）

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字段都可以为空？ 具体来说，我在状态字段之前看到了一个Maybe，但我想象的是一个更大的数据结构，将所有字段修改为Maybe字段会很繁琐。 例如，虽然我/可以/重写上面的内容如下：

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

为了避免对记录类型进行侵入式更改，我们可以通过分析其结构来处理从记录类型派生的另一种类型，这需要相对高级的泛型和类型级编程。 这个答案使用了generics-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-ary乘积 ，每个包含在仿函数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-ary产品NP ，使用generics-sop提供的丰富功能集来操作它。

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

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传递。