Purescript 为 Affjax Respondeable 重用 Argonaut JSON 解码

Question

我正在尝试从 Haskell 服务器获取一些 JSON 数据，但我遇到了 Respondeable 实例以及一般的 Affjax 的问题。我已经用 Data.Argonaut.Generic.Aeson (GA) 定义了 EncodeJson + DecodeJson，但我不知道如何将它与 Respondeable 实例和它的 fromResponse 函数相匹配。

它给了我错误“无法将外部类型与 Json 类型匹配”，但是否可以重用我的 decodeJson 实例而无需手动创建其他任何东西？也许通过创建一个 IsForeign 实例，但在其中使用 GA.decodeJson ？我只是不知道该怎么做。我已经看到它是如何在https://github.com/purescript/purescript-foreign/blob/master/examples/Complex.purs 中手动完成的，但我有复杂的类型需要与我的 Haskell JSON 输出相匹配，手动完成将是一个巨大的痛苦。

我正在使用 purescript 10.7、Affjax 3.02、argonaut 2.0.0 和 argonaut-generic-codecs 5.1.0。谢谢！

testAffjax :: forall eff. Aff (ajax :: AJAX | eff) (Answer)
testAffjax = launchAff do
  res <- affjax $ defaultRequest { url = "/", method = Left GET }
  pure res.response


data Answer = Answer {
  _answer :: String
, _isCorrect :: Boolean
, _hint :: String
}

{- PROBLEM -}
instance respondableAnswer :: Respondable Answer where
  responseType = Tuple Nothing JSONResponse
  fromResponse = GA.decodeJson {- Error here -}

derive instance genericAnswer :: Generic Answer
instance showAnswer :: Show Answer where
  show = gShow
instance encodeAnswer :: EncodeJson Answer where
  encodeJson = GA.encodeJson
instance decodeAnswer :: DecodeJson Answer where
  decodeJson = GA.decodeJson

Answer 1

您正在寻找的是一个适应 JSON 解码器的函数：

decodeJson :: forall a. Json -> Either String a

使用F 而不是Either 返回。 F 是在Data.Foreign 中为Except MultipleErrors a 定义的同义词。为此，我们需要：

1. 将我们的String 错误转换为MultipleErrors
2. 从Either 转换为Except

MultipleErrors 是Data.Foreign 中定义的另一个同义词，这次是NonEmptyList ForeignError。 Looking at ForeignError 有一个构造函数也称为ForeignError，它可以让我们提供一些字符串消息。这让我们需要创建一个NonEmptyList，这很容易：

remapError = pure <<< ForeignError

NonEmptyList 是Applicative，所以我们可以用pure 创建一个单元素列表。

从Either 到Except 也很简单。再次looking at the definitions in Pursuit我们可以看到：

newtype ExceptT m e a = ExceptT (m (Either e a))
type Except = ExceptT Identity

所以ExceptT 只是一个花哨的Either，给我们：

eitherToExcept = ExceptT <<< pure

这里的pure是将Either e a提升为m (Either e a)，即Exceptm ~ Identity。

所以现在我们可以利用这些东西，制作一个通用的“解码 JSON 以获取 Affjax 响应”功能：

decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
  ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson

这里唯一发生的另一件事是我们使用lmap 映射到Either 的左侧部分，以执行错误消息类型转换位。

我们现在可以使用 Kleisli 组合 ((<=<)) 将这个 decodeJsonResponse 与原来的 fromResponse 链接起来，这将做初始的 ResponseContent -> F Json：

instance respondableAnswer :: Respondable Answer where
  responseType = Tuple (Just applicationJSON) JSONResponse
  fromResponse = decodeJsonResponse <=< fromResponse

这是使用您的 Answer 类型的完整示例：

module Main where

import Prelude

import Control.Monad.Aff (Aff)
import Control.Monad.Except (ExceptT(..))

import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson)
import Data.Argonaut.Generic.Argonaut as GA
import Data.Bifunctor (lmap)
import Data.Foreign (F, ForeignError(..))
import Data.Generic (class Generic, gShow)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common as MediaType
import Data.Tuple (Tuple(..))

import Network.HTTP.Affjax as AX
import Network.HTTP.Affjax.Response as AXR

testAffjax :: forall eff. Aff (ajax :: AX.AJAX | eff) Answer
testAffjax = _.response <$> AX.get "/"

newtype Answer = Answer
  { _answer :: String
  , _isCorrect :: Boolean
  , _hint :: String
  }

derive instance genericAnswer :: Generic Answer

instance showAnswer :: Show Answer where
  show = gShow

instance encodeAnswer :: EncodeJson Answer where
  encodeJson = GA.encodeJson

instance decodeAnswer :: DecodeJson Answer where
  decodeJson = GA.decodeJson

instance respondableAnswer :: AXR.Respondable Answer where
  responseType = Tuple (Just MediaType.applicationJSON) AXR.JSONResponse
  fromResponse = decodeJsonResponse <=< AXR.fromResponse

decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
  ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson