読者です 読者をやめる 読者になる 読者になる

IT練習ノート

IT関連で調べたこと(実際は嵌ったこと)を書いています。

Servantのログ出力

@lotz さんの下記の記事があります。手元で動かそうとしたところ(2017/01/15時点)、記事が書かれた頃とライブラリのバージョンが変わっているため、そのままでは動作しませんでした。そこで、修正部分をメモしました。

qiita.com

修正のポイントは以下の2点です。

  • EitherTExceptTに変更します。
  • EitherTMonadLoggerインスタンスにするコードを削除します。(ExceptTMonadLoggerインスタンスになっているため)

作業手順

  • 適当な作業用のディレクトリを作ります。
  • 記事よりservant-logger-example.cabalをコピーします。
  • 記事よりapp/Main.hsをコピーします。
  • 修正をします(下記に差分のdiffをとりました)。
  • cabal installします。
  • cabal buildします。
  • dist/build/app/appを実行します。

修正の差分は次の通りです。

foo$ diff app/Main_before.hs app/Main.hs 
14c14
< import Control.Monad.Trans.Either
---
> import Control.Monad.Trans.Except
24,27c24
< instance MonadLogger m => MonadLogger (EitherT e m) where
<     monadLoggerLog a b c d = lift $ monadLoggerLog a b c d
< 
< loggingServer :: ServerT API (EitherT ServantErr (LoggingT IO))
---
> loggingServer :: ServerT API (ExceptT ServantErr (LoggingT IO))
35a33
>     Warp.run 8080 $ serve api server

修正をしないと、下記のようなコンパイルエラーとなります。

[1 of 1] Compiling Main             ( app/Main.hs, interpreted )

app/Main.hs:35:18: error:
    • Couldn't match type ‘EitherT ServantErr (LoggingT IO)’
                     with ‘Control.Monad.Trans.Except.ExceptT ServantErr (LoggingT IO)’
        arising from a functional dependency between:
          constraint ‘servant-0.9.1.1:Servant.Utils.Enter.Enter
                        (EitherT ServantErr (LoggingT IO) Text)
                        (Control.Monad.Trans.Except.ExceptT ServantErr (LoggingT IO)
                         :~> Control.Monad.Trans.Except.ExceptT ServantErr IO)
                        (Control.Monad.Trans.Except.ExceptT ServantErr IO Text)’
            arising from a use of ‘enter’
          instance ‘servant-0.9.1.1:Servant.Utils.Enter.Enter
                      (m a) (m :~> n) (n a)’
            at <no location info>
    • In the expression:
        (hoistNat (Nat runStdoutLoggingT)) `enter` loggingServer
      In an equation for ‘server’:
          server = (hoistNat (Nat runStdoutLoggingT)) `enter` loggingServer
      In the expression:
        do { putStrLn "Listening on port 8080";
             let server
                   = (hoistNat (Nat runStdoutLoggingT)) `enter` loggingServer;
             Warp.run 8080 $ serve api server }

このコンパイルエラーの解決には下記が参考になりました。

stackoverflow.com