From 387b6bece77f7a311e6fa324b3481e167c8d6f35 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 14 May 2024 05:08:32 +0300
Subject: [PATCH] wip

---
 .fixme-new/config            |  8 ++++----
 fixme-new/lib/Fixme/Run.hs   | 17 +++++++++--------
 fixme-new/lib/Fixme/State.hs | 25 +++++++++++++++++--------
 3 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/.fixme-new/config b/.fixme-new/config
index 64c3014e..09201d76 100644
--- a/.fixme-new/config
+++ b/.fixme-new/config
@@ -9,7 +9,7 @@ fixme-prefix     TODO:
 fixme-prefix     PR:
 fixme-prefix     REVIEW:
 
-fixme-git-scan-filter-days 30
+fixme-git-scan-filter-days 600
 
 fixme-attribs assigned workflow
 
@@ -55,12 +55,12 @@ fixme-comments ";" "--"
 
      (align 8  ("[" $workflow "]"))  " "
      (align 12 $assigned)  " "
-     (trim 50  ($fixme-title))
+     (align 20 (trim 20 $committer-name)) " "
+     (trim 50  ($fixme-title)) " "
      (nl)
   )
 )
 
-
-update
+; update
 
 
diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs
index 4a7a447f..6ceff746 100644
--- a/fixme-new/lib/Fixme/Run.hs
+++ b/fixme-new/lib/Fixme/Run.hs
@@ -259,8 +259,6 @@ scanGitLocal args p =  do
 
   env <- ask
 
-  dbpath <- localDBPath
-
   flip runContT pure do
 
     (dbFn, _) <- ContT $ withSystemTempFile "fixme-db" . curry
@@ -343,7 +341,14 @@ scanGitLocal args p =  do
 
       liftIO $ IO.hSetBuffering ssin LineBuffering
 
-      for_ blobs $ \(h,fp) ->  do
+      for_ blobs $ \(h,fp) ->  callCC \next -> do
+
+        seen <-  lift (withState $ selectObjectHash h) <&> isJust
+
+        when seen do
+          trace $ red "ALREADY SEEN BLOB" <+> pretty h
+          next ()
+
         liftIO $ IO.hPrint ssin (pretty h) >> IO.hFlush ssin
         prefix <- liftIO (BS.hGetLine ssout) <&> BS.words
 
@@ -384,7 +389,6 @@ scanGitLocal args p =  do
             WHERE RelevantCommits.hash = ?
                       |]
 
-
                       what <- select @(FixmeAttrName,FixmeAttrVal) q (Only h)
                                 <&> HM.fromList
                                 <&> (<> HM.fromList [ ("blob",fromString $ show (pretty h))
@@ -424,9 +428,6 @@ scanGitLocal args p =  do
                          ] & mconcat
                            & Map.fromList
 
-            debug $ red "fxpos1" <+> pretty h <> line <> pretty (Map.toList fxpos1)
-            debug $ red "fxpos2" <+> pretty h <> line <> pretty (Map.toList fxpos2)
-
             fixmies <- for (zip [0..] rich) $ \(i,fx) -> do
                          let title = fixmeTitle fx
                          let kb = Map.lookup (title,i) fxpos2
@@ -451,9 +452,9 @@ scanGitLocal args p =  do
             debug $ "actually-import-fixmies" <+> pretty h
 
             liftIO $ withFixmeEnv env $ withState $ transactional do
+              insertBlob h
               for_ fixmies insertFixme
 
-
           _ -> fucked ()
 
       unless ( ScanRunDry `elem` args ) do
diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs
index 8ab16a27..f02d1993 100644
--- a/fixme-new/lib/Fixme/State.hs
+++ b/fixme-new/lib/Fixme/State.hs
@@ -9,7 +9,8 @@ module Fixme.State
   , selectFixme
   , deleteFixme
   , insertCommit
-  , selectCommit
+  , insertBlob
+  , selectObjectHash
   , newCommit
   , cleanupDatabase
   , updateIndexes
@@ -94,8 +95,9 @@ createTables = do
   -- в другую бд, если вдруг понадобится
 
   ddl [qc|
-        create table if not exists fixmecommit
+        create table if not exists fixmegitobject
           ( hash text not null
+          , type text null
           , primary key (hash)
           )
       |]
@@ -203,17 +205,24 @@ createTables = do
 insertCommit :: FixmePerks m => GitHash -> DBPipeM m ()
 insertCommit gh = do
   insert [qc|
-    insert into fixmecommit (hash) values(?)
+    insert into fixmegitobject (hash,type) values(?,'commit')
     on conflict (hash) do nothing
             |] (Only gh)
 
-selectCommit :: FixmePerks m => GitHash -> DBPipeM m (Maybe GitHash)
-selectCommit gh = do
-  select [qc|select hash from fixmecommit where hash = ?|] (Only gh)
+insertBlob :: FixmePerks m => GitHash -> DBPipeM m ()
+insertBlob gh = do
+  insert [qc|
+    insert into fixmegitobject (hash,type) values(?,'blob')
+    on conflict (hash) do nothing
+            |] (Only gh)
+
+selectObjectHash :: FixmePerks m => GitHash -> DBPipeM m (Maybe GitHash)
+selectObjectHash gh = do
+  select [qc|select hash from fixmegitobject where hash = ?|] (Only gh)
     <&> fmap fromOnly . listToMaybe
 
 newCommit :: (FixmePerks m, MonadReader FixmeEnv m) => GitHash -> m Bool
-newCommit gh = isNothing <$> withState (selectCommit gh)
+newCommit gh = isNothing <$> withState (selectObjectHash gh)
 
 insertFixme :: FixmePerks m => Fixme -> DBPipeM m ()
 insertFixme fx@Fixme{..} = do
@@ -418,7 +427,7 @@ cleanupDatabase = do
   withState $ transactional do
     update_ [qc|delete from fixme|]
     update_ [qc|delete from fixmeattr|]
-    update_ [qc|delete from fixmecommit|]
+    update_ [qc|delete from fixmegitobject|]
     update_ [qc|delete from fixmedeleted|]
     update_ [qc|delete from fixmerel|]
     update_ [qc|delete from fixmeactual|]