wip

fixme-new/lib/Fixme/Scan/Git/Local.hs

@@ -167,11 +167,12 @@ scanGitLogLocal refMask play = do
   let pat = [(True, refMask)]
 
   -- FIXME: use-cache-to-skip-already-processed-tips
-  logz <- S.toList_ do
-            for_ hashes $ \h -> do
+  logz <- S.toList_ $ for_ hashes $ \h -> do
+              done <- lift $ withState (isProcessed (ViaSerialise h))
+              unless done do
                 blobs <- lift (listBlobs h >>= filterBlobs0 pat)
-                 for_ blobs $ \(b,h) -> do
-                  S.yield h
+                for_ blobs $ \(_,b) -> do
+                  S.yield (h,b)
 
   warn $ yellow "STEP 3" <+> "for each tree   --- find log"
 
@@ -179,13 +180,17 @@ scanGitLogLocal refMask play = do
 
   warn $ yellow "STEP 4" <+> "for each log    --- scan log"
 
+  withState $ transactional do
+
     flip runContT pure do
-    for_ logz $ \h -> do
+      for_ logz $ \(commitHash, h) -> do
+        warn $ blue "SCAN BLOB" <+> pretty h
         tmp <- ContT $ bracket (liftIO (emptySystemTempFile "fixme-log")) rm
-      blob <- lift $ gitCatBlob h
+        blob <- lift $ lift $ gitCatBlob h
         liftIO (LBS8.writeFile tmp blob)
         sto  <- ContT $ bracket (compactStorageOpen @HbSync readonly tmp) compactStorageClose
-      lift $ loadAllEntriesFromLog sto >>= play
+        lift $ lift $ loadAllEntriesFromLog sto >>= play
+        lift $ insertProcessed (ViaSerialise commitHash)
 
 
 scanGitLocal :: FixmePerks m

fixme-new/lib/Fixme/State.hs

@@ -22,6 +22,8 @@ module Fixme.State
   , selectStageDeleted
   , selectStage
   , cleanStage
+  , insertProcessed
+  , isProcessed
   , HasPredicate(..)
   ) where
 
@@ -270,6 +272,12 @@ createTables = do
            )
          |]
 
+  ddl [qc| create table if not exists fixmeprocessed
+           ( hash   text  not null
+           , primary key (hash)
+           )
+         |]
+
 -- .fixme-new/state.db
 -- and not exists (select null from fixmedeleted d where a.fixme = id limit 1)
 
@@ -641,3 +649,20 @@ updateIndexes = withState $ transactional do
 
 
 
+insertProcessed :: (FixmePerks m, MonadReader FixmeEnv m, Hashed HbSync w)
+                => w
+                -> DBPipeM m ()
+insertProcessed what = do
+  insert [qc| insert into fixmeprocessed (hash) values(?)
+              on conflict (hash) do nothing
+            |] (Only (show $ pretty $ hashObject @HbSync what))
+
+
+isProcessed :: (FixmePerks m, MonadReader FixmeEnv m, Hashed HbSync w)
+             => w
+             -> DBPipeM m Bool
+isProcessed what = do
+  let k = show $ pretty $ hashObject @HbSync what
+  select @(Only (Maybe Int)) [qc| select null from fixmeprocessed where hash = ? limit 1 |] (Only k)
+   <&> isJust . listToMaybe
+

fixme-new/lib/Fixme/Types.hs

@@ -527,3 +527,9 @@ instance FixmeRenderTemplate SimpleTemplate Text where
       p e = [Text.pack (show $ pretty e)]
 
 
+newtype ViaSerialise a = ViaSerialise a
+
+instance Serialise a => Hashed HbSync (ViaSerialise a) where
+  hashObject (ViaSerialise x) = hashObject (serialise x)
+
+