【Servant】(8) Another Monad

[【Servant】(1) Wai - Qiita](https://qiita.com/sand/items/16a6ef431a8376e7cbaa)
[【Servant】(2) Servantチュートリアル - Qiita](https://qiita.com/sand/items/fea7c294dd7835692ff7)
[【Servant】(3) エンドポイントを増やす - Qiita](https://qiita.com/sand/items/3af359b1830453d1d0ed)
[【Servant】(4) URLパラメータをハンドラの引数とする - Qiita](https://qiita.com/sand/items/d1c0bfb84487a1dfa9bb)
[【Servant】(5) JSON - Qiita](https://qiita.com/sand/items/fd2ea8acdc56998d5c5e)
[【Servant】(6) HTML - Qiita](https://qiita.com/sand/items/0e9f3c80b5103b966be4)
[【Servant】(7) Post Data - Qiita](https://qiita.com/sand/items/d21aed7c24521e20f1cb)
[【Servant】(8) Another Monad - Qiita](https://qiita.com/sand/items/9c8fa50815b00daead24)
[【Servant】(9) Handlerモナド - Qiita](https://qiita.com/sand/items/ae649f14f1b598d636c3)
[【Servant】(10) SQLite - Qiita](https://qiita.com/sand/items/091b0ea981152ad7d744)
[【Servant】(11) Servant-Client - Qiita](https://qiita.com/sand/items/a0e7758da7274a119849)
[【Servant】(12) Basic 認証 - Qiita](https://qiita.com/sand/items/dba678cef365fbd23ae3)



今回は、以下のexample集からAnotherMonadのexampleを取り上げます。
[Example Projects - haskell-servant/servant@github](https://github.com/haskell-servant/servant/blob/master/doc/examples.md)


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





# 1. Hoist server



これまで使ってきた **Server** 型は、実は **ServerT** によって以下のように定義されたものです。
[Servant.Server - Hackage](https://hackage.haskell.org/package/servant-server-0.17/docs/Servant-Server.html)

```haskell:Server
type Server api = ServerT api Handler
```



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


```haskell: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**
なる変換が可能となるというものです



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


```haskell: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で包みます。

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


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

```haskell:
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のソース本体

```haskell: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
```




メイン


```haskell: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
```

使用するパッケージ

```yaml: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  ###実行結果
```


今回は以上です