在Aeson記錄中使用自定義數據類型

Question

前言：我還是一個Haskell noob，所以如果我遺漏了一些明顯的東西，請原諒我。我正在嘗試爲具有非標準數據類型（電子郵件地址）字段的記錄數據類型編寫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" 
--}