使用 Aeson 时如何在 map 中使用 sum 类型作为键?

How to use a sum type as a key in map when using Aeson?

我想在 JSON 中编码一个简单的 "map":

{ "CS": "Ahoj"
, "EN": "Hello"
}

我的尝试:

{-# LANGUAGE TemplateHaskell, DeriveGeneric, DeriveAnyClass #-}

import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Text (Text)
import qualified Data.HashMap.Lazy as M
import GHC.Generics (Generic)
import Data.Hashable (Hashable)

data Language
  = CS
  | EN
  deriving (Eq, Show, Generic, Hashable)

deriveJSON defaultOptions ''Language

newtype TranslatedText =
  TranslatedText (M.HashMap Language Text)
  deriving (Eq, Show, Generic)

deriveJSON defaultOptions ''TranslatedText

我得到:

/xxx/src/Data.hs:80:1: error:
    • No instance for (FromJSONKey Language)
        arising from a use of ‘parseJSON’
    • In the second argument of ‘(<$>)’, namely ‘parseJSON arg_apgG’
      In the expression: (TranslatedText <$> parseJSON arg_apgG)
      In a case alternative:
          arg_apgG -> (TranslatedText <$> parseJSON arg_apgG)
   |
80 | deriveJSON defaultOptions ''TranslatedText
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/xxx/src/Data.hs:80:1: error:
    • No instance for (ToJSONKey Language)
        arising from a use of ‘toJSON’
    • In the expression: toJSON arg1_apfY
      In a case alternative: TranslatedText arg1_apfY -> toJSON arg1_apfY
      In the expression:
        case value_apdm of { TranslatedText arg1_apfY -> toJSON arg1_apfY }
   |
80 | deriveJSON defaultOptions ''TranslatedText
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/xxx/src/Data.hs:80:1: error:
    • No instance for (ToJSONKey Language)
        arising from a use of ‘toEncoding’
    • In the expression: toEncoding arg1_apgk
      In a case alternative:
          TranslatedText arg1_apgk -> toEncoding arg1_apgk
      In the expression:
        case value_apg9 of {
          TranslatedText arg1_apgk -> toEncoding arg1_apgk }
   |
80 | deriveJSON defaultOptions ''TranslatedText
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

我尝试使用 readMaybeshow 编写 FromJSONKeyToJSONKey 实例,但我不知道应该如何构建 Parser?或者有更好、更自动的方法吗?毕竟 sum 类型可以很容易地转换 from/to Text.

这是一个典型的实例,使用 ShowReadRead 的派生子句需要添加到 Language):

-- Additional imports
import qualified Data.Text as T
import Text.Read (readMaybe)

instance ToJSONKey Language where
  toJSONKey = toJSONKeyText (T.pack . show)

instance FromJSONKey Language where
  fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (T.unpack t) of
    Just k -> pure k
    Nothing -> fail ("Invalid key: " ++ show t)

应该有更短的方法,我已经提交了添加通用实现的提案:https://github.com/bos/aeson/issues/710