combining runStdoutLoggingT, runReaderT and enter

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
5 messages Options
Reply | Threaded
Open this post in threaded view
|

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

--






signature.asc (817 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: combining runStdoutLoggingT, runReaderT and enter

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.


On Mon, Sep 12, 2016 at 9:14 AM, Félix Sipma <[hidden email]> wrote:
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

--
Reply | Threaded
Open this post in threaded view
|

Re: combining runStdoutLoggingT, runReaderT and enter

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!

On 2016-09-12 16:49+0200, Alp Mestanogullari wrote:

> 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.
>
> On Mon, Sep 12, 2016 at 9:14 AM, Félix Sipma <[hidden email]>
> wrote:
>
>> 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
>>
>> --
>>
>> "haskell-servant" group.
>>
>> email to [hidden email].
>>
>>
>>
--
Félix Sipma

--






signature.asc (817 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: combining runStdoutLoggingT, runReaderT and enter

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

--






test.hs (1K) Download Attachment
signature.asc (849 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: combining runStdoutLoggingT, runReaderT and enter

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

--






signature.asc (849 bytes) Download Attachment