Question

我有一个Map，其中键是Text的新类型。我想自动（尽可能）为此地图导出ToJSON和FromJSON。 aeson已经有ToJSON和FromJSON的实例用于Map Text v。

我的详细代码有效：

{-# LANGUAGE DeriveGeneric    #-}

module Test where

import           ClassyPrelude

import           Data.Aeson                  
import           GHC.Generics                (Generic)

import qualified Data.Map                    as M

newtype MyText = MyText {unMyText::Text} deriving (Eq, Ord)

data Bar = Bar deriving (Generic)
instance ToJSON Bar
instance FromJSON Bar

data Foo = Foo (Map MyText Bar)

instance ToJSON Foo where
  toJSON (Foo x) = toJSON mp
    where mp = M.fromList . map (\(x,y) -> (unMyText x,y)) . M.toList $ x

instance FromJSON Foo where
  parseJSON v = convert <$> parseJSON v
    where convert :: Map Text Bar -> Foo
          convert =  Foo . mapFromList . map (\(x,y) -> (MyText x,y)) . mapToList

我可以做更多类似的事情吗？

data Foo = Foo (Map MyText Bar) deriving (Generic)

instance ToJSON Foo 
instance FromJSON Foo

修改

我尝试过（但仍然没有运气）：

newtype MyText = MyText {unMyText::Text} deriving (Eq, Ord, ToJSON, FromJSON)
instance ToJSON Foo where
  toJSON (Foo x) = toJSON x

和

newtype MyText = MyText {unMyText::Text} deriving (Eq, Ord, ToJSON, FromJSON)
instance ToJSON Foo

Answer 1

您无法自动派生此实例的事实是100％正确的行为。您所期望的不起作用的原因是无法知道实例FromJSON (Map Text v)可以用于Map MyText v类型的值。这是因为Map的创建和操作是以其密钥的Ord实例为基础的，并且（编译器）无法知道所有xy (x == y) == (MyText x == MyText y)，这是安全地强制Map Text v到Map MyText v所必需的。从技术上讲，Map的角色声明是：

type role Map nominal representational

基本上这表示Map k v仅对其第一个类型参数相同的其他地图具有可强制性。维基说：

我们有实例Coercible a b =＆gt;强制性（T a）（T b）当且仅当第一个参数具有代表性角色。

类Coercible用于在最近版本的GHC中进行类型安全强制（7.8？）有关类型角色及其在类型安全中的角色的更多信息，请参阅here。

如果您计划派生Ord MyText的实例，那么将Map Text v强制转换为Map MyText v确实是安全的，因为Ord实例是相同的。这需要使用unsafeCoerce。但是你仍然需要自己编写实例：

instance ToJSON v => ToJSON (Map MyText v) where
  toJSON = toJSON . (unsafeCoerce :: Map MyText v -> Map Text v)

instance FromJSON v => FromJSON (Map MyText v) where 
  parseJSON = (unsafeCoerce :: Parser (Map Text v) -> Parser (Map MyText v)) . parseJSON

如果您打算编写自己的Ord实例，则上述内容绝对不安全。您的解决方案是正确的，但效率不高。使用以下内容：

  toJSON = toJSON . M.mapKeys (coerce :: MyText -> Text)
  parseJSON = fmap (M.mapKeys (coerce :: Text -> MyText)) . parseJSON

根据您的Ord实例，您可以使用mapKeysMonotonic代替，这样会更有效率。有关何时可以使用Data.Map的详细信息，请参阅mapKeysMonotonic的文档。

然后，明显的事情将起作用：

data Bar = Bar deriving (Eq, Ord, Generic)
instance ToJSON Bar
instance FromJSON Bar

data Foo = Foo (Map MyText Bar) deriving (Generic)
instance ToJSON Foo 
instance FromJSON Foo

-- Using GeneralizedNewtypeDeriving
newtype Foo2 = Foo2 (Map MyText Bar) deriving (FromJSON, ToJSON)

完整代码：

{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, FlexibleInstances #-}

module Test where

import Data.Aeson                  
import GHC.Generics (Generic)
import qualified Data.Map as M
import Data.Map (Map)
import Data.Text (Text)
import GHC.Prim (coerce)
import Unsafe.Coerce (unsafeCoerce)
import Data.Aeson.Types (Parser)

newtype MyText = MyText {unMyText::Text} deriving (Eq, Ord, Generic, ToJSON, FromJSON)

instance ToJSON v => ToJSON (Map MyText v) where
  -- toJSON = toJSON . M.mapKeys (coerce :: MyText -> Text)
  toJSON = toJSON . (unsafeCoerce :: Map MyText v -> Map Text v)

instance FromJSON v => FromJSON (Map MyText v) where 
  -- parseJSON x = fmap (M.mapKeys (coerce :: Text -> MyText)) (parseJSON x)
  parseJSON x = (unsafeCoerce :: Parser (Map Text v) -> Parser (Map MyText v)) (parseJSON x)

data Bar = Bar deriving (Eq, Ord, Generic)
instance ToJSON Bar
instance FromJSON Bar

data Foo = Foo (Map MyText Bar) deriving (Generic)
instance ToJSON Foo 
instance FromJSON Foo

newtype Foo2 = Foo2 (Map MyText Bar) deriving (FromJSON, ToJSON)

自动派生ToJSON（Map NewtypeOfText v）

修改

1 个答案: