Using a custom datatype in a Aeson record

Question

Preface: I'm still quite a Haskell noob so forgive me if I'm missing something obvious. I'm trying to write aeson ToJSON and FromJSON instances for a record datatype with a field with a non-standard datatype (email address).

{-# 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 "[email protected]")) 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 outputs these errors:

/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 }

How do I properly write these instances?

Answer 1

First add instance FromJSON UserLevel as you derive it from Generic. For parsing EmailAddress type I use the FromJSON instance implementation from here (remove type signature and replace <> by ++ )

for this you need add these imports as well

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

And the whole code related json parsing

-- * 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"
--}