mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 10:02:47 +03:00
Merge pull request #3698 from urbit/pp/log-zag
Fix zigzag in --stderr logging
This commit is contained in:
commit
4107ad0e05
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user