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

康斯坦丁·雷布尼科夫

我已经制作了这段代码,但我对两件事感到困惑:

  • 为什么这两部分的工作方式不同,一个是伐木,另一个不是?
  • 如果在 .log 上添加了 NoLoggingT 包装器,为什么第二块会记录日志selectFoobars

代码:

{-# 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找到完全可构建的 repo

康斯坦丁·雷布尼科夫

似乎日志功能被分配给连接信息本身,并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在 a 中显式运行其代码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

它会停止记录。它仍然不尊重NoLoggingTselectFooBars类型注释,这是稍微有一些混乱。

本文收集自互联网,转载请注明来源。

如有侵权,请联系[email protected] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

iptables-persistent不会在引导时加载规则

来自分类Dev

剧情不会在Jupyter中显示

来自分类Dev

键盘不会在应用中关闭

来自分类Dev

JLabel不会在JPanel中截断

来自分类Dev

didSelectRowAtIndexPath不会在ViewController中触发

来自分类Dev

fgetc()不会在EOF中停止

来自分类Dev

图片不会在wordpress中显示

来自分类Dev

Python不会在终端中运行

来自分类Dev

字体不会在IE中呈现

来自分类Dev

函数不会在unityscript中运行

来自分类Dev

UIActivityIndicator不会在iOS中停止

来自分类Dev

循环不会在R中执行

来自分类Dev

UILabel不会在UIView中居中

来自分类Dev

Apache不会在uniServer中启动

来自分类Dev

onCreateView 不会在 Fragment 中触发

来自分类Dev

“hashchange”不会在 Wordpress 中触发

来自分类Dev

组件不会在反应中呈现

来自分类Dev

addValueChangeListener 不会在 android 中触发

来自分类Dev

fstrim 不会在 cronjob 中运行

来自分类Dev

图像不会在 xamarin 中显示

来自分类Dev

片段不会在活动中显示

来自分类Dev

OnGetMarkText 不会在 TContourSeries 中触发

来自分类Dev

DialogFragment 不会在 AsyncTask 中关闭

来自分类Dev

Firefox不会在浏览器中显示日志

来自分类Dev

Firefox不会在浏览器中显示日志

来自分类Dev

grizzly不会在请求中记录异常

来自分类Dev

为什么为每个模块设置日志记录级别都不会在我的代码中显示日志?

来自分类Dev

升压记录器不会在午夜旋转

来自分类Dev

Oncreate()中的动画不会在android中停止