Merge pull request #3698 from urbit/pp/log-zag

Fix zigzag in --stderr logging
This commit is contained in:
pilfer-pandex 2020-10-13 16:15:59 -07:00 committed by GitHub
commit 4107ad0e05
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -29,6 +29,7 @@ where
import Urbit.King.Config
import Urbit.Prelude
import RIO (logGeneric)
import System.Directory ( createDirectoryIfMissing
, getXdgDirectory
, XdgDirectory(XdgCache)
@ -88,7 +89,9 @@ runKingEnvStderr verb lvl inner = do
<&> setLogUseTime True
<&> setLogUseLoc False
<&> setLogMinLevel lvl
withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner
withLogFunc logOptions $ \logFunc ->
let lf = wrapCarriage logFunc
in runKingEnv lf lf inner
runKingEnvLogFile :: Bool -> LogLevel -> Maybe FilePath -> RIO KingEnv a -> IO a
runKingEnvLogFile verb lvl fileM inner = do
@ -107,7 +110,7 @@ runKingEnvLogFile verb lvl fileM inner = do
<&> setLogUseLoc False
<&> setLogMinLevel lvl
withLogFunc stderrLogOptions $ \stderrLogFunc -> withLogFunc logOptions
$ \logFunc -> runKingEnv logFunc stderrLogFunc inner
$ \logFunc -> runKingEnv logFunc (wrapCarriage stderrLogFunc) inner
withLogFileHandle :: FilePath -> (Handle -> IO a) -> IO a
withLogFileHandle f act =
@ -115,6 +118,11 @@ withLogFileHandle f act =
hSetBuffering handle LineBuffering
act handle
-- XX loses callstack
wrapCarriage :: LogFunc -> LogFunc
wrapCarriage lf = mkLogFunc $ \_ ls ll bldr ->
runRIO lf $ logGeneric ls ll (bldr <> "\r")
defaultLogFile :: IO FilePath
defaultLogFile = do
logDir <- getXdgDirectory XdgCache "urbit"