Why do I need to lift when using MonadLog with Pipes

Question

I'm trying to get logging-error working with pipes. I'm nearly there—in the sense that I have something working—but I don't think it's quite right and I don't know how to fix it. The code:

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Main where

import           Protolude hiding ((<>), empty, for, get)

import           Control.Monad.Log
import           Text.PrettyPrint.Leijen.Text

import           Pipes


testApp :: (MonadIO m, MonadLog (WithSeverity Doc) m) => m ()
testApp = logInfo $ textStrict "Logging works. Yah!"


printMessage :: (MonadIO m, MonadLog (WithSeverity Doc) m) => Consumer Text m ()
printMessage = forever $ await >>= putStrLn


readInputMessage :: (MonadIO m, MonadLog (WithSeverity Doc) m) => Producer Text m ()
readInputMessage = forever action      
  where
    action = do
      liftIO $ putStr ("> " :: Text)
      liftIO getLine >>= yield
      lift $ logInfo $ text "Waits with abated breath"


runMyLogging :: MonadIO m => LoggingT (WithSeverity Doc) m a -> m a
runMyLogging f = runLoggingT f (print . renderWithSeverity identity)


runPipesApp :: IO ()
runPipesApp = runMyLogging $ runEffect $
        readInputMessage
    >-> printMessage


runTestApp :: IO ()
runTestApp = runMyLogging testApp


main :: IO ()
main = do
  runTestApp
  runPipesApp

In readInputMessage I need to lift logInfo otherwise it won't compile. However testApp logInfo dosen't need to be lift'ed. Why do I need to lift in one but not the other?

Without lift this is the compilation error:

/home/rgh/dev/haskell/fa-logging/app/Main.hs:29:7: error:
    • Could not deduce (MonadLog
                          (WithSeverity Doc) (Pipes.Proxy X () () Text m))
        arising from a use of ‘logInfo’
      from the context: (MonadIO m, MonadLog (WithSeverity Doc) m)
        bound by the type signature for:
                   readInputMessage :: forall (m :: * -> *).
                                       (MonadIO m, MonadLog (WithSeverity Doc) m) =>
                                       Producer Text m ()
        at app/Main.hs:23:1-84
    • In a stmt of a 'do' block:
        logInfo $ text "Waits with abated breath"
      In the expression:
        do liftIO $ putStr ("> " :: Text)
           liftIO getLine >>= yield
           logInfo $ text "Waits with abated breath"
      In an equation for ‘action’:
          action
            = do liftIO $ putStr ("> " :: Text)
                 liftIO getLine >>= yield
                 logInfo $ text "Waits with abated breath"
   |
29 |       logInfo $ text "Waits with abated breath"
   |       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

--  While building package fa-logging-0.0.0 using:
      /srv/cache/rgh/.stack/setup-exe-cache/x86_64-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.0.2_ghc-8.2.1 --builddir=.stack-work/dist/x86_64-linux-nopie/Cabal-2.0.0.2 build lib:fa-logging exe:fa-logging --ghc-options " -ddump-hi -ddump-to-file"
    Process exited with code: ExitFailure 1

I think it's not compiling because the compiler can't work out what type m is but I don't know how to fix it.

Answer 1

The problem is that the types in pipes aren't instances of MonadLog. In testApp, you've declared

(MonadLog (WithSeverity Doc) m) => m ()

So we are in an instance of MonadLog. Comparatively, for readInputMessage, you've declared

(MonadLog (WithSeverity Doc) m) => Producer Text m ()

So the type m is an instance of MonadLog, but we're not in type m (). We're in type Producer Text m (). Using lift then takes us into the m monad, which is what you've observed.

The solution is to make the Pipes types members of MonadLog when it's inner monad is. If you're willing to put up with orphan instances, you can write something similar to the code below.

instance (MonadLog m) => MonadLog Proxy a' a b' b m r  where
    askLogger = lift askLogger
    localLogger f = lift  . localLogger x

This should allow you to use MonadLog in any of the Pipes types as long as the inner monad is also a MonadLog.