HaskellとJSON、そしてレコード型

HaskellのJSON周りについて、こうやるのがいいんじゃないかという私の現在のやり方を書きます。題材としては、 Swagger Petstore に記されている REST API にリクエストを投げてレスポンスを取り出すというのをやります。 (Swagger ですが scaffold は使わず自分で HTTP クライアントライブラリを使います)。

基本方針は「出力は厳密に入力には寛容に」(出典失念) です。

JSONの前に: レコードのフィールドへのアクセス
JSONの前に: レコードのデフォルト値
Haskellのデータ型→JSON
JSONデータを含むHTTPリクエスト
レスポンスにおけるJSONの扱い

JSONの前に: レコードのフィールドへのアクセス

Haskellのレコード型って、フィールドのゲッターがふつうの関数なのでレコードから値を取り出そうとすると f3 $ f2 $ f1 record みたいにフィールド名が左向きに繋がります。そのくせレコードの更新構文は右向きだったりとか……。

そのあたりをいい感じにしてくれる lens というライブラリがあって (lens というと色々あるみたいですが以下これを単にlensと呼びます)、こんなことができます。

{-# LANGUAGE TemplateHaskell #-}
import Control.Lens (makeLenses, (^.))
import Prelude hiding (id)            -- idをフィールド名で使うため

data User = User { _id :: Int, _name :: Name }
data Name = Name { _firstName :: String, _familyName :: String }
makeLenses ''User
makeLenses ''Name

main :: IO ()
main = do
  let user = User 1 (Name "Takiji" "Kobayashi")
  print $ user ^. id                  -- -> 1
  print $ user ^. name . firstName    -- -> "Takiji"

makeLenses は TemplateHaskell によってコンパイル時に動く関数で、データ型の定義からいろいろなものを自動生成します。すると (^.) などの lens の演算子がデータ型に対して使えるようになり、フィールド名を右向きに繋げていけるようになります。レコードの更新も同様に右方向でできます。

lens を紹介しているサイトでは大体この makeLenses を紹介していると思います。しかしレコード型をたくさん作っていると makeLenses ではちょっと面倒になってきます。なんでかと言うと Haskell のレコード型のフィールド名って別のレコード型と衝突するんですよね。衝突を避けるためにフィールド名のプレフィクスとしてレコード名をつけたりします。

data User = User { _userId :: Int }
data Pet = Pet { _petId :: Int }
makeLenses ''User
makeLenses ''Pet

main :: IO ()
main = do
  print $ (User 1) ^. userId    -- -> 1
  print $ (Pet 1) ^. petId      -- -> 1

そういう場合に便利なやつとして makeFields というのが lens で提供されています。

data User = User { _userId :: Int }
data Pet = Pet { _petId :: Int }
makeFields ''User
makeFields ''Pet

main :: IO ()
main = do
  print $ (User 1) ^. id    -- -> 1
  print $ (Pet 1) ^. id     -- -> 1

lens で利用するときにプレフィクスがいらなくなるわけですね。この例だとまだありがたみが薄いですがレコードが増えてきてレコード名が長くなってくると大変便利です。 (というかないと破綻する)。

makeLenses を紹介しているサイトが多いですが makeFields 便利なので使いましょう。 makeFields でも不満がある場合は、lensライブラリにはフィールド名の扱いをより自由にカスタマイズする方法も提供されているみたいなのでそれを使うといいでしょう。

あと今回、lens だけでどうにかする方法を紹介しましたが、拡張可能レコードを使うのが今風でより良いかもしれません。拡張可能レコードについては haskell/extensible-record.md at master · lotz84/haskell · GitHub がよくまとまっていると思います。

JSONの前に: レコードのデフォルト値

我々は怠惰なので複雑なレコード値を構築するのが面倒です。レコード型にデフォルト値があって必要なフィールドだけを変更できると便利なことがあります。

そんなとき便利なのが data-default です。

Swagger Petstore の POST /store/order の入力値をこれを使って表現してみます。

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics (Generic)
import qualified Data.Text as T
import Data.Default (Default(..))

instance Default Bool where
  def = False

instance Default T.Text where
  def = ""

data PostOrder = PostOrder
                 { _postOrderId :: Int
                 , _postOrderPetId :: Int
                 , _postOrderQuantity :: Int
                 , _postOrderShipDate :: T.Text
                 , _postOrderStatus :: T.Text
                 , _postOrderComplete :: Bool
                 } deriving (Show, Generic)

instance Default PostOrder

main :: IO ()
main = print (def :: PostOrder) -- > PostOrder {_postOrderId = 0, _postOrderPetId = 0, _postOrderQuantity = 0, _postOrderShipDate = "", _postOrderStatus = "", _postOrderComplete = False}

型クラス Default の関数 def がその型のデフォルト値を意味します。 Int などの基本的な型にはすでにインスタンスが用意されていますが、

デフォルト値を定めづらい型: Bool など
標準でないライブラリの型: Text など
自作の型

についてはユーザがインスタンスを定義する必要があります。

def は2つの方法で定義できます。

ふつうにデフォルト値を手で与える: 上記の Bool と T.Text
Generic を使って自動的に導出する: 上記の PostOrder

言語拡張 DeriveGeneric は型についてある種のメタデータを生成することを可能にします。 def はこのメタデータがあれば自動的に導出できるようになっているので、def について言及しなくても PostOrder が Default のインスタンスであると示すだけで def の内容が用意されます。

Haskellのデータ型→JSON

Haskell の JSON ライブラリといえば aeson ですが、今回はそれに加えて aeson-casing というのも使います。

PostOrder の JSON エンコーディングを記述します。 (既に書いた分は省略)。

import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.Aeson.Casing as JSON
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as LBS

instance JSON.ToJSON PostOrder where
  toJSON = JSON.genericToJSON JSON.defaultOptions { JSON.fieldLabelModifier = JSON.snakeCase . drop (T.length "_postOrder") }

main :: IO ()
main = LBS.putStr $ JSON.encode $ (def :: PostOrder) -- > {"status":"","quantity":0,"pet_id":0,"id":0,"ship_date":"","complete":false}

aeson でも Generic による自動導出ができて、実は toJSON の定義を書かなくても ToJSON のインスタンスはできます。ただ今回は lens のところでも書いたようにフィールド名のプレフィクスを消したいので、自動導出をカスタマイズする方法を採っています。

T.length の部分はちょっと格好悪いしメンテナンス性を下げるのでいい方法がないか模索中です。

JSONデータを含むHTTPリクエスト

ここまで書いてきたすべてのものを使って、いよいよ HTTP リクエストを投げていきます。

HTTP クライアントライブラリには req を使います。このジャンルでは wreq が有名ですが、req もいいライブラリだと思います。 req の README には開発のモチベーションや wreq 等の他のライブラリとの比較があります。

POST /store/order へのリクエストは req ではこのように書きます。 (既に書いた分と makeFields は省略)。

import Network.HTTP.Req ( req
                        , MonadHttp(..)
                        , GET(..), POST(..)
                        , http, https
                        , (/:)
                        , NoReqBody(..), ReqBodyJson(..)
                        , jsonResponse
                        , responseBody
                        )
import Control.Exception (throwIO)
import Control.Lens ((&), (.~))

instance MonadHttp IO where
  handleHttpException = throwIO

postOrder :: (MonadHttp m) => PostOrder -> m JSON.Value
postOrder model = responseBody <$> req
  POST                 -- HTTPメソッド: POST
  (http "petstore.swagger.io" /: "v2" /: "store" /: "order")
                       -- URL: http://.../store/order
  (ReqBodyJson model)  -- リクエストボディ: (ToJSONのインスタンスである)PosrOrderを
                       --               JSON としてセット
  jsonResponse         -- レスポンスの型: レスポンスは JSON としてパース
  mempty               -- ヘッダなど: 今回はないので mempty

main :: IO ()
main = do
  let order = (def :: PostOrder) & petId .~ 3
                                 & quantity .~ 1
  postOrder order

req の提供する req が HTTP リクエストを投げる関数です。

req は使用環境に MonadHttp を要求します。今回はシンプルに IO の中で req を使いたいので IO を MonadHttp のインスタンスにしていますが、このやり方だと Orphan Instance の警告が出ます。

実は1週間ほど前にこの警告を回避する方法が提供され、最新の req 0.4 で利用可能になっています (詳細)。まだ LTS Haskell には入っていないのでここでは紹介しませんが、警告が気になる場合は見てみるといいでしょう。

レスポンスにおけるJSONの扱い

これまでリクエストについては型を定義して名前が衝突しないように配慮してデフォルト値も設定して……と手塩にかけてやってきましたが、レスポンスについてはそこまでしっかりやらなくてもいいと自分は思っています。基本方針にも書きましたが「出力は厳密に入力には寛容に」という原則に従います。

具体的には lens-aeson というライブラリを使います。 lens-aeson を使って、Swagger Petstore の GET /pet/{:id} のレスポンスを処理してみます。

import Control.Lens ((^?))
import Data.Aeson.Lens (key, _String)

getPetById :: (MonadHttp m) => T.Text -> m JSON.Value
getPetById _petId = responseBody <$> req
  GET
  (http "petstore.swagger.io" /: "v2" /: "pet" /: _petId)
  NoReqBody
  jsonResponse
  mempty

main :: IO ()
main = do
  pet1 <- getPetById "1"
  let pet1Name = pet1 ^? key "name" . _String
  print pet1Name    -- > Just "some name"

レスポンスの型を特に指示していないのに値が取り出せてしまいます。

と言っても型がない訳ではなく、実際は関数によって型が与えられていて、しっかり静的にチェックされます。ここでの key は引数が JSON のオブジェクトに相当する型であることを仮定します。同様に _String は取り出した値が文字列であると仮定します。その仮定が外れるような入力なら(または該当するキーがなかったら)単に Nothing が返ります。

出典を忘れたのですが「優れた言語は型付けのレベルを柔軟に変更できる」という意見を見たことがあります。今回紹介したやり方は結構型を柔軟に取り扱っている感じじゃないでしょうか。