From 6dbff6b59886adfe4505ce8598e19dfcd790dbf2 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Fri, 24 Jan 2025 06:34:37 +0300
Subject: [PATCH] wip, Logger and some cleanup

---
 hbs2-git3/app/Main.hs             | 63 +------------------------------
 hbs2-git3/hbs2-git3.cabal         |  1 +
 hbs2-git3/lib/HBS2/Git3/Logger.hs | 32 ++++++++++++++++
 hbs2-git3/lib/HBS2/Git3/Run.hs    |  7 +++-
 hbs2-git3/lib/HBS2/Git3/State.hs  |  3 +-
 5 files changed, 41 insertions(+), 65 deletions(-)
 create mode 100644 hbs2-git3/lib/HBS2/Git3/Logger.hs

diff --git a/hbs2-git3/app/Main.hs b/hbs2-git3/app/Main.hs
index 9150c683..8e5faac3 100644
--- a/hbs2-git3/app/Main.hs
+++ b/hbs2-git3/app/Main.hs
@@ -4,71 +4,10 @@ module Main where
 import HBS2.Git3.Prelude
 import HBS2.Git3.Run
 import HBS2.Git3.State
-
-import HBS2.Data.Log.Structured
-
-import HBS2.Git3.Config.Local
+import HBS2.Git3.Logger
 
 import Data.Config.Suckless.Script
-
-import Data.ByteString.Lazy qualified as LBS
-import Network.ByteOrder qualified as N
-import Data.HashSet qualified as HS
-import Data.HashSet (HashSet(..))
-import Streaming.Prelude qualified as S
-
 import System.Environment qualified as E
-import Crypto.Hash qualified as C
-
-{- HLINT ignore "Functor law" -}
-{- HLINT ignore "Eta reduce" -}
-
-readIndexFromFile :: forall m . MonadIO m
-                  => FilePath
-                  -> m (HashSet GitHash)
-readIndexFromFile fname = do
-
-    bs <- liftIO $ LBS.readFile fname
-
-    r <- S.toList_ $ runConsumeLBS bs $ flip fix 0 \go n -> do
-      done <- noBytesLeft
-      if done then pure ()
-        else do
-          _  <- readBytesMaybe 4
-                  >>= orThrow SomeReadLogError
-                  <&> fromIntegral . N.word32 . LBS.toStrict
-
-          hash   <- readBytesMaybe 20
-                       >>= orThrow SomeReadLogError
-                       <&> GitHash . LBS.toStrict
-
-          lift (S.yield hash)
-          go (succ n)
-
-    pure $ HS.fromList r
-
-
--- 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
 
 main :: IO ()
 main = flip runContT pure do
diff --git a/hbs2-git3/hbs2-git3.cabal b/hbs2-git3/hbs2-git3.cabal
index eca1b959..cb540eea 100644
--- a/hbs2-git3/hbs2-git3.cabal
+++ b/hbs2-git3/hbs2-git3.cabal
@@ -127,6 +127,7 @@ library
       HBS2.Git3.Import
       HBS2.Git3.Repo
       HBS2.Git3.Run
+      HBS2.Git3.Logger
       HBS2.Git3.State
       HBS2.Git3.State.Internal.Types
       HBS2.Git3.State.Internal.RefLog
diff --git a/hbs2-git3/lib/HBS2/Git3/Logger.hs b/hbs2-git3/lib/HBS2/Git3/Logger.hs
new file mode 100644
index 00000000..c4ecd980
--- /dev/null
+++ b/hbs2-git3/lib/HBS2/Git3/Logger.hs
@@ -0,0 +1,32 @@
+module HBS2.Git3.Logger ( setupLogger
+                        , flushLoggers
+                        , silence
+                        , debugPrefix
+                        ) where
+
+import HBS2.Git3.Prelude
+
+-- debugPrefix :: LoggerEntry -> LoggerEntry
+-- 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
+
+
diff --git a/hbs2-git3/lib/HBS2/Git3/Run.hs b/hbs2-git3/lib/HBS2/Git3/Run.hs
index 99d3ea1d..7e77ba43 100644
--- a/hbs2-git3/lib/HBS2/Git3/Run.hs
+++ b/hbs2-git3/lib/HBS2/Git3/Run.hs
@@ -12,6 +12,7 @@ import HBS2.Git3.Export
 import HBS2.Git3.Import
 import HBS2.Git3.State
 import HBS2.Git3.Repo qualified as Repo
+import HBS2.Git3.Logger
 
 import Data.Config.Suckless.Script
 
@@ -92,6 +93,9 @@ compression      ;  prints compression level
 
           _ -> throwIO (BadFormException @C nil)
 
+        entry $ bindMatch "quiet" $ nil_ $ const $ lift do
+          silence
+
         entry $ bindMatch "index-block-size" $ nil_ \case
           [ LitIntVal size ]-> lift do
             setIndexBlockSize (fromIntegral size)
@@ -457,7 +461,8 @@ compression      ;  prints compression level
 
             liftIO $ print $ pretty (AsBase58 reflog)
 
-        entry $ bindMatch "repo:credentials" $ nil_ $ const $ lift $ connectedDo do
+        entry $ bindMatch "repo:credentials" $ nil_ $ const $ lift $ connectedDo $ do
+          waitRepo (Just 10)
           (p,_) <- getRepoRefLogCredentials
           liftIO $ print $ pretty $ mkForm @C "matched" [mkSym (show $ pretty ( AsBase58 p) )]
 
diff --git a/hbs2-git3/lib/HBS2/Git3/State.hs b/hbs2-git3/lib/HBS2/Git3/State.hs
index 6cb5b092..2041e808 100644
--- a/hbs2-git3/lib/HBS2/Git3/State.hs
+++ b/hbs2-git3/lib/HBS2/Git3/State.hs
@@ -307,6 +307,5 @@ waitRepo timeout = do
 
         lift $ updateRepoKey repoKey
 
-        liftIO $ print $ "reflog" <+> pretty (AsBase58 reflog) <+> pretty rv
-
+        debug $ "reflog" <+> pretty (AsBase58 reflog) <+> pretty rv