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"