Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
Help us understand the problem. What is going on with this article?

【Servant】(8) Another Monad

【Servant】(1) Wai - Qiita
【Servant】(2) Servantチュートリアル - Qiita
【Servant】(3) エンドポイントを増やす - Qiita
【Servant】(4) URLパラメータをハンドラの引数とする - Qiita
【Servant】(5) JSON - Qiita
【Servant】(6) HTML - Qiita
【Servant】(7) Post Data - Qiita
【Servant】(8) Another Monad - Qiita
【Servant】(9) Handlerモナド - Qiita
【Servant】(10) SQLite - Qiita
【Servant】(11) Servant-Client - Qiita
【Servant】(12) Basic 認証 - Qiita

今回は、以下のexample集からAnotherMonadのexampleを取り上げます。
Example Projects - haskell-servant/servant@github

Handlerに任意のモナドを使いたい場合の対応方法です。

1. Hoist server

これまで使ってきた Server 型は、実は ServerT によって以下のように定義されたものです。
Servant.Server - Hackage

Server
type Server api = ServerT api Handler

この定義のHandlerを実装するのにHandlerモナドでなく、別のモナド(例えばReaderモナド)を使い、Serverを実装するためには、Hoist serverを使います。

hoistServer
hoistServer :: HasServer api '[] => Proxy api -> (forall x. m x -> n x) -> 
                                                 ServerT api m -> ServerT api n

つまり全てのxに対して、
Reader x -> Handler x
なる関数があれば、
ServerT api Reader -> ServerT api Handler
なる変換が可能となるというものです

実際の実装を見てみましょう。

handlerServer
handlerServer :: ServerT MyServerType Handler
handlerServer = hoistServer api readerToHandler readerServer
  where
    readerToHandler :: Reader String x -> Handler x
    readerToHandler r = return $ runReader r "reader env"

以下の関数が「Reader x -> Handler x」なる関数の実装です。初期環境"reader env"を与えてReaderモナド r を走らせ、その結果をHandlerモナドのReturnで包みます。

readerToHandler
readerToHandler :: Reader String x -> Handler x
readerToHandler r = return $ runReader r "reader env"

以下がHandlerで、Readerモナドとして実装されています。オリジナルを少し変更して、Readerモナドの正常稼働を確認するために環境の値をaskしてretun値に結合するようにしています。

handlerName :: Reader String String
handlerName = do 
              r <- ask
              return $ r ++ " : sras"


handlerAge :: Reader String String
handlerAge = return "10"

readerServer :: ServerT MyServerType (Reader String)
readerServer = handlerName :<|> handlerAge

このReaderモナドを、handlerServerでHandlerモナドに変換するわけです。

2. 全ソース

AnotherMonadのソース本体

AnotherMonad.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module AnotherMonad where

import Servant ( QueryParam
               , PlainText
               , Get
               , ServerT
               , hoistServer -- Servant function to make a custom monad with with Servant.
               , Proxy(..)
               , type (:>)      -- Syntax for importing type operator
               , type (:<|>)
               , (:<|>)(..)
               )
import Servant.Server (Handler, Server, Application, serve)
import Network.Wai.Handler.Warp (run)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader

type MyServerType =  "person" :> "name" :> Get '[PlainText] String  -- The endpoint types does not have to change to accomodate a different monad
               :<|> "person" :> "age" :> Get '[PlainText] String

handlerName :: Reader String String  -- These two are our two handlers. But instead of returning a `Handler`, it returns a Reader. We will see how these handlers can be made to work with Servant.
handlerName = do 
              r <- ask
              return $ r ++ " : sras"

handlerAge :: Reader String String
handlerAge = return "10"

api :: Proxy MyServerType
api = Proxy

readerServer :: ServerT MyServerType (Reader String) -- Endpoints are combined together as before. Here the endpoint types are still our custom monad. The Reader monad.
readerServer = handlerName :<|> handlerAge           -- At the next step, we will convert this consolidated server, into something that Servant can handle.

handlerServer :: ServerT MyServerType Handler  -- This code is the important part where we convert a value of type `ServerT MyServerType (Reader String)` to a value of type `ServerT MyServerType Handler`, using the hoistServer function from Servant.
handlerServer = hoistServer api readerToHandler readerServer
  where
    readerToHandler :: Reader String x -> Handler x  -- This code just extracts the value from our custom monads (Reader here) and wraps it in the Handler monad.
    readerToHandler r = return $ runReader r "reader env"

app :: Application
app = serve api handlerServer

runServant :: IO ()
runServant = run 4000 app


-- curl -v  http://localhost:4000/person/name
-- *   Trying 127.0.0.1...
-- * Connected to localhost (127.0.0.1) port 4000 (#0)
-- > GET /person/name HTTP/1.1
-- > Host: localhost:4000
-- > User-Agent: curl/7.47.0
-- > Accept: */*
-- >
-- < HTTP/1.1 200 OK
-- < Transfer-Encoding: chunked
-- < Date: Sat, 21 Jul 2018 17:00:44 GMT
-- < Server: Warp/3.2.23
-- < Content-Type: text/plain;charset=utf-8
-- <
-- * Connection #0 to host localhost left intact
-- sras

メイン

Main.hs
module Main where

import qualified HtmlContent       as T1
import qualified PostData          as T2
import qualified CustomPostData    as T3
import qualified AnotherMonad      as T4

main :: IO ()
main = T4.runServant

使用するパッケージ

package.yaml
dependencies:
- base >= 4.7 && < 5
- servant
- servant-server
- aeson
- time
- wai
- warp
- http-media
- bytestring
- mtl

3. 実行結果

実行コマンド

stack build && stack exec first-project-exe

実行結果

$ curl -v  http://localhost:4000/person/name
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0*   Trying ::1:4000...
* TCP_NODELAY set
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
* Connected to localhost (127.0.0.1) port 4000 (#0)
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0> GET /person/name HTTP/1.1
> Host: localhost:4000
> User-Agent: curl/7.67.0
> Accept: */*
>
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Mon, 24 Feb 2020 02:49:22 GMT
< Server: Warp/3.3.5
< Content-Type: text/plain;charset=utf-8
<
{ [30 bytes data]
100    17    0    17    0     0     80      0 --:--:-- --:--:-- --:--:--    80
reader env : sras  ###実行結果

今回は以上です

sand
Haskell、Elm、Elixir、Phoenixなどが好きな言語です。 確率統計を勉強中。
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away