Purescript 重用 Argonaut JSON 解码 Affjax Respondeable

Purescript Reuse Argonaut JSON Decoding for Affjax Respondeable

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

它给我错误 "Could not match type Foreign with type 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

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

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

到 return 使用 F 而不是 EitherFData.Foreign 中为 Except MultipleErrors a 定义的同义词。为此,我们需要:

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

MultipleErrorsData.Foreign 中定义的另一个同义词,这次是 NonEmptyList ForeignErrorLooking at ForeignError 有一个也称为 ForeignError 的构造函数,可以让我们提供一些字符串消息。这让我们需要创建一个 NonEmptyList,这非常简单:

remapError = pure <<< ForeignError

NonEmptyListApplicative,所以我们可以用 pure.

创建一个单元素列表

EitherExcept也很简单。再次 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),对于Except m ~ Identity.

所以现在我们可以使用这些东西,并制作一个通用的 "decode JSON for Affjax responses" 函数:

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

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

我们现在可以使用 Kleisli 组合 ((<=<)) 将此 decodeJsonResponse 与将执行初始 ResponseContent -> F Json:[=54= 的原始 fromResponse 链接在一起]

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