没有Foundation的日志记录时如何避免空行?

时间:2014-12-01 18:57:39

标签: haskell yesod

我有一个带有购物车的Yesod应用程序,效果很好。我现在想要在外部应用程序中清除过期的购物车(" app / tasks.hs"在脚手架中)将与cron一起运行。以下代码有效,但每条日志消息后面都有一个空行。难道我做错了什么?问题:如何将其转换为快速记录器?我已经在脚手架中阅读了Application.hs,但我没有管理如何避免创建基础......

import Control.Monad.Logger                 (runStdoutLoggingT, LoggingT)
import Database.Persist.Sqlite              (runSqlPool)
import Data.Text                            (append)
import Import
import qualified Database.Esqueleto as E

runQueries :: UTCTime -> NominalDiffTime -> SqlPersistT (ResourceT (LoggingT IO)) ()
runQueries now expiration = do
    $(logInfo) "Delete expired shopping carts."
    carts <-
        E.select $
        E.from $ \(c, u) -> do
        E.where_ (     c E.^. CartUpdated E.<. E.val (addUTCTime (- expiration) now)
                 E.&&. c E.^. CartCustomer E.==. u E.^. UserId
                 )
        return (c, u)
    forM_ carts $ \(cart, user) -> do
        cartitems <- selectList [ CartItemCart ==. entityKey cart ] []
        forM_ cartitems $ \ci -> do
            update (cartItemItem $ entityVal ci) [ItemStock +=. (cartItemQuantity $ entityVal ci)]
            delete $ entityKey ci
        delete $ entityKey cart
        $(logInfo) $ "Deleted cart: " `append` (userEmail $ entityVal user)

main :: IO ()
main = do
    -- Get the settings from all relevant sources
    settings <- loadAppSettingsArgs
        -- fall back to compile-time values, set to [] to require values at runtime
        [configSettingsYmlValue]

        -- allow environment variables to override
        useEnv

    now <- getCurrentTime

    pool <- createPoolConfig (appDatabaseConf settings)

    runStdoutLoggingT $ runResourceT $ runSqlPool (runQueries now $ appCartExpiration settings) pool

1 个答案:

答案 0 :(得分:3)

好的捕获,这实际上是monad-logger中的一个错误。我已经发布了修复它的0.3.10.1版本。

编辑以下是使用monad-logger快速记录器的示例:

{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Control.Monad.Logger
import System.Log.FastLogger
import Control.Concurrent (threadDelay)

main :: IO ()
main = do
    loggerSet <- newStderrLoggerSet defaultBufSize
    let logFunc loc src level str = do
            pushLogStr loggerSet (defaultLogStr loc src level str)
    flip runLoggingT logFunc $ do
        $logInfo "foo"
        $logInfo "foo"
        $logInfo "foo"
        $logInfo "foo"
    flushLogStr loggerSet