1. ソースコード

ソースコードの動かし方は【Servant】(2) Servantチュートリアルを参照してください。

Lib.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}

module Lib
    ( runServant
    ) where

import Servant
import Data.Aeson(ToJSON, FromJSON)
import Data.Time.Calendar
import Data.List
import Data.Maybe
import GHC.Generics(Generic)
import Network.Wai(Application)
import Network.Wai.Handler.Warp(run)

type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email

data Position = Position
  { xCoord :: Int
  , yCoord :: Int
  } deriving Generic

instance ToJSON Position

newtype HelloMessage = HelloMessage { msg :: String }
  deriving Generic

instance ToJSON HelloMessage

data ClientInfo = ClientInfo
  { clientName :: String
  , clientEmail :: String
  , clientAge :: Int
  , clientInterestedIn :: [String]
  } deriving Generic

instance FromJSON ClientInfo
instance ToJSON ClientInfo

data Email = Email
  { from :: String
  , to :: String
  , subject :: String
  , body :: String
  } deriving Generic

instance ToJSON Email

emailForClient :: ClientInfo -> Email
emailForClient c = Email from' to' subject' body'

  where from'    = "great@company.com"
        to'      = clientEmail c
        subject' = "Hey " ++ clientName c ++ ", we miss you!"
        body'    = "Hi " ++ clientName c ++ ",\n\n"
                ++ "Since you've recently turned " ++ show (clientAge c)
                ++ ", have you checked out our latest "
                ++ intercalate ", " (clientInterestedIn c)
                ++ " products? Give us a visit!"

server3 :: Server API
server3 = position
     :<|> hello
     :<|> marketing

  where position :: Int -> Int -> Handler Position
        position x y = return (Position x y)

        hello :: Maybe String -> Handler HelloMessage
        hello mname = return . HelloMessage $ case mname of
          Nothing -> "Hello, anonymous coward"
          Just n  -> "Hello, " ++ n

        marketing :: ClientInfo -> Handler Email
        marketing clientinfo = return (emailForClient clientinfo)

userAPI :: Proxy API
userAPI = Proxy

-- 'serve' comes from servant and hands you a WAI Application,
-- which you can think of as an "abstract" web application,
-- not yet a webserver.
app3 :: Application
app3 = serve userAPI server3

runServant :: IO ()
runServant = run 8081 app3

パス"position"へのリクエストです。1と2がcaptureされます。

$ curl http://localhost:8081/position/1/2
{"yCoord":2,"xCoord":1}

パス"hello"へのリクエストです。query stringがNothingです。

$ curl http://localhost:8081/hello
{"msg":"Hello, anonymous coward"}

パス"hello"へのリクエストです。query stringがname=Alpです。

$ curl http://localhost:8081/hello?name=Alp
{"msg":"Hello, Alp"}

パス"marketing"へのリクエストです。

「-d {...}」でJSON形式のリクエストボディを送信します。
「-H 'Content-type: application/json'」でリクエストがJSON形式であることを知らせます。
「-H 'Accept: application/json'」でレスポンスがJSON形式であることを期待していると知らせます。

以下のコマンドと出力結果ですが、見やすいように改行を入れました。

$ curl -X POST 
-d '{"clientName":"Alp Mestanogullari", "clientEmail" : "alp@foo.com", "clientAge": 25, "clientInterestedIn": ["haskell", "mathematics"]}' 
-H 'Accept: application/json' 
-H 'Content-type: application/json' 
http://localhost:8081/marketing

{"subject":"Hey Alp Mestanogullari, we miss you!",
"body":"Hi Alp Mestanogullari,\n\nSince you've recently turned 25, have you checked out our latest haskell, mathematics products? Give us a visit!",
"to":"alp@foo.com",
"from":"great@company.com"}

#2. 説明

##2-1. APIの定義

type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email

「Capture "something" a」は a型の引数となります。URL末尾の"position/1/2"の1と2をキャプチャーし、そのままハンドラの引数として渡されます。
「QueryParam "something" a」はMaybe a型の引数となります。"something"="name"として、URL末尾が"hello?name=Alp"の場合は Just "Alp" が引数です。"hello"だけの場合は、Nothingが引数です。
「ReqBody contentTypeList a」はa型の引数となります。この場合は、a型=ClientInfo型を意味します。JSONで受け取ったリクエストボディを「instance ToJSON ClientInfo」でデシリアライズします。

##2-2.ハンドラの定義

当然ですが、ハンドラが受け取る引数は、APIで定義したものにキレイに対応しています。キレイというのはAPI DSLがシンプルなのでハンドラの引数との対応が明確であるということです。

server3 :: Server API
server3 = position
     :<|> hello
     :<|> marketing

  where position :: Int -> Int -> Handler Position
        position x y = return (Position x y)

        hello :: Maybe String -> Handler HelloMessage
        hello mname = return . HelloMessage $ case mname of
          Nothing -> "Hello, anonymous coward"
          Just n  -> "Hello, " ++ n

        marketing :: ClientInfo -> Handler Email
        marketing clientinfo = return (emailForClient clientinfo)

##2-3. JSON シリアライズ

それと指摘したいのはAesonのおかげで、（デ）シリアライズを、data type単位で宣言しておくだけでよいので、リクエスト／レスポンスの都度書く必要がなく、全体にスッキリしていることです。例えばClientInfo型については以下のように宣言してあるだけです。

---
{-# LANGUAGE DeriveGeneric #-}
---
import GHC.Generics(Generic)
---

data ClientInfo = ClientInfo
  { clientName :: String
  , clientEmail :: String
  , clientAge :: Int
  , clientInterestedIn :: [String]
  } deriving Generic

instance FromJSON ClientInfo
instance ToJSON ClientInfo

今回は以上です。