voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, logging

This commit is contained in:
voidlizard 2025-02-01 08:00:57 +03:00
parent 478f43a528
commit 83a73e7e0d
1 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
hbs2-git3/app/GitRemoteHelper.hs
View File

@ -11,11 +11,13 @@ import HBS2.Git3.Import
import HBS2.Git3.Export import HBS2.Git3.Export
import HBS2.Git3.Git import HBS2.Git3.Git
import HBS2.Git3.Repo import HBS2.Git3.Repo
import HBS2.Git3.Logger
import Data.Config.Suckless import Data.Config.Suckless
import System.Posix.Signals import System.Posix.Signals
import System.IO qualified as IO import System.IO qualified as IO
import System.Posix.IO
import System.Exit qualified as Exit import System.Exit qualified as Exit
import System.Environment (getArgs,lookupEnv) import System.Environment (getArgs,lookupEnv)
import Text.InterpolatedString.Perl6 (qc) import Text.InterpolatedString.Perl6 (qc)
@ -134,7 +136,30 @@ main = flip runContT pure do
setupLogger setupLogger
origStderr <- liftIO $ dup stdError
(readEnd, writeEnd) <- liftIO createPipe
liftIO $ dupTo writeEnd stdError
liftIO $ closeFd writeEnd
rStderr <- liftIO $ fdToHandle readEnd
origHandle <- liftIO $ fdToHandle origStderr
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.hPutStr origHandle (replicate 100 ' ')
IO.hPutStr origHandle "\r"
IO.hPutStr origHandle s
IO.hPutStr origHandle "\r"
pause @'Seconds 0.05
ContT $ bracket none $ const do ContT $ bracket none $ const do
IO.hPutStr origHandle (replicate 100 ' ')
IO.hPutStr origHandle "\rdone\n"
silence silence
lift $ void $ installHandler sigPIPE Ignore Nothing lift $ void $ installHandler sigPIPE Ignore Nothing
@ -190,26 +215,3 @@ main = flip runContT pure do
next Plain next Plain
-- liftIO exitSuccess -- liftIO exitSuccess
-- debugPrefix :: LoggerEntry -> LoggerEntry
debugPrefix = toStderr . logPrefix "[debug] "
setupLogger :: MonadIO m => m ()
setupLogger = do
-- setLogging @DEBUG $ toStderr . logPrefix "[debug] "
setLogging @ERROR $ toStderr . logPrefix "[error] "
setLogging @WARN $ toStderr . logPrefix "[warn] "
setLogging @NOTICE $ toStderr . logPrefix ""
pure ()
flushLoggers :: MonadIO m => m ()
flushLoggers = do
silence
silence :: MonadIO m => m ()
silence = do
setLoggingOff @DEBUG
setLoggingOff @ERROR
setLoggingOff @WARN
setLoggingOff @NOTICE