PureScriptでHTTPリクエストを叩き結果のJSONをレコードで受け取る

最近PureScriptを使い始めました。練習としてHTTPリクエストを投げて結果をJSONで受け取り、それを任意のレコード（newtypeやdataでもいいけど）で受け取る処理を実装してみました。
なんということはないコードですが、意外に世間にサンプルが少ない気がしますので共有しておきます。

主要な処理

この処理は、大雑把に言えば以下の２つの処理に分けられます。

1. HTTPリクエストを投げる
2. ボディのJSON文字列をパースしてレコードを作る

今回はhttps://httpbin.org/ipにリクエストを投げて結果のJSONを { origin :: String } というレコードで受け取る処理を題材にしてこの処理を実装します。

JSON文字列をパースしてレコードを作る

PureScriptを使ってJSONの型安全な読み書きを自動化するというQiitaの記事で紹介されているpurescript-simple-jsonを使ってみたところ、これ以上ないくらいにシンプルで非常に便利でした。

import Data.Either (Either (..))
import Foreign     (MultipleErrors)
import Simple.JSON (readJSON)

type IpRes = { origin :: String }

jsonToIpRes :: String -> Either MultipleErrors IpRes
jsonToIpRes = readJSON

なお、MultipleErrorsという型は NonEmptyList ForeignErrorのエイリアスです。

ここではリクエスト結果をレコードで受け取っていますが、newtypeやdataで定義した型であってもSimple.JSONは期待通りパースしてくれます。

HTTPリクエストを投げる

HTTPリクエストを投げるパッケージはいくつかあるっぽいのですが、ここではAffjaxというパッケージを使います。

GETを投げるだけなら非常に簡単で、get関数を使います。get関数の戻り値はAffモナドで包まれます。
JSONのパースには、先ほど作ったrequest関数を使います。

import Data.List.NonEmpty    (singleton)
import Effect.Aff            (Aff)
import Affjax                as AX
import Affjax.ResponseFormat as ResponseFormat

request :: Aff (Either MultipleErrors IpRes)
request = do
  res <- AX.get ResponseFormat.string "https://httpbin.org/ip"
  case res.body of
    Left (ResponseFormat.ResponseFormatError err _) -> pure $ Left $ singleton err
    Right json -> pure $ jsonToIpRes json

なお ResponseFormatErrorという型はレスポンスが期待の書式でないことを示すエラーであり、エラーとその原因となった値の対を保持します。定義は次の通りです。

data ResponseFormatError
  = ResponseFormatError ForeignError Foreign

ソース全体

PureScriptで作ったプログラムのエントリポイントはmain関数であり、型はEffect aです。Affjaxを使ってHTTPリクエスト処理を実装すると型はAffになるので、Effectモナドの中でAffモナドを使うためにlaunchAff_という関数が提供されています。

launchAffという関数もあるのですが、これはAffモナドを非同期に実行する場合に使うようです、多分。

module Main where

import           Prelude

import           Data.Either           (Either (..))
import           Data.List.NonEmpty    (singleton, foldl)
import           Foreign               (MultipleErrors)

import           Simple.JSON           (readJSON)

import           Effect                (Effect)
import           Effect.Aff            (Aff, launchAff_)
import           Effect.Class.Console  (log)

import           Affjax                as AX
import           Affjax.ResponseFormat as ResponseFormat

type IpRes = { origin :: String }

jsonToIpRes :: String -> Either MultipleErrors IpRes
jsonToIpRes = readJSON

request :: Aff (Either MultipleErrors IpRes)
request = do
  res <- AX.get ResponseFormat.string "https://httpbin.org/ip"
  case res.body of
    Left (ResponseFormat.ResponseFormatError err _) -> pure $ Left $ singleton err
    Right json -> pure $ jsonToIpRes json

main :: Effect Unit
main = launchAff_ $ do
  res <- request
  case res of
    Left errors -> log $ foldl (\s err -> if (s == "")  then show err else s <> "\n" <> show err) "" errors
    Right  gr   -> log gr.origin

今回の処理を実装した感想

たったこれだけの処理の実装にまあ時間のかかること。PureScriptを使い始めということに加えサンプルが少なく原典（＝パッケージのリポジトリやソースコード）を参照することが多くなり、時間を多く取られました。

またAffやFiberなど、知識外の型の意味を調べるのにもまた時間を取られます。

しかし、ビルドに通ってしまえばほぼ意図通りに動作します。
これはまさにHaskellと同じツンデレ言語ではないですか。

素晴らしい、PureScript。