diff --git a/hbs2-git3/app/GitRemoteHelper.hs b/hbs2-git3/app/GitRemoteHelper.hs index bb27c86c..7e634d93 100644 --- a/hbs2-git3/app/GitRemoteHelper.hs +++ b/hbs2-git3/app/GitRemoteHelper.hs @@ -28,6 +28,8 @@ import Data.Maybe import Data.Config.Suckless.Script import System.Exit hiding (die) +import System.Console.ANSI + {- HLINT ignore "Use isEOF" -} {- HLINT ignore "Use putStrLn" -} @@ -79,6 +81,7 @@ localDict DeferredOps{..} = makeDict @C do waitRepo Nothing =<< getGitRepoKeyThrow importGitRefLog + notice "done importGitRefLog" rrefs <- importedRefs @@ -137,32 +140,31 @@ main = flip runContT pure do setupLogger - -- origStderr <- liftIO $ dup stdError - -- (readEnd, writeEnd) <- liftIO createPipe - -- liftIO $ dupTo writeEnd stdError - -- liftIO $ closeFd writeEnd + origStderr <- liftIO $ dup stdError + (readEnd, writeEnd) <- liftIO createPipe + liftIO $ dupTo writeEnd stdError + liftIO $ closeFd writeEnd - -- rStderr <- liftIO $ fdToHandle readEnd - -- origHandle <- liftIO $ fdToHandle origStderr + rStderr <- liftIO $ fdToHandle readEnd + origHandle <- liftIO $ fdToHandle origStderr - -- liftIO $ hSetBuffering origHandle NoBuffering + liftIO $ hSetBuffering origHandle NoBuffering - -- liftIO $ IO.hPutStr origHandle "\n" - -- ContT $ withAsync $ liftIO $ forever do - -- pause @'Seconds 0.25 - -- wut <- IO.hGetContents rStderr <&> lines - -- for_ wut $ \s -> do - -- IO.hPutStrLn rStderr s - -- IO.hPutStr origHandle (replicate 100 ' ') - -- IO.hPutStr origHandle "\r" - -- IO.hPutStr origHandle s - -- IO.hPutStr origHandle "\r" + liftIO $ IO.hPutStr origHandle "\n" + ContT $ withAsync $ liftIO $ forever do + pause @'Seconds 0.25 + wut <- IO.hGetContents rStderr <&> lines + for_ wut $ \s -> do + + hClearLine origHandle + hSetCursorColumn origHandle 0 + IO.hPutStr origHandle s + hSetCursorColumn origHandle 0 -- pause @'Seconds 0.05 - -- ContT $ bracket none $ const do - -- IO.hPutStr origHandle (replicate 100 ' ') - -- IO.hPutStr origHandle "\r" - -- silence + ContT $ bracket none $ const do + hClearLine origHandle + hSetCursorColumn origHandle 0 lift $ void $ installHandler sigPIPE Ignore Nothing env <- nullGit3Env diff --git a/hbs2-git3/hbs2-git3.cabal b/hbs2-git3/hbs2-git3.cabal index 5ac9da0e..49ae5848 100644 --- a/hbs2-git3/hbs2-git3.cabal +++ b/hbs2-git3/hbs2-git3.cabal @@ -149,6 +149,7 @@ library , base16-bytestring , binary , psqueues + , ansi-terminal , unix hs-source-dirs: lib @@ -164,6 +165,7 @@ executable hbs2-git3 , binary , psqueues , vector + , ansi-terminal , zstd hs-source-dirs: app @@ -178,6 +180,7 @@ executable git-remote-hbs23 base, hbs2-git3, hbs2-core, hbs2-peer, hbs2-git , binary , vector + , ansi-terminal hs-source-dirs: app default-language: GHC2021