在JSON示例中使用TypeClass形成真实世界的Haskell

我发现主要是困惑，似乎它也在刺痛我

在中，直到TypeClass开始工作之前：使JSON更易于使用，我觉得一切都很清楚；然后，本书展示了JSON文件的一部分，以及一个Haskell源代码，它定义了一个变量

result

holding（大部分）JSON示例

然后，参考前面的代码块，它区分了JSON对象（可以包含不同类型的元素）和Haskell列表（不能包含不同类型的元素）。这证明在上述代码中使用

JValue

的构造函数（

JNumber

，

JBool

，…）是合理的

到目前为止还不错。然后我开始感到困惑

这限制了我们的灵活性：如果我们想将数字

3920

更改为字符串

“3920”

，我们必须将用于包装它的构造函数从

JNumber

更改为

JString

是啊，那又怎样？如果我打算做这个改变，我将不得不改变，例如，这一行

("esitmatedCount", JNumber 3920)

对此

("esitmatedCount", JString "3,920")

这对应于将实际JSON文件中的

3920

更改为

“3920”

。那又怎么样？如果我有机会在Haskell列表中添加不同的类型，我仍然需要将数字用双引号括起来并添加逗号

我不明白失去灵活性的原因。

然后，一个诱人的解决方案被提出（诱人？比它没有好处…缺点在哪里？在线书中的一些评论提出了同样的问题。）

现在，我们将

toJValue

函数应用于值，而不是像

JNumber

这样的构造函数来包装它。如果我们更改一个值的类型，编译器将选择一个合适的

toJValue

实现来使用它

这让我觉得，我的意图是使用构造函数的

toJValue

函数，而不是

JNumber

，但我不知道

toJValue 3920

如何工作

我应该如何使用上述代码？更新：我在末尾的一节中为您的后续评论添加了答案

我认为作者在编写类型类一章时，希望与前一章中的示例保持连续性。他们可能还记得他们在Haskell中使用类型类处理JSON时编写的一些真实代码。（我看到RWH的作者之一Bryan O'Sullivan也是优秀的

aeson

JSON解析库的作者，该库非常有效地使用了类型类。）我认为他们也有点沮丧，因为他们对类型类需求的最佳示例（

BasicEq

）是已经实现的东西，这迫使读者假装语言设计人员在语言中留下了一个关键特性，以便看到对类型类的需求。他们还意识到JSON示例非常丰富和复杂，足以让他们引入一些困难的新概念（类型同义词和重叠实例、开放世界假设、新类型包装器等）

因此，他们试图将JSON示例添加为一个现实的、相当复杂的示例，该示例与早期材料相关，可以用于教学目的，以介绍一系列新材料

不幸的是，他们意识到这个例子的动机很弱，至少在没有引入一系列先进的新概念和技术的情况下，这有点太晚了。因此，他们咕哝着“缺乏灵活性”，不管怎样，还是继续前进，让这个例子在最后逐渐消失，从来没有真正回到人们如何使用

toJValue

或

fromJValue

做任何事情

下面演示了为什么

JSON

类是有用的，这是由

aeson

包驱动的。请注意，它使用了RWH前五章中未涉及的几个更高级的功能，因此您可能还无法完全理解

所以我们在同一页上，假设我们有下面的代码，一个稍微简化的类型类版本和第6章中的实例。下面的代码需要一些额外的语言扩展

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes, RecordWildCards #-}

module JSONClass where

data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject [(String, JValue)]
            | JArray [JValue]
  deriving (Show)

class JSON a where
  toJValue :: a -> JValue
  fromJValue :: JValue -> Maybe a
instance JSON Bool where
  toJValue = JBool
  fromJValue (JBool b) = Just b
  fromJValue _ = Nothing
instance {-# OVERLAPPING #-} JSON String where
  toJValue = JString
  fromJValue (JString s) = Just s
  fromJValue _ = Nothing
instance JSON Double where
  toJValue = JNumber
  fromJValue (JNumber x) = Just x
  fromJValue _ = Nothing
instance {-# OVERLAPPABLE #-} (JSON a) => JSON [a] where
  toJValue = JArray . map toJValue
  fromJValue (JArray vals) = mapM fromJValue vals
  fromJValue _ = Nothing

还假设我们有一些代表搜索结果的Haskell数据类型，以“Typeclasses at work”一节中给出的

结果

示例为模式：

将这些转换为JSON会很好。使用

RecordWildCards

扩展将参数字段“放大”为单独的变量，我们可以非常清晰地编写：

resultToJValue :: Result -> JValue
resultToJValue Result{..}
  = JObject [("title", JString title), ("snippet", JString snippet), ("url", JString url)]
searchToJValue :: Search -> JValue
searchToJValue Search{..}
  = JObject [("query", JString query),
             ("estimatedCount", JNumber estimatedCount),
             ("moreResults", JBool moreResults),
             ("results", JArray $ map resultToJValue results)]

它的构造函数有点杂乱。我们可以通过将一些构造函数替换为

toJValue

来“简化”这一点，这将为我们提供：

resultToJValue :: Result -> JValue
resultToJValue Result{..}
  = JObject [("title", toJValue title), ("snippet", toJValue snippet),
                 ("url", toJValue url)]
searchToJValue :: Search -> JValue
searchToJValue Search{..}
  = JObject [("query", toJValue query),
             ("estimatedCount", toJValue estimatedCount),
             ("moreResults", toJValue moreResults),
             ("results", JArray $ map resultToJValue results)]

你可以很容易地争辩说，这真的同样杂乱无章。但是，type类允许我们定义一个helper函数：

(.=) :: (JSON a) => String -> a -> (String, JValue)
infix 0 .=
k .= v = (k, toJValue v)

这引入了一个漂亮、干净的语法：

resultToJValue :: Result -> JValue
resultToJValue Result{..}
  = JObject [ "title" .= title
            , "snippet" .= snippet
            , "url" .= url ]
searchToJValue :: Search -> JValue
searchToJValue Search{..}
  = JObject [ "query" .= query
            , "estimatedCount" .= estimatedCount
            , "moreResults" .= moreResults
            , ("results", JArray $ map resultToJValue results)]

最后一行看起来难看的唯一原因是我们没有给出

Result

它的

JSON

实例：

instance JSON Result where
  toJValue = resultToJValue

这样我们就可以写：

searchToJValue :: Search -> JValue
searchToJValue Search{..}
  = JObject [ "query" .= query
            , "estimatedCount" .= estimatedCount
            , "moreResults" .= moreResults
            , "results" .= results ]

事实上，我们根本不需要函数

resultToJValue

和

searchToJValue

，因为它们的定义可以直接在实例中给出。因此，在定义了

搜索

和

结果

数据类型之后，上面的所有代码都可以折叠为：

(.=) :: (JSON a) => String -> a -> (String, JValue)
infix 0 .=
k .= v = (k, toJValue v)

instance JSON Result where
  toJValue Result{..}
    = JObject [ "title" .= title
              , "snippet" .= snippet
              , "url" .= url ]
instance JSON Search where
  toJValue Search{..}
    = JObject [ "query" .= query
              , "estimatedCount" .= estimatedCount
              , "moreResults" .= moreResults
              , "results" .= results ]

为以下方面提供支持：

search = Search "awkward squad haskell" 3920 True
           [ Result "Simon Peyton Jones: papers"
                    "Tackling the awkward squad..."
                    "http://..."
           ]

main = print (toJValue search)

如何将JSON

JValue

转换回

Result

和

Search

？您可能希望尝试在不使用类型类的情况下编写此代码，并查看它的外观。类型类的解决方案使用了一个令人费解的辅助函数（需要

RankNTypes

语言扩展）：

如果没有类型类，这种对d的统一处理

(.=) :: (JSON a) => String -> a -> (String, JValue)
infix 0 .=
k .= v = (k, toJValue v)

instance JSON Result where
  toJValue Result{..}
    = JObject [ "title" .= title
              , "snippet" .= snippet
              , "url" .= url ]
instance JSON Search where
  toJValue Search{..}
    = JObject [ "query" .= query
              , "estimatedCount" .= estimatedCount
              , "moreResults" .= moreResults
              , "results" .= results ]

search = Search "awkward squad haskell" 3920 True
           [ Result "Simon Peyton Jones: papers"
                    "Tackling the awkward squad..."
                    "http://..."
           ]

main = print (toJValue search)

withObj :: (JSON a) => JValue ->
           ((forall v. JSON v => String -> Maybe v) -> Maybe a) -> Maybe a
withObj (JObject lst) template = template v
  where v k = fromJValue =<< lookup k lst

instance JSON Result where
  fromJValue o = withObj o $ \v -> Result <$> v "title" <*> v "snippet" <*> v "url"
instance JSON Search where
  fromJValue o = withObj o $ \v -> Search <$> v "query" <*> v "estimatedCount"
    <*> v "moreResults" <*> v "results"

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes, RecordWildCards #-}

module JSONClass where

-- JSON type
data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject [(String, JValue)]
            | JArray [JValue]
  deriving (Show)

-- Type classes and instances
class JSON a where
  toJValue :: a -> JValue
  fromJValue :: JValue -> Maybe a
instance JSON Bool where
  toJValue = JBool
  fromJValue (JBool b) = Just b
  fromJValue _ = Nothing
instance {-# OVERLAPPING #-} JSON String where
  toJValue = JString
  fromJValue (JString s) = Just s
  fromJValue _ = Nothing
instance JSON Double where
  toJValue = JNumber
  fromJValue (JNumber x) = Just x
  fromJValue _ = Nothing
instance {-# OVERLAPPABLE #-} (JSON a) => JSON [a] where
  toJValue = JArray . map toJValue
  fromJValue (JArray vals) = mapM fromJValue vals
  fromJValue _ = Nothing

-- helpers
(.=) :: (JSON a) => String -> a -> (String, JValue)
infix 0 .=
k .= v = (k, toJValue v)
withObj :: (JSON a) => JValue ->
           ((forall v. JSON v => String -> Maybe v) -> Maybe a) -> Maybe a
withObj (JObject lst) template = template v
  where v k = fromJValue =<< lookup k lst

-- our new data types
data Search = Search
  { query :: String
  , estimatedCount :: Double
  , moreResults :: Bool
  , results :: [Result]
  } deriving (Show)
data Result = Result
  { title :: String
  , snippet :: String
  , url :: String
  } deriving (Show)

-- JSON instances to marshall them in and out of JValues
instance JSON Result where
  toJValue Result{..}
    = JObject [ "title" .= title
              , "snippet" .= snippet
              , "url" .= url ]
  fromJValue o = withObj o $ \v -> Result <$> v "title" <*> v "snippet" <*> v "url"
instance JSON Search where
  toJValue Search{..}
    = JObject [ "query" .= query
              , "estimatedCount" .= estimatedCount
              , "moreResults" .= moreResults
              , "results" .= results ]
  fromJValue o = withObj o $ \v -> Search <$> v "query" <*> v "estimatedCount"
    <*> v "moreResults" <*> v "results"

-- a test
search :: Search
search = Search "awkward squad haskell" 3920 True
           [ Result "Simon Peyton Jones: papers"
                    "Tackling the awkward squad..."
                    "http://..."
           ]
main :: IO ()
main = do
  let jsonSearch = toJValue search
  print jsonSearch
  let search' = fromJValue jsonSearch :: Maybe Search
  print search'

-- from book
class JSON a where
    toJValue :: a -> JValue
    fromJValue :: JValue -> Either JSONError a
-- mine
class JSON a where
  toJValue :: a -> JValue
  fromJValue :: JValue -> Maybe a

-- from book
instance JSON Bool where
    toJValue = JBool
    fromJValue (JBool b) = Right b
    fromJValue _ = Left "not a JSON boolean"
-- mine
instance JSON Bool where
  toJValue = JBool
  fromJValue (JBool b) = Just b
  fromJValue _ = Nothing

instance JSON JValue where
    toJValue = id
    fromJValue = Right

instance JSON JValue where
    toJValue = id
    fromJValue = Just  -- use Just instead of Right; we never return Nothing

JArray [JNumber 1.0, JNumber 2.0, JNumber 3.0]

map fromJValue vals

[Just 1.0, Just 2.0, Just 3.0] :: [Maybe Double]

Just [1.0, 2.0, 3.0] :: Maybe [Double]

[JNumber 1.0, JNumber 2.0, JString "three point zero"]

[Just 1.0, Just 2.0, Nothing] :: [Maybe Double]

Nothing :: Maybe [Double]

mapM :: (a -> Maybe b) -> [a] -> Maybe [b]

instance JSON () where
  toJValue () = JNull
  fromJValue JNull = Just ()
  fromJValue _ = Nothing

data Result = Result
  { title :: String
  , snippet :: String
  , url :: String
  , favicon :: Maybe String   -- new, optional field
  } deriving (Show)

instance JSON a => JSON (Maybe a) where
  toJValue Nothing = JNull
  toJValue (Just x) = toJValue x
  fromJValue JNull = Just Nothing
  fromJValue x = Just <$> fromJValue x

instance JSON Result where
  toJValue Result{..}
    = JObject [ "title" .= title
              , "snippet" .= snippet
              , "url" .= url
              , "favicon" .= favicon ]
  fromJValue o = withObj o $ \v -> Result <$> v "title" <*> v "snippet"
                                   <*> v "url" <*> v "favicon"

> toJValue (Result "mytitle" "mysnippet" "myurl" Nothing)
JObject [("title",JString "mytitle"),("snippet",JString "mysnippet"),("url",JString "myurl"),("favicon",JNull)]
> toJValue (Result "mytitle" "mysnippet" "myurl" (Just "myfavicon"))
JObject [("title",JString "mytitle"),("snippet",JString "mysnippet"),("url",JString "myurl"),("favicon",JString "myfavicon")]

> fromJValue (JObject [("title",JString "mytitle"),("snippet",JString "mysnippet"),("url",JString "myurl")]) :: Maybe Result
Nothing

> fromJValue (JObject [("title",JString "mytitle"),("snippet",JString "mysnippet"),("url",JString "myurl"),("favicon",JNull)]) :: Maybe Result
Just (Result {title = "mytitle", snippet = "mysnippet", url = "myurl", favicon = Nothing})