Skip to content
This repository has been archived by the owner on Oct 19, 2024. It is now read-only.

Colog example in docs will not compile #331

Open
b00kdev opened this issue Apr 20, 2022 · 1 comment
Open

Colog example in docs will not compile #331

b00kdev opened this issue Apr 20, 2022 · 1 comment

Comments

@b00kdev
Copy link

b00kdev commented Apr 20, 2022

I am wanting to add colog to my mu-haskell project. The example in the docs results in a compilation error. I have something like this:

main :: IO ()
main = runGRpcAppTrans msgProtoBuf 8080 logger server
  where logger = usingLoggerT (LogAction $ liftIO putStrLn)

which results in the error:

[2 of 2] Compiling Main

/.../logging-test/src/Main.hs:21:51: error:
    • Couldn't match expected type ‘IO (m ())’
                  with actual type ‘String -> IO ()’
    • Probable cause: ‘putStrLn’ is applied to too few arguments
      In the first argument of ‘liftIO’, namely ‘putStrLn’
      In the second argument of ‘($)’, namely ‘liftIO putStrLn’
      In the first argument of ‘usingLoggerT’, namely
        ‘(LogAction $ liftIO putStrLn)’
    • Relevant bindings include
        logger :: LoggerT msg m a -> m a (bound at src/Main.hs:21:9)
   |
21 |   where logger = usingLoggerT (LogAction $ liftIO putStrLn)
   |

That error is easy enough to fix:

main :: IO ()
main = runGRpcAppTrans msgProtoBuf 8080 logger server
  where logger = usingLoggerT (LogAction $ liftIO . putStrLn)

but then results in the following error:

/.../logging-test/src/Main.hs:20:48: error:
    • No instance for (mtl-2.2.2:Control.Monad.Error.Class.MonadError
                         ServerError
                         (LoggerT
                            String
                            (transformers-0.5.6.2:Control.Monad.Trans.Except.ExceptT
                               ServerError IO)))
        arising from a use of ‘server’
    • In the fourth argument of ‘runGRpcAppTrans’, namely ‘server’
      In the expression: runGRpcAppTrans msgProtoBuf 8080 logger server
      In an equation for ‘main’:
          main
            = runGRpcAppTrans msgProtoBuf 8080 logger server
            where
                logger = usingLoggerT (LogAction $ liftIO . putStrLn)
   |
20 | main = runGRpcAppTrans msgProtoBuf 8080 logger server
   |                                                ^^^^^^

I am not sure why I need to define an instance of MonadError to get logging working. I'd like to update the docs with a working Colog example, but cannot figure out how to make the types line up. I created a minimal project if anyone wants to take a look:

https://github.com/b00kdev/logging-test

@b00kdev
Copy link
Author

b00kdev commented Apr 20, 2022

I ended up getting it to compile and work, but I had to specialize the types quite a bit, so there is likely a more generic solution. If not, I will create a PR with these updates in the docs, but would like another pair of eyes to take a look.

module Main where

import Colog
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (ReaderT, runReaderT)
import qualified Data.Text as T
import Mu.GRpc.Server
import Mu.Server
import Schema

data Env = Env
  { envServerPort :: !Int
  , envLogAction :: !(LogAction ServerErrorIO Message)
  }

instance HasLog Env Message (ReaderT Env ServerErrorIO) where
  getLogAction = liftLogAction . envLogAction
  setLogAction newLogAction env = env { envLogAction = hoistLogAction performLogsInReaderT newLogAction }
    where
      performLogsInReaderT :: ReaderT Env ServerErrorIO a -> ServerErrorIO a
      performLogsInReaderT action = runReaderT action env

main :: IO ()
main = usingLoggerT action $ do
  let env = Env 8080 (liftLogAction action)
  logInfo ("starting server on port " <> T.pack (show (envServerPort env)))
  liftIO $ runGRpcAppTrans msgProtoBuf (envServerPort env) (`runReaderT` env) server
  where
    action = cmap fmtMessage logTextStdout

server :: (MonadServer m, WithLog env Message m) => SingleServerT i Service m _
server = singleService (method @"SayHello" sayHello)

sayHello :: (MonadServer m, WithLog env Message m) => HelloRequestMessage -> m HelloReplyMessage
sayHello (HelloRequestMessage nm) = do
  logInfo "saying hello"
  pure $ HelloReplyMessage ("hi, " <> nm)

Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant