Why do I need to lift when using MonadLog with Pipes - haskell

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.