wip

hbs2-git3/app/Main.hs

@@ -622,20 +622,6 @@ theDict = do
               BS.hPutStr fh ghs
 
 
-        entry $ bindMatch "test:sqlite" $ nil_ $ \case
-          [ StringLike fn ] -> lift do
-              db <- newDBPipeEnv dbPipeOptsDef fn
-              withDB db do
-                all <- select_ @_ @(Only Text) [qc|select hash from githash|]
-                for_ all $ \x -> do
-                  n <- select @(Only Int) [qc|select 1 from githash where hash = ?|] (Only (fromOnly x))
-                           <&> L.null
-                  unless n do
-                    liftIO $ print $ pretty (fromOnly x)
-
-          _ -> throwIO (BadFormException @C nil)
-
-
         entry $ bindMatch "test:segment:dump" $ nil_ $ \syn -> lift do
           sto <- getStorage
           let (_, argz) = splitOpts [] syn
@@ -1036,12 +1022,12 @@ theDict = do
 
         entry $ bindMatch "reflog:tx:list" $ nil_ $ \syn -> lift $ connectedDo do
 
-          let (opts, _) = splitOpts [ ("--tree",0)
+          let (opts, _) = splitOpts [ ("--checkpoints",0)
-                                    , ("--checkpoints",0)
+                                    , ("--segments",0)
                                     ] syn
 
-          let optTree  = or [ True | ListVal [StringLike "--tree"] <- opts ]
           let cpOnly   = or [ True | ListVal [StringLike "--checkpoints"] <- opts ]
+          let sOnly    = or [ True | ListVal [StringLike "--segments"] <- opts ]
 
           sto <- getStorage
 
@@ -1059,16 +1045,13 @@ theDict = do
 
           liftIO $ forM_ hxs $ \h -> do
 
-            if not optTree && not cpOnly then
-              print $ pretty h
-            else do
             decoded <- readTxMay sto h
                <&> \case
                   Just (TxSegment x)   | not cpOnly ->
-                      Just (fill 44 (pretty h) <+> fill 44 (pretty x))
+                    Just ("S" <+> fill 44 (pretty h) <+> fill 44 (pretty x))
 
-                    Just (TxCheckpoint n x) ->
+                  Just (TxCheckpoint n x) | not sOnly ->
-                      Just (fill 44 (pretty h) <+> fill 8 (pretty n) <+> pretty x)
+                    Just ("C" <+> fill 44 (pretty h) <+> pretty x <+> fill 8 (pretty n))
 
                   _ -> Nothing
 

hbs2-git3/lib/HBS2/Git3/State/Index.hs

@@ -4,6 +4,7 @@ import HBS2.Git3.Prelude
 import HBS2.System.Dir
 import HBS2.CLI.Run.Internal.Merkle (getTreeContents)
 import HBS2.Git3.State.Types
+import HBS2.Git3.Git
 
 import HBS2.Data.Log.Structured
 
@@ -25,19 +26,9 @@ import Data.HashMap.Strict qualified as HM
 import Data.HashSet (HashSet)
 import Data.HashSet qualified as HS
 import Data.Word
-import Data.Vector (Vector)
-import Data.Vector qualified as V
-import Data.Kind
 
+import Data.Config.Suckless
 
-import Data.BloomFilter qualified as Bloom
-import Data.BloomFilter (Bloom(..))
-import Data.BloomFilter.Mutable qualified as MBloom
-
-import Control.Monad.ST
-
-import Control.Concurrent.STM qualified as STM
-import Codec.Compression.Zstd.Lazy qualified as ZstdL
 import Codec.Compression.Zstd.Streaming as ZStdS
 import Codec.Serialise
 import Streaming.Prelude qualified as S
@@ -384,8 +375,17 @@ updateReflogIndex = do
 
                   pieces <- S.toList_ $ do
                     void $ runConsumeLBS what $ readLogFileLBS () $ \o _ lbs -> do
-                      let (t, _) = LBS.splitAt 1 lbs
+                      let (t, llbs) = LBS.splitAt 1 lbs
-                      notice $ pretty (LBS8.unpack t) <+> pretty o
+                      -- notice $ pretty (LBS8.unpack t) <+> pretty o
+
+                      -- FIXME: do-something
+                      when (t == "R") do
+                        let refs = [ (t,h,x)
+                                   | ListVal [LitIntVal t, GitHashLike h, StringLike x]
+                                   <- parseTop (LBS8.unpack llbs) & fromRight mempty
+                                   ]
+                        liftIO $ mapM_ (print . pretty) refs
+
                       lift $ S.yield o
 
                   lift $ S.yield (h, pieces)