wip

fixme-new/lib/Fixme/Run.hs

@@ -514,7 +514,7 @@ runForms ss = for_  ss $ \s -> do
       deleteFixme hash
 
     ListVal [SymbolVal "added", FixmeHashLike _] -> do
-      -- we dont' add fixmies at that stage
+      -- we don't add fixmies at this stage
       -- but in fixme-import
       none
 
@@ -565,23 +565,33 @@ runForms ss = for_  ss $ \s -> do
 
     ListVal [SymbolVal "import-fixmies", StringLike fn] -> do
       warn $ red "IMPORT-FIXMIES" <+> pretty fn
-      sto <- compactStorageOpen @HbSync mempty fn
+
+      fset <- listAllFixmeHashes
+
+      sto <- compactStorageOpen @HbSync readonly fn
       ks   <- keys sto
 
       toImport <- S.toList_ do
         for_ ks $ \k -> runMaybeT do
           v <- get sto k & MaybeT
-          Added _ fx <- deserialiseOrFail @CompactAction (LBS.fromStrict v) & toMPlus
-          let ha = hashObject @HbSync (serialise fx)
-          here <- lift $ lift $ checkFixmeExists (HashRef ha)
-          unless here do
-            warn $ red "import" <+> viaShow (pretty ha)
-            lift $ S.yield fx
+          what <- deserialiseOrFail @CompactAction (LBS.fromStrict v) & toMPlus
+
+          case what of
+            Added _ fx  -> do
+              let ha = hashObject @HbSync (serialise fx) & HashRef
+              unless (HS.member ha fset) do
+                warn $ red "import" <+> viaShow (pretty ha)
+                lift $ S.yield (Right fx)
+            w -> lift $ S.yield (Left $ fromRight mempty $ parseTop (show $ pretty w))
 
       withState $ transactional do
-        for_ toImport insertFixme
+        for_ (rights  toImport) insertFixme
 
-      updateIndexes
+      let w = lefts toImport
+      runForms (mconcat w)
+
+      unless (List.null toImport) do
+        updateIndexes
 
       compactStorageClose sto
 

fixme-new/lib/Fixme/State.hs

@@ -26,6 +26,7 @@ module Fixme.State
   , isProcessed
   , selectProcessed
   , checkFixmeExists
+  , listAllFixmeHashes
   , HasPredicate(..)
   , SelectPredicate(..)
   ) where
@@ -39,6 +40,8 @@ import Data.Config.Suckless
 import Data.Config.Suckless.Syntax
 import DBPipe.SQLite hiding (field)
 
+import Data.HashSet (HashSet)
+import Data.HashSet qualified as HS
 import Data.Aeson as Aeson
 import Data.HashMap.Strict qualified as HM
 import Text.InterpolatedString.Perl6 (q,qc)
@@ -441,6 +444,11 @@ selectFixme txt = do
       <&> over (field @"fixmeAttr") (<> attrs)
 
 
+listAllFixmeHashes :: (FixmePerks m, MonadReader FixmeEnv m) => m (HashSet HashRef)
+listAllFixmeHashes = withState do
+  select_ @_ @(Only HashRef) [qc|select id from fixme|]
+    <&> HS.fromList . fmap fromOnly
+
 checkFixmeExists :: FixmePerks m => HashRef -> FixmeM m Bool
 checkFixmeExists what = withState do
   select @(Only (Maybe Int)) [qc|select 1 from fixme where id = ? limit 1|] (Only what)