wip, Logger and some cleanup

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.Git3.Logger
-import HBS2.Data.Log.Structured
-
-import HBS2.Git3.Config.Local
 
 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

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

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
+
+

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) )]
 

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
-