Сериализация базового типа суммы в Джсоне с Эзоном - PullRequest
0 голосов
/ 14 января 2019
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"

Я хочу реализовать FromJSON и ToJSON GoalStatus следующим образом: Goal {.. status:"accomplished"} или Goal {.. status:"inProgress"} и т. Д. ... как-то не знаю, как реализовать эти классы типов без структуры ключ -> значение ... GoalStatus следует конвертировать только в String Text без ключей, прикрепленных к значению.

У меня есть временное решение, в котором мне пришлось добавить ненужный ключ с именем "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"

Ответы [ 2 ]

0 голосов
/ 14 января 2019

Я не уверен, что понимаю вопрос. Вот полный файл со стандартными реализациями:

{-# 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

Вот как он ведет себя в 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\"}"

Разве это не то, что вы хотите?

В обоих случаях также туда и обратно:

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

Если это не то, что вы хотите, было бы полезно с некоторыми явными примерами ввода с желаемым выводом.

0 голосов
/ 14 января 2019

String !Text является конструктором Value, а object имеет сигнатуру типа [Pair] -> Value, где Pair равно (Text, Value). Вы можете использовать String, чтобы сделать Value в ToJSON, а затем сопоставить конкретные формы String при разборе в 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"
...