为什么在使用带管道的 MonadLog 时需要提升

Why do I need to lift when using MonadLog with Pipes

我正在尝试让 logging-errorpipes 一起工作。我快到了——从某种意义上说,我有一些东西在工作——但我认为它不太对,我不知道如何修复它。代码:

{-# 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

readInputMessage 我需要 lift logInfo 否则它不会编译。但是 testApp logInfo 不需要解除。为什么我需要举起一个而不是另一个?

没有lift这是编译错误:

/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

认为它没有编译,因为编译器无法计算出m是什么类型,但我不知道如何修复它。

问题是 pipes 中的类型不是 MonadLog 的实例。在 testApp 中,您已声明

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

因此我们处于 MonadLog 的实例中。相比之下,对于 readInputMessage,您已声明

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

所以类型 mMonadLog 的实例,但我们 不是 类型 m ()。我们的类型是 Producer Text m ()。然后使用 lift 将我们带入 m monad,这就是您所观察到的。

解决方案是在 MonadLog 的内部 monad 是时使 Pipes 类型成为其成员。如果你愿意忍受孤儿实例,你可以写一些类似于下面的代码。

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

这个 应该 允许你在任何 Pipes 类型中使用 MonadLog 只要内部 monad 也是 MonadLog.