From e9ed97f8a82fb43992f8d1a16503e4565ea1b040 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Tue, 13 Oct 2020 12:01:04 -0700
Subject: [PATCH] king: fix zig-zag in stderr logging

---
 pkg/hs/urbit-king/lib/Urbit/King/App.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs
index 107708d16..c091473fa 100644
--- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs
@@ -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"