在 Aeson 记录中使用自定义数据类型

Question

前言：我仍然是一个 Haskell 菜鸟，如果我遗漏了一些明显的东西，请原谅我。我正在尝试为具有非标准数据类型（电子邮件地址）的字段的记录数据类型编写 aeson ToJSON 和 FromJSON 实例。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}

module User where

import Control.Monad.Trans.Except
import Data.Aeson
import Data.ByteString.Char8 (pack)
import Data.Maybe
import GHC.Generics
import Servant
import Text.Email.Validate

type UserApi =
  "user" :> Get '[JSON] [User] :<|>
  "user" :> Capture "userId" Integer :> Get '[JSON] User

userServer :: Server UserApi
userServer =
  getUsers :<|>
  getUserById

getUsers :: Handler [User]
getUsers = return [exampleUser]

getUserById :: Integer -> Handler User
getUserById = \ case
  0 -> return exampleUser
  _ -> throwE err404

exampleUser :: User
exampleUser = User 0 "L. Smith" (fromJust (emailAddress "lsmith@example.com")) Base

-- * user info
data UserLevel = Base | Admin
  deriving (Eq, Show, Generic)

data User
  = User {
    userId :: Integer,
    userName :: String,
    userEmail :: EmailAddress,
    userLevel :: UserLevel
  }
  deriving (Eq, Show, Generic)

instance ToJSON User where
    toJSON (User userId userName userEmail userLevel) =
      object ["userId" .= userId, "userName" .= userName, "userEmail" .= show userEmail, "userLevel" .= show userLevel]

instance FromJSON User where
  parseJSON = withObject "user" $ \o -> do
    userId <- o .: "userId"
    userName <- o .: "userName"
    userEmail <- do s <- emailAddress (pack (o .: "age"))
                    case s of
                      Nothing -> fail "Invalid email address"
                      Just x -> return x
    userLevel <- o .: "userLevel"
    return User{..}

GHC 输出这些错误：

/home/gigavinyl/Projects/ordermage/src/components/User.hs:59:26: error:
    • Couldn't match type ‘Maybe’
                     with ‘aeson-0.11.2.1:Data.Aeson.Types.Internal.Parser’
      Expected type: aeson-0.11.2.1:Data.Aeson.Types.Internal.Parser
                       EmailAddress
        Actual type: Maybe EmailAddress
    • In a stmt of a 'do' block: s <- emailAddress (pack (o .: "age"))
      In a stmt of a 'do' block:
        userEmail <- do { s <- emailAddress (pack (o .: "age"));
                          case s of {
                            Nothing -> fail "Invalid email address"
                            Just x -> return x } }
      In the expression:
        do { userId <- o .: "userId";
             userName <- o .: "userName";
             userEmail <- do { s <- emailAddress (pack (o .: "age"));
                               case s of {
                                 Nothing -> ...
                                 Just x -> ... } };
             userLevel <- o .: "userLevel";
             .... }

/home/gigavinyl/Projects/ordermage/src/components/User.hs:59:46: error:
    • Couldn't match type ‘aeson-0.11.2.1:Data.Aeson.Types.Internal.Parser
                             a0’
                     with ‘[Char]’
      Expected type: String
        Actual type: aeson-0.11.2.1:Data.Aeson.Types.Internal.Parser a0
    • In the first argument of ‘pack’, namely ‘(o .: "age")’
      In the first argument of ‘emailAddress’, namely
        ‘(pack (o .: "age"))’
      In a stmt of a 'do' block: s <- emailAddress (pack (o .: "age"))

/home/gigavinyl/Projects/ordermage/src/components/User.hs:61:23: error:
    • Couldn't match expected type ‘EmailAddress’
                  with actual type ‘Maybe t0’
    • In the pattern: Nothing
      In a case alternative: Nothing -> fail "Invalid email address"
      In a stmt of a 'do' block:
        case s of {
          Nothing -> fail "Invalid email address"
          Just x -> return x }

/home/gigavinyl/Projects/ordermage/src/components/User.hs:62:23: error:
    • Couldn't match expected type ‘EmailAddress’
                  with actual type ‘Maybe EmailAddress’
    • In the pattern: Just x
      In a case alternative: Just x -> return x
      In a stmt of a 'do' block:
        case s of {
          Nothing -> fail "Invalid email address"
          Just x -> return x }

如何正确编写这些实例？

Answer 1

首先添加 instance FromJSON UserLevel，因为它是从 Generic 派生的。为了解析 EmailAddress 类型，我使用 here 中的 FromJSON 实例实现（删除类型签名并将 <> 替换为 ++ ）

为此你还需要添加这些导入

import Data.Aeson.Types (Parser)
import Data.Text.Encoding (encodeUtf8)

和整个代码相关json解析

-- * user info
data UserLevel = Base | Admin
  deriving (Eq, Show, Generic)
instance FromJSON UserLevel

data User
  = User {
    userId :: Integer,
    userName :: String,
    userEmail :: EmailAddress,
    userLevel :: UserLevel
  }
  deriving (Eq, Show, Generic)

instance ToJSON User where
    toJSON (User userId userName userEmail userLevel) =
      object ["userId" .= userId, "userName" .= userName, "userEmail" .= show userEmail, "userLevel" .= show userLevel]


instance FromJSON EmailAddress where
    parseJSON = withText "EmailAddress" $ \t ->
                    case validate $ encodeUtf8 t of
                        Left err -> fail $ "Failed to parse email address: $
                        Right email -> return email

instance FromJSON User where
  parseJSON = withObject "user" $ \o -> do
    userId    <- o .: "userId"
    userName  <- o .: "userName"
    userEmail <- o .: "userEmail"  
    userLevel <- o .: "userLevel"
    return User{..}

{-- My prefer syntax for json parsing
instance FromJSON User where
  parseJSON (Object o) =  
   User <$>
    o .: "userId"    <*>
    o .: "userName"  <*>
    o .: "userEmail" <*>
    o .: "userLevel"
--}

在 Aeson 记录中使用自定义数据类型

Using a custom datatype in a Aeson record

haskell

aeson

servant