More than 3 years have passed since last update.

【Servant】(8) Another Monad

Last updated at 2020-03-15Posted at 2020-02-24

今回は、以下の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  ###実行結果

今回は以上です

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up