king: fix zig-zag in stderr logging
@@ -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"
