Clojurian時々Haskellerでラブライブ!ファン(海未🏹&曜⛵推し)のlagénorhynque (a.k.a. カマイルカ)です。
Opt Technologies所属で、普段は広告運用に関わる社内向けプロダクトをPHP, TypeScript, Clojureで開発しています。
最近までにClojureをプロダクトに導入したり、Haskell/Elmプロダクトの開発者を募集したりと、社内でもClojureやHaskellといった言語への注目度がこれまで以上に高まっています(断言)。
そこで今回は、今年11月から新たに始まったClojure勉強会clj-nakanoでの課題を題材に、HaskellでのWeb API開発に入門してみることにしました。
ちなみにclj-nakanoといえば、Clojure開発者Rich HickeyのClojure/conj 2017でのキーノートEffective Programs - 10 Years of Clojureを解説した日本語資料も先日一部で話題になっていたようです。
situated-program-challenge
clj-nakanoでは、Rich Hickeyのキーノートでも出てきた表現"situated program"というものについて探求するべく、situated-program-challengeという課題に取り組んでいます。
詳しくはリポジトリのREADMEに書かれていますが、所定のデータベースにアクセスするREST APIのサーバとクライアントを複数言語で実装し、典型的なWeb APIをいかに簡潔に実装できるか、仕様変更に対していかに柔軟に対応できるか、検証してみようというものです。
第2回clj-nakanoではClojureとScalaでの実装例が紹介されました。
- Clojure版 by @iku000888 さん: iku000888/situated-program-challenge at clj-solution
- Scala版 by @shinichy さん: shinichy/situated-program-challenge at version1
というわけで、Web API開発の入門にも適したsituated-program-challengeのREST APIサーバをHaskellで実装してみます。
Haskell版の実装
実際にsituated-program-challengeの仕様version1の内容に即して実装してみたHaskell版:
lagenorhynque/situated-program-challenge at hs-version1
HaskellでWeb APIを作ろうとするとフレームワークにもいろいろ選択肢があるようですが、今回はちょうど最近 Seven Web Frameworks in Seven Weeks という本でYesodに触れたところだったため、Yesodで開発してみました。
Yesodは型安全(type-safe)なルーティングやDBアクセスなどが可能なフルスタックフレームワークで、DBアクセスにはPersistentとEsqueletoがスムーズに利用できました。
個人的には『Haskell入門』でも紹介されているフレームワークSpock, Scotty、DBアクセスのためのHaskell Relational Recordあたりも気になっています。
時間の都合により、本記事執筆時点ではsituated-program-challengeの課題のうちRESTサーバのみの実装で(RESTクライアントは未実装)、Yesodのscaffoldによる不要なコード/ファイルが残っていたり、ユニットテストがなかったりしますが、ひとまず以下のような流れで開発できました。
1. プロジェクトの生成
Yesod公式のquick start guideなどを参考にプロジェクトを生成し、コマンドラインツールをインストールする。
$ stack new rest-server yesod-postgres
$ cd rest-server
$ stack install yesod-bin --install-ghc
ビルドするには、
$ stack build
開発サーバを起動するには、
$ stack exec -- yesod devel
2. DB接続設定
docker-compose.ymlで利用するPostgreSQLのデータベース接続情報が与えられているので、Yesodの設定ファイルに反映する。
database:
user: "_env:PGUSER:meetup"
password: "_env:PGPASS:password123"
host: "_env:PGHOST:localhost"
port: "_env:PGPORT:5432"
# See config/test-settings.yml for an override during tests
database: "_env:PGDATABASE:meetup"
poolsize: "_env:PGPOOLSIZE:10"
3. モデルの定義
lein migratus によるマイグレーションで得られたテーブルに対応するモデルを定義する。
Group sql=groups
name Text sqltype=text Maybe
createdAt UTCTime Maybe
deriving Eq
deriving Show
GroupMember sql=groups_members
groupId GroupId
memberId MemberId
Primary groupId memberId
admin Bool default=false Maybe
deriving Eq
deriving Show
Meetup sql=meetups
title Text sqltype=text
startAt UTCTime Maybe
endAt UTCTime Maybe
venueId VenueId Maybe
groupId GroupId Maybe
deriving Eq
deriving Show
MeetupMember sql=meetups_members
meetupId MeetupId
memberId MemberId
Primary meetupId memberId
deriving Eq
deriving Show
Member sql=members
firstName Text sqltype=text Maybe
lastName Text sqltype=text Maybe
email Text sqltype=text Maybe
deriving Eq
deriving Show
Venue sql=venues
name Text sqltype=text Maybe
postalCode Text sqltype=text Maybe
prefecture Text sqltype=text Maybe
city Text sqltype=text Maybe
street1 Text sqltype=text Maybe
street2 Text sqltype=text Maybe
groupId GroupId Maybe
deriving Eq
deriving Show
↑の model ファイルの定義が↓で読み込まれてTemplate Haskellによって展開され、対応するデータ型(レコード)や型クラスのインスタンスが自動生成される仕組みらしい(Clojurian/Lisperとしてはこのあたりのマクロによるメタプログラミングがとても気になる)。
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Model where
import ClassyPrelude.Yesod
import Data.Aeson.TH
import Database.Persist.Quasi
import qualified Data.Aeson.Casing as Casing
import qualified Text.Casing as Casing
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
deriveJSON (Casing.aesonPrefix Casing.kebab) ''Group
deriveJSON (Casing.aesonPrefix Casing.kebab) ''Meetup
deriveJSON (Casing.aesonPrefix Casing.kebab) ''Member
deriveJSON (Casing.aesonPrefix Casing.kebab) ''Venue
今回のAPIではJSONのキーがkebab-caseであるため、Data.Aeson.THの deriveJSON でモデルのレコードをJSONにする際にレコードフィールド名のプレフィックスを落としてcamelCaseからkebab-caseに変換するようにしている。
ここでもTemplate Haskellの力でモデルとJSONの相互変換のボイラープレートコードが削減されている。
4. ルーティングの定義
swagger specとしてAPIの仕様が与えられているので、それに従ってルーティングを定義する。
/members MembersR GET POST
/members/#MemberId MemberR GET
/members/#MemberId/meetups/#MeetupId MeetupMemberR POST
/members/#MemberId/groups/#GroupId GroupMemberR POST
/groups GroupsR GET POST
/groups/#GroupId/venues VenuesR GET POST
/groups/#GroupId/meetups MeetupsR GET POST
/groups/#GroupId/meetups/#MeetupId MeetupR GET
Yesodのコマンドラインツールを利用すると、例えば以下のようにルーティング定義と対応するハンドラーのファイルが自動生成できてちょっと便利。
e.g.
$ stack exec -- yesod add-handler
Name of route (without trailing R): Groups
Enter route pattern (ex: /entry/#EntryId): /groups
Enter space-separated list of methods (ex: GET POST): GET POST
5. ハンドラーの実装
リクエストを受け取ってからレスポンスを返すまでのAPIのビジネスロジックをハンドラー関数として実装する。
ここでは、入出力のJSONを適宜変換したり、Persistent/EsqueletoでDBアクセスしたり。
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.Members where
import Import
import Control.Lens
import Data.Aeson.Lens
getMembersR :: Handler Value
getMembersR = do
ms <- runDB $ selectList [] [] :: Handler [Entity Member]
returnJson $ map memberValueWithId ms
postMembersR :: Handler Value
postMembersR = do
m <- requireJsonBody :: Handler Member
mid <- runDB $ insert m
returnJson . memberValueWithId $ Entity mid m
getMemberR :: MemberId -> Handler Value
getMemberR memberId = do
m <- runDB $ get404 memberId
returnJson . memberValueWithId $ Entity memberId m
memberValueWithId :: Entity Member -> Value
memberValueWithId (Entity mid m) =
toJSON m & _Object . at "member-id" ?~ toJSON mid
Persistentの標準機能でSQLの SELECT や INSERT など基本的なDB操作が簡潔に書けた。
e.g.
-- SELECT
ms <- runDB $ selectList [] [] :: Handler [Entity Member]
-- INSERT
mid <- runDB $ insert m
また、aesonでJSONを扱う際にlens, lens-aesonも一部利用してみた。
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Handler.Meetups where
import Import
import Database.Esqueleto ((^.))
import qualified Database.Esqueleto as E
import Handler.Members (memberValueWithId)
import Handler.Venues (venueValueWithAddress)
getMeetupsR :: GroupId -> Handler Value
getMeetupsR groupId = do
ms <- runDB $ selectList [MeetupGroupId ==. Just groupId] []
meetupDetails <- mapM fetchMeetupDetail ms
returnJson meetupDetails
postMeetupsR :: GroupId -> Handler Value
postMeetupsR groupId = do
m <- requireJsonBody :: Handler Meetup
let m' = m { meetupGroupId = Just groupId }
mid <- runDB $ insert m'
meetupDetail <- fetchMeetupDetail $ Entity mid m'
returnJson meetupDetail
getMeetupR :: GroupId -> MeetupId -> Handler Value
getMeetupR _ = getMeetup
postMeetupMemberR :: MemberId -> MeetupId -> Handler Value
postMeetupMemberR memberId meetupId = do
_ <- runDB . insert $ MeetupMember { meetupMemberMeetupId = meetupId
, meetupMemberMemberId = memberId
}
getMeetup meetupId
fetchMeetupDetail :: Entity Meetup -> Handler Value
fetchMeetupDetail em@(Entity mid Meetup{..}) = do
v <- maybe (return Nothing) (runDB . getEntity) meetupVenueId
ms <- runDB $ E.select
$ E.from $ \(member' `E.InnerJoin` meetupMember') -> do
E.on $ member' ^. MemberId E.==. meetupMember' ^. MeetupMemberMemberId
E.where_ $ meetupMember' ^. MeetupMemberMeetupId E.==. E.val mid
return member'
return $ meetupWithVenueAndMembers em v ms
getMeetup :: MeetupId -> Handler Value
getMeetup mid = do
m <- runDB $ get404 mid
meetupDetail <- fetchMeetupDetail $ Entity mid m
returnJson meetupDetail
meetupWithVenueAndMembers :: Entity Meetup -> Maybe (Entity Venue) -> [Entity Member] -> Value
meetupWithVenueAndMembers (Entity mid Meetup{..}) venue members =
object [ "event-id" .= mid
, "title" .= meetupTitle
, "start-at" .= meetupStartAt
, "end-at" .= meetupEndAt
, "venue" .= fmap venueValueWithAddress venue
, "members" .= fmap memberValueWithId members
]
こちらのハンドラーでは、多対多関係を表現するテーブルを JOIN して検索するために、より柔軟に(しかも型安全に)SQLが書けるEsqueletoを利用している。
ms <- runDB $ E.select
$ E.from $ \(member' `E.InnerJoin` meetupMember') -> do
E.on $ member' ^. MemberId E.==. meetupMember' ^. MeetupMemberMemberId
E.where_ $ meetupMember' ^. MeetupMemberMeetupId E.==. E.val mid
return member'
その他のハンドラーも同様に実装してRESTサーバは完成!
Clojure版の実装
Clojureらしいデータ駆動(data-driven)/データ指向(data-oriented)なフレームワークDuct、DBアクセスにHoneySQLあたりを利用して実装したClojure版(予定):
lagenorhynque/situated-program-challenge at clj-version1
時間の都合により、本記事執筆時点ではAtaraxyとPostgreSQLを使う想定でRESTサーバ用のプロジェクトを生成したところで止まっています(Haskell版と対比してみたかったのですが、普通に間に合いませんでした😇……)。
$ lein new duct rest-server +api +ataraxy +postgres
Haskell版とともに近日中に実装していく予定なので、興味のある方は日を改めてご確認ください😅
【2017/12/22追記】
Clojure (Duct)版のRESTサーバを実装してみました!
ClojureのDuctでWeb API開発してみた - Qiita
まとめ
- HaskellのフルスタックフレームワークYesodで型安全性に支えられながらWeb APIが開発できた
- Clojureでは常にREPLと対話しながら開発するが、Haskellのコンパイラとある種の対話をしながら開発するスタイルも良いかも
- Haskellはまだまだ私には難しいけど、徐々に分かってくると楽しい＞ω＜/
- Haskellの言語とエコシステムについてもっと理解すればもっとコードを改善できそう
Haskellerの皆さん(もちろんその他の言語使いの方々も)、situated-program-challengeを気軽に試してみてください|дﾟ)ﾁﾗｯ