combining runStdoutLoggingT, runReaderT and enter

[Félix Sipma]

Hi,

I'm having problems combining ReaderT and LoggingT (from monad-logger)
in a custom Handler type.

The following code is compiling (with "stack ghc Main.hs"), but I'd
like to replace "type Handler = ExceptT ServantErr (LoggingT IO)" with
"type Handler = ReaderT String (ExceptT ServantErr (LoggingT IO))" and
have the code compiling again. I don't get how to define "server"...
Would someone have an idea of what I could do?


#!/usr/bin/env stack
-- stack runghc --package mtl --package monad-logger --package warp --package servant-server
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.Logger (LoggingT, logInfo, runStdoutLoggingT)
import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT, runReaderT)
import qualified Network.Wai.Handler.Warp as Warp
import Servant hiding (Handler)

-- type Handler = ReaderT String (ExceptT ServantErr (LoggingT IO))
type Handler = ExceptT ServantErr (LoggingT IO)

type API = Get '[PlainText] String

api :: Proxy API
api = Proxy

loggingServer :: ServerT API Handler
loggingServer = success

success :: Handler String
success = do
$(logInfo) "test"
pure "success"

main :: IO ()
main = do
let server = hoistNat (Nat runStdoutLoggingT) `enter` loggingServer
-- let server = ???
Warp.run 8080 $ serve api server


--
Félix Sipma

[Alp Mestanogullari]

Hi Félix (or should I say "salut"? =P)

It might be useful here to look at all of this from a distance. What this whole 'enter' business is about is: servant only knows how to generate HTTP responses in 'ExceptT ServantErr IO'. If you want any other monad, you have to provide servant with a bridge to go from your monad to servant's. That's what you successfully did for injecting logging support into your handlers.

ExceptT ServantErr (LoggingT IO)               Monad1

                       |  f

                       v

       ExceptT ServantErr IO                          Monad0

It turns out that those "mappings" compose. If you know how to get from Monad1 to Monad0 (referring to this function here as 'f'), and now want to use some Monad2 (ReaderT String Monad1) in your case, all you have to do is define a mapping from Monad2 to Monad1 (say 'g'). Then, when you call enter, all you have to do is to compose the two functions to go from Monad2 to Monad0.

ReaderT String (ExceptT ServantErr (LoggingT IO))     Monad2

                                     |     g

                                     v
             ExceptT ServantErr (LoggingT IO)                   Monad1

                                     |     f

                                     v
                        ExceptT ServantErr IO                          Monad0

In your case, Monad2 is just Monad1 wrapped in ReaderT, so you have to
do something along the lines of:

hoistNat (Nat runStdoutLoggingT) . Nat (runReaderT "someString")

where the '.' here is the one from Control.Category, since those 'Nat's are not good old functions and can't be composed using our good old '.' from Prelude.

--
Félix Sipma

--
You received this message because you are subscribed to the Google Groups "haskell-servant" group.
To unsubscribe from this group and stop receiving emails from it, send an email to haskell-servant+unsubscribe@googlegroups.com.
To post to this group, send email to haskell-servant@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/haskell-servant/20160912071457.f7jddpzvud3623v2%40capeo.
For more options, visit https://groups.google.com/d/optout.

--

Alp Mestanogullari

[Félix Sipma]

Oh, yes! I spent hours trying to try all the possible combinations of
"hoistNat", "Nat", ".", but I forgot about the different "." for
categories and normal functions. I should have been more awaken during
my category courses :-).

A little point of detail: you forgot a flip:
hoistNat (Nat runStdoutLoggingT) . Nat (flip runReaderT "someString")

Thank you very much for your detailed explanation!

>> email to haskell-serva...@googlegroups.com.
>> To post to this group, send email to haskell...@googlegroups.com.

>> To view this discussion on the web visit https://groups.google.com/d/
>> msgid/haskell-servant/20160912071457.f7jddpzvud3623v2%40capeo.
>> For more options, visit https://groups.google.com/d/optout.

--

Félix Sipma

[Félix Sipma]

Hi,

Thanks to Alp, I had a working example:

#!/usr/bin/env stack
-- stack --resolver lts-8.24 runghc --package mtl --package monad-logger --package warp --package servant-server

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.Logger (LoggingT, logInfo, runStdoutLoggingT)
import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT, runReaderT)
import qualified Network.Wai.Handler.Warp as Warp
import Servant hiding (Handler)

import qualified Control.Category as C

type Handler = ReaderT String (ExceptT ServantErr (LoggingT IO))

type API = Get '[PlainText] String

api :: Proxy API
api = Proxy

loggingServer :: ServerT API Handler
loggingServer = success

success :: Handler String
success = do
$(logInfo) "test"
pure "success"

main :: IO ()
main = do

let nt = hoistNat (Nat runStdoutLoggingT) C.. Nat (`runReaderT` "someString")
server = nt `enter` loggingServer

Warp.run 8080 $ serve api server

Now if I try to upgrade to lts-9.2 (with servant-0.11 instead of servant-0.9),
I get:

test.hs:34:24: error:
Data constructor not in scope:
Nat :: (LoggingT m0 a0 -> m0 a0) -> m1 :~> n

test.hs:34:51: error:
Data constructor not in scope:
Nat :: (ReaderT [Char] m2 a1 -> m2 a1) -> a :~> t m1

test.hs:36:31: error:
• Couldn't match type ‘Servant.Utils.Enter.Entered
m3
(t0 n0)
(ReaderT String (ExceptT ServantErr (LoggingT IO)) [Char])’
with ‘Servant.Server.Internal.Handler.Handler [Char]’
Expected type: Server API
Actual type: Servant.Utils.Enter.Entered
m3
(t0 n0)
(ReaderT String (ExceptT ServantErr (LoggingT IO)) [Char])
The type variables ‘m3’, ‘t0’, ‘n0’ are ambiguous
• In the second argument of ‘serve’, namely ‘server’
In the second argument of ‘($)’, namely ‘serve api server’
In a stmt of a 'do' block: Warp.run 8080 $ serve api server
• Relevant bindings include
server :: Servant.Utils.Enter.Entered
m3
(t0 n0)
(ReaderT String (ExceptT ServantErr (LoggingT IO)) [Char])
(bound at test.hs:35:9)

The first errors are easy to fix, by converting Nat to NT, but I don't get how
to fix the last one... I've tried to look at the modifications to Handler
and Enter, without success so far. Could someone help me on this?

You can find the example code with the lts-8.24 -> lts-9.2 and Nat -> NT
conversion attached, just run `stack test.hs` to compile it.

Thanks!

--
Félix

[Félix Sipma]

OK, I think I finally got something working by changing my Handler type to a
new AppHandler type:

#!/usr/bin/env stack
-- stack --resolver lts-9.2 runghc --package mtl --package monad-logger --package warp --package servant-server

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.Logger (LoggingT, logInfo, runStdoutLoggingT)
import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT, runReaderT)
import qualified Network.Wai.Handler.Warp as Warp
import Servant

import qualified Control.Category as C

import qualified Servant.Server.Internal.Handler as SH

type AppHandler = ReaderT String (LoggingT Handler)

type API = Get '[PlainText] String

api :: Proxy API
api = Proxy

loggingServer :: ServerT API AppHandler
loggingServer = success

success :: AppHandler String

success = do
$(logInfo) "test"
pure "success"

appHandlerToHandler :: AppHandler :~> Handler
appHandlerToHandler = NT appHandlerToHandler'
where
appHandlerToHandler' :: AppHandler a -> Handler a
appHandlerToHandler' h = runStdoutLoggingT $ runReaderT h "someString"

main :: IO ()
main = do

let server = appHandlerToHandler `enter` loggingServer

Warp.run 8080 $ serve api server

Please comment if you see an aberration there!

--
Félix Sipma