From 540bb8fe2e4819589abb750382dfe4c4fe24d672 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 13 Oct 2018 22:36:17 +0200 Subject: [PATCH] nicer logging --- src/Application.hs | 8 +++++++- src/Jobs.hs | 6 +++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 238debdb6..4f07f3de0 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -60,6 +60,9 @@ import Network.HaskellNet.SMTP.SSL as SMTP hiding (Settings) import Data.Pool import Control.Monad.Trans.Resource + +import System.Log.FastLogger.Date +import qualified Yesod.Core.Types as Yesod (Logger(..)) -- Import all relevant handler modules here. -- (HPack takes care to add new modules to our cabal file nowadays.) @@ -91,7 +94,10 @@ makeFoundation appSettings@(AppSettings{..}) = do -- Some basic initializations: HTTP connection manager, logger, and static -- subsite. appHttpManager <- newManager - appLogger <- liftIO $ newStdoutLoggerSet defaultBufSize >>= makeYesodLogger + appLogger <- liftIO $ do + tgetter <- newTimeCache "%Y-%m-%d %T %z" + loggerSet <- newStdoutLoggerSet defaultBufSize + return $ Yesod.Logger loggerSet tgetter appStatic <- liftIO $ bool static staticDevel appMutableStatic appStaticDir appCryptoIDKey <- readKeyFile appCryptoIDKeyFile diff --git a/src/Jobs.hs b/src/Jobs.hs index ad4d77995..09b861df2 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -165,7 +165,7 @@ execCrontab = flip evalStateT HashMap.empty . forever $ do MatchAt nextTime -> do JobContext{jobCrontab} <- ask nextTime' <- applyJitter jobCtl nextTime - $logDebugS "Cron" [st|Waiting until #{tshow nextTime'} to execute #{tshow jobCtl}|] + $logDebugS "Cron" [st|Waiting until #{tshow (utcToLocalTimeTZ appTZ nextTime')} to execute #{tshow jobCtl}|] logFunc <- askLoggerIO whenM (liftIO . flip runLoggingT logFunc $ waitUntil jobCrontab currentCrontab nextTime') doJob @@ -177,7 +177,7 @@ execCrontab = flip evalStateT HashMap.empty . forever $ do applyJitter seed t = do appInstance <- getsYesod appInstanceID let - halfRange = floor $ 0.5 / acc + halfRange = truncate $ 0.5 / acc diff = evalRand ( (* acc) . fromInteger <$> getRandomR (- halfRange, halfRange)) $ mkStdGen (hash appInstance `hashWithSalt` seed) return $ addUTCTime diff t @@ -196,7 +196,7 @@ execCrontab = flip evalStateT HashMap.empty . forever $ do waitUntil :: (Eq a, MonadResourceBase m, MonadLogger m) => TVar a -> a -> UTCTime -> m Bool waitUntil crontabTV crontab nextTime = runResourceT $ do diffT <- diffUTCTime nextTime <$> liftIO getCurrentTime - let waitTime = fromInteger (floor $ diffT / acc) * toRational acc + let waitTime = fromInteger (truncate $ diffT / acc) * toRational acc waitTime' = realToFrac waitTime :: NominalDiffTime $logDebugS "waitUntil" [st|#{tshow diffT} (#{tshow waitTime'})|] if