在使用Aeson时，如何使用sum类型作为map中的键？

Question

我想用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
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

我尝试过使用readMaybe和show编写FromJSONKey和ToJSONKey实例，但我不知道应该如何构造Parser？还是有更好的，更自动化的方法？毕竟，可以很容易地将sum类型从/转换为Text。

Answer 1

下面是一个典型的实例，使用Show和Read (需要在Language中添加一个用于Read的派生子句)：

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