Serialization of a basic sum type in Json with Aeson

user_1298865 0
Viewed 562
type GoalDescription = Text

data GoalStatus = Created | Accomplished | InProgress | GivenUp deriving (Show , Eq , Generic )

data Goal = Goal {workspaceId ::WorkspaceId , goalId :: GoalId , description :: GoalDescription , status :: GoalStatus} deriving (Show , Eq , Generic )

instance ToJSON Goal where
  toJSON (Goal {workspaceId, goalId ,description,status } ) = object [
            "workspaceId" .= workspaceId,
            "goalId" .= goalId,
            "description" .= description,
            "status" .= status]

instance FromJSON Goal  where

    parseJSON (Object jsonObject) = Goal <$> jsonObject .: "workspaceId" <*>  jsonObject .: "goalId" <*>  jsonObject .: "description" <*>  jsonObject .: "status"
    parseJSON _ =  error $ "Json format not expected"

I want to implement the FromJSON and ToJSON of GoalStatus that way: Goal {.. status:"accomplished"} or Goal {.. status:"inProgress"} etc... somehow I don't know how to implement these type classes without having a key -> value structure... GoalStatus should be only converted into a String Text without Keys attached to the value..

I have this temporary solution where I had to add an unnecessary key named "value" :

instance ToJSON GoalStatus where
    toJSON (Created) = object ["value" .= String "created"]
    toJSON (InProgress) = object ["value" .= String "inProgress"]
    toJSON (Accomplished) = object ["value" .= String "accomplished"]
    toJSON (GivenUp) = object ["value" .= String "GivenUp"]


instance FromJSON GoalStatus  where

  parseJSON (Object o) = do
     value <- o .: "value"
     case value of
          String status | (unpack status) == "created" -> return Created
          String status | (unpack status) == "inProgress" -> return InProgress
          String status | (unpack status) == "accomplished" -> return Accomplished
          String status | (unpack status) == "accomplished" -> return GivenUp
          _ -> error $ "Json format not expected"
  parseJSON _ =  error $ "Json format not expected"
aeson haskell
2 Answers

String !Text is a constructor of Value and object has the type signature [Pair] -> Value where Pair is (Text, Value). You can use String to make the Value in ToJSON and then match on the particular shapes of the String when parsing in FromJSON.

instance ToJSON GoalStatus where
  toJSON (Created) = String "created"
  toJSON (InProgress) = String "inProgress"
  toJSON (Accomplished) = String "accomplished"
  toJSON (GivenUp) = String "givenUp"

instance FromJSON GoalStatus  where
  parseJSON (String s) = case unpack s of
    "created" -> return Created
    "inProgress" -> return InProgress
    "accomplished" -> return Accomplished
    "givenUp" -> return GivenUp
    _ -> error $ "Json format not expected"
  parseJSON _ =  error $ "Json format not expected"
user_4124170

I'm not sure that I understand the question. Here's a full file with generic-derived implementations:

{-# LANGUAGE DeriveGeneric #-}
module Q54178405 where

import Data.Text
import Data.Aeson
import GHC.Generics

type WorkspaceId = Int
type GoalId = Int
type GoalDescription = Text

data GoalStatus =
  Created | Accomplished | InProgress | GivenUp deriving (Show, Eq, Generic)

instance ToJSON GoalStatus
instance FromJSON GoalStatus

data Goal = Goal {
    workspaceId ::WorkspaceId
  , goalId :: GoalId
  , description :: GoalDescription
  , status :: GoalStatus}
  deriving (Show, Eq, Generic)

instance ToJSON Goal
instance FromJSON Goal

Here's how it behaves in GHCi:

*Q54178405 Q54178405> encode $ Goal 42 1337 "foo" Accomplished
"{\"status\":\"Accomplished\",\"goalId\":1337,\"workspaceId\":42,\"description\":\"foo\"}"
*Q54178405 Q54178405> encode $ Goal 42 1337 "foo" GivenUp
"{\"status\":\"GivenUp\",\"goalId\":1337,\"workspaceId\":42,\"description\":\"foo\"}"

Isn't that what you want?

The instances round-trip as well:

*Q54178405 Q54178405> decode $ encode $ Goal 42 1337 "foo" GivenUp :: Maybe Goal
Just (Goal {workspaceId = 42, goalId = 1337, description = "foo", status = GivenUp})

If this isn't what you want, it'd be useful with some explicit examples of input with desired output.

user_1260140
Related