自动派生ToJSON(Map NewtypeOfText v)

Question

我有一个Map,其中键是一个新的Text类型.我想自动(尽可能)为此Map 派生ToJSON和FromJSON.埃宋已经为地图文字v实现的toJSON和FromJSON实例.

我的详细代码有效:

{-# 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.这是因为a的创建和操作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 ab => Coercible(T a)(T b).

该类Coercible用于在最近版本的GHC(7.8？)中进行类型安全强制.有关类型角色及其在类型安全中的作用的更多信息,请参见此处.该

如果您计划派生实例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)