はじめに
Haskell には大小様々な Web フレームワークがあります．(yesod, scotty, spock, apiary, rest, 等々)
API サーバを作りたいときは scotty を利用することが多かったのですが，つい最近 haskell-servant というパッケージ群を知りました．
小さな API サーバを書きたいときに便利そうだなと思い，使いつつ軽くコードを読んでみました*1．
環境
型を用いて API 仕様を定義するタイプのフレームワークで，クライアントコードやドキュメントも生成してくれます．
API の型とそれに対応するハンドラを組み合わせることで WAI アプリケーションとして動作します．
現在の形になったのはつい最近なんでしょうか？ → Rethinking webservice and APIs in Haskell: servant 0.2
試作: メモアプリ用 API サーバ
以下のような API を定義しています．
type MemoAPI =
"memos" :> Get [Memo]
:<|> "memos" :> ReqBody ReqMemo :> Post Memo
:<|> "memos" :> Capture "id" Int :> Delete
:> が / みたいなもので，:<|> が API の結合だそうです．
route を構成するパスやパラメータ名もリテラルとして型に埋め込めます．
戻り値の型は ToJSON，ReqBody に指定する型は FromJSON，Capture に指定する型は FromText をそれぞれ実装する必要があります．
例えば FromText であれば以下のようになります．
import Data.Time
import Data.Text.Read (decimal)
instance FromText TimeZone where
fromText t =
case decimal t of
Right (h, _) -> Just $ hoursToTimeZone h
_ -> Nothing
また，ドキュメント生成時にパラメータの説明やサンプルデータが必要になるため，それぞれ ToCapture，ToSample のインスタンスを実装します．
instance ToCapture (Capture "id" Int) where
toCapture _ = DocCapture "id" "memo id"
instance ToSample Memo where
toSample = Just sampleMemo
instance ToSample [Memo] where
toSample = Just [sampleMemo]
sampleMemo :: Memo
sampleMemo = Memo
{ id = 5
, text = "Try haskell-servant."
, createdAt = ZonedTime (LocalTime (fromGregorian 2014 12 31) midday) (hoursToTimeZone 9)
}
仕様変更したときに何か不足していればコンパイルエラーになるため「実装とドキュメントがずれてしまう」といったことは減らせそうです．
ただ今のところデフォルトで出力可能な形式は markdown だけのようで，出力形式を変えたい場合は自前で API -> String を実装する必要があります．
仕組みを知る上で前提となる知識
(※ご存知の方は読み飛ばしてください)
Type operators
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/data-type-extensions.html
オペレータシンボルを型コンストラクタとして扱うための拡張です．-XTypeOperators で有効になります．
型やクラスの宣言に利用されるオペレータを除けば，プレフィックスに : がなくても良い？みたいです．
servant では :> や :<|> がこれに相当します．
Type-Level Literals
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/type-level-literals.html
数値や文字列を型レベルの定数として扱うことができるようです．
-XDataKinds で有効になります (DataKinds 自体は，型を kind に，値コンストラクタを型コンストラクタに持ち上げる拡張)．
以下は上記ページの例そのままですが，Label "x" が型として機能しています．
data Label (l :: Symbol) = Get
class Has a l b | a l -> b where
from :: a -> Label l -> b
data Point = Point Int Int deriving Show
instance Has Point "x" Int where from (Point x _) _ = x
instance Has Point "y" Int where from (Point _ y) _ = y
example = from (Point 1 2) (Get :: Label "x")
もちろん Get :: Label "y" とすれば example は 2 を返します．
servant では API のルーティングパスを表現するところで利用されています．
Kind polymorphism
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/kind-polymorphism.html
kind が多相的に扱えるようになります．何て呼ぶんでしょうか？多相カインド？ -XPolyKinds で有効になります．
kind が明示されていない部分は * ではなく kind 変数として推論されるようになるみたいです．
data T m a = MkT (m a)
↓GHCi
*Test> :kind T
T :: (* -> *) -> * -> *
*Test> :set -XPolyKinds
*Test> :kind T
T :: (k -> *) -> k -> * -- m の kind が * -> * から k -> * (変数あり) に変わった
Proxy
base の Data.Proxy に定義された，型情報を持つだけの data です．
data Proxy t = Proxy
↓GHCi
Prelude Data.Proxy> :kind Proxy
Proxy :: k -> *
kind が多相的になっているため，* や Nat，Symbol といった kind に関係なく様々な型を持つことができます．
servant の :> はいろいろな kind を持った型をとるため，Proxy を使って定義されています．
data (path :: k) :> a = Proxy path :> a
infixr 9 :>
ちょっとだけ内部に潜る
Application の作成
serve に渡した p :: Proxy layout と server :: Server layout から，HasServer クラスの route 関数 (の実装) が RoutingApplication を作成します．
RoutingApplication は WAI の Application が少し変更されたもので，servant の RoutingResult を扱うようになっているため toApplication 関数でこれを変換して最終的な Application にしています．
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
serve :: HasServer layout => Proxy layout -> Server layout -> Application
serve p server = toApplication (route p server)
ルーティング処理
実際にルーティングを行っている route 関数は Visitor パターンのような実装になっています．HasServer の instance 実装でパターンマッチしているようなイメージ？であっているでしょうか．
パスやパラメータ/戻り値の型は Proxy layout から決定され，Server layout もその型に従うように要求されます．
class HasServer layout where
type Server layout :: *
route :: Proxy layout -> Server layout -> RoutingApplication
API を結合する :<|> の場合，以下のように分離された a :: Server a，b :: Server b をそれぞれまた route に引き渡すような実装になっています．
a が失敗した場合に b が実行されるようになっていることもわかります．
instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
type Server (a :<|> b) = Server a :<|> Server b
route Proxy (a :<|> b) request respond =
route pa a request $ \ mResponse ->
if isMismatch mResponse
then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
else respond mResponse
where pa = Proxy :: Proxy a
pb = Proxy :: Proxy b
途中の path をたどっていく部分は，WAI の Request から取得したリクエストパスと，シンボルとして型に埋め込まれた文字列 path とを比較し，一致すればさらに進み，一致しなければ失敗 (NotFound) としてレスポンスを返していることがわかります．
instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
type Server (path :> sublayout) = Server sublayout
route Proxy subserver request respond = case pathInfo request of
(first : rest)
| first == cs (symbolVal proxyPath)
-> route (Proxy :: Proxy sublayout) subserver request{
pathInfo = rest
} respond
_ -> respond $ failWith NotFound
where proxyPath = Proxy :: Proxy path
なお，symbolVal は型レベルリテラル (Symbol) を文字列として取り出す関数です．
symbolVal (Proxy :: Proxy "hoge") == "hoge"
パラメータがある場合 (例えばサンプルコードの Capture "id" Int) は，captured で Text から a 型の値に変換され (ここで FromText のインスタンスが必要になる)，ハンドラの方 (route の引数である subserver :: Server layout) は a -> Server sublayout 型としてキャプチャしたパラメータの値に適用されています．
instance (KnownSymbol capture, FromText a, HasServer sublayout)
=> HasServer (Capture capture a :> sublayout) where
type Server (Capture capture a :> sublayout) =
a -> Server sublayout
route Proxy subserver request respond = case pathInfo request of
(first : rest)
-> case captured captureProxy first of
Nothing -> respond $ failWith NotFound
Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{
pathInfo = rest
} respond
_ -> respond $ failWith NotFound
where captureProxy = Proxy :: Proxy (Capture capture a)
最終的に Proxy layout の末尾に指定された HTTP Method と戻り値の型の部分までたどり着き，ここで WAI のレスポンスが構築されます．
instance ToJSON result => HasServer (Get result) where
type Server (Get result) = EitherT (Int, String) IO result
route Proxy action request respond
| null (pathInfo request) && requestMethod request == methodGet = do
e <- runEitherT action
respond . succeedWith $ case e of
Right output ->
responseLBS ok200 [("Content-Type", "application/json")] (encode output)
Left (status, message) ->
responseLBS (mkStatus status (cs message)) [] (cs message)
| null (pathInfo request) && requestMethod request /= methodGet =
respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound
EitherT の Left は失敗したときのステータスコードとメッセージの組，Right は成功したときの戻り値をそれぞれ表しています．
type Server (Get result) = EitherT (Int, String) IO result
おわりに
あまり深追いはしていませんが，ざっと仕組みは追えたと思います．
ルーティングの部分を型で守りたいと思い apiary を試していましたが，servant も興味深い選択肢の一つだと思いました．
