Aesonレコードのカスタムデータ型を使用する

Question

はじめに：私はまだかなりハスケルのノブですので、私が何か明白なものを見逃している場合は私を許してください。非標準のデータ型（電子メールアドレス）のフィールドを持つレコードデータ型の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

最初にGenericから派生したときにinstance FromJSON UserLevelを追加します。 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" 
--}