NoLoggingT 不会在 Persistent 中禁用日志记录答案

【问题标题】：NoLoggingT does not disable logging in PersistentNoLoggingT 不会在 Persistent 中禁用日志记录
【发布时间】：2019-01-11 11:12:08
【问题描述】：

我已经编写了这段代码，但我对两件事感到困惑：

为什么这两个部分的工作方式不同，一个记录而另一个不？
如果selectFoobars 上添加了 NoLoggingT 包装器，为什么第二部分会记录？

代码：

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (ResourceT)
import Data.String.Class (toString)
import Database.Esqueleto
import Database.Persist.Sqlite (createSqlitePool)
import qualified Database.Persist.Sqlite as P
import Database.Persist.TH
import GHC.Natural
import System.Log.FastLogger (fromLogStr)

instance MonadLogger IO where
  monadLoggerLog _loc _src _lvl msg =
    putStrLn (toString (fromLogStr (toLogStr msg)))

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
Foo
  bar Natural
|]

runSomeQuery :: ConnectionPool -> Natural -> IO (Maybe Natural)
runSomeQuery pool aid = do
  flip runSqlPersistMPool pool $ do
    runMigration migrateAll
    _ <- selectFooBars aid
    return Nothing

selectFooBars ::
     Natural -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) [Entity Foo]
selectFooBars aid = do
  logDebugN "This should not log?"
  select . from $ \s -> do
    where_ $ (s ^. FooBar ==. val aid)
    limit 1
    return s

main :: IO ()
main = do
  logDebugN "MAIN"
  P.runSqlite ":memory:" $ do
    logDebugN "STARTING UP 01"
    runMigration migrateAll
    _ <- selectFooBars 123
    return ()
  budgetPool <- createSqlitePool ":memory:" 1
  logDebugN ">>>>>>>>>>>>>>>"
  logDebugN ">>>>>>>>>>>>>>>"
  logDebugN ">>>>>>>>>>>>>>>"
  logDebugN "STARTING UP 02"
  _ <- runSomeQuery budgetPool 975
  return ()

可以在https://github.com/k-bx/nologesqueleto找到完全可构建的仓库

【问题讨论】：

标签： haskell yesod persistent haskell-persistent

【解决方案1】：

似乎日志记录功能分配给连接信息本身，createSqlPool 分配在您运行createSqlitePool 的任何位置：

createSqlPool
    :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend)
    => (LogFunc -> IO backend)
    -> Int
    -> m (Pool backend)
createSqlPool mkConn size = do
    logFunc <- askLogFunc
    liftIO $ createPool (mkConn logFunc) close' 1 20 size

而runSqlite 在NoLoggingT 中显式运行其代码：

runSqlite :: (MonadUnliftIO m, IsSqlBackend backend)
          => Text -- ^ connection string
          -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database action
          -> m a
runSqlite connstr = runResourceT
                  . runNoLoggingT
                  . withSqliteConn connstr
                  . runSqlConn

所以如果你把代码改成：

  budgetPool <- runNoLoggingT $ createSqlitePool ":memory:" 1

它将停止记录。它仍然不尊重selectFooBars 类型注解中的NoLoggingT，这有点令人困惑。

【讨论】：