Purescript 重用 Argonaut JSON 解码用于 Affjax Respondeable

Question

我正在尝试从 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

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) , 这对于 Except m ~ Identity .

所以现在我们可以使用这些东西，并制作一个通用的“为 Affjax 响应解码 JSON”函数:

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