From 83e4146d7591c106e6d173a68a003893aad1045e Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 4 Jun 2024 07:30:48 +0300
Subject: [PATCH] wip, missed files

---
 fixme-new/lib/Fixme/Run.hs   | 14 ++++++++------
 fixme-new/lib/Fixme/State.hs | 29 +++++++++++++----------------
 2 files changed, 21 insertions(+), 22 deletions(-)

diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs
index 33902703..dc7b08be 100644
--- a/fixme-new/lib/Fixme/Run.hs
+++ b/fixme-new/lib/Fixme/Run.hs
@@ -266,10 +266,9 @@ cat_ metaOnly hash = do
 delete :: FixmePerks m => Text -> FixmeM m ()
 delete txt = do
   acts <- asks fixmeEnvUpdateActions >>= readTVarIO
-  void $ runMaybeT do
-    ha <- toMPlus =<< lift (selectFixmeHash txt)
-    lift $ insertFixmeDelStaged ha
-
+  hashes <- selectFixmeHashes txt
+  for_ hashes $ \ha -> do
+    insertFixmeDelStaged ha
 
 modify_ :: FixmePerks m => Text -> String -> String -> FixmeM m ()
 modify_ txt a b = do
@@ -560,8 +559,8 @@ run what = do
 
           compactStorageClose sto
 
-        ListVal [SymbolVal "git:merge",StringLike o, StringLike target, StringLike b] -> do
-          debug $ red "git:merge" <+> pretty o <+> pretty target <+> pretty b
+        ListVal [SymbolVal "git:merge-binary-log",StringLike o, StringLike target, StringLike b] -> do
+          debug $ red "git:merge-binary-log" <+> pretty o <+> pretty target <+> pretty b
 
           temp <- liftIO $ emptyTempFile "." "merge-result"
           sa  <- compactStorageOpen @HbSync readonly o
@@ -595,6 +594,9 @@ run what = do
         ListVal [SymbolVal "builtin:clean-stage"] -> do
           cleanStage
 
+        ListVal [SymbolVal "builtin:drop-stage"] -> do
+          cleanStage
+
         ListVal [SymbolVal "builtin:show-stage"] -> do
           stage <- selectStage
           liftIO $ print $ vcat (fmap pretty stage)
diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs
index 3ee54fe9..97142e7e 100644
--- a/fixme-new/lib/Fixme/State.hs
+++ b/fixme-new/lib/Fixme/State.hs
@@ -6,6 +6,7 @@ module Fixme.State
   , insertFixme
   , selectFixmeThin
   , selectFixmeHash
+  , selectFixmeHashes
   , selectFixme
   , deleteFixme
   , updateFixme
@@ -223,6 +224,14 @@ createTables = do
     )
     select id as fixme, fixmekey, ts from rn
       where rn = 1
+      and not exists (
+      select null
+        from fixmeattr a
+             join fixmedeleted d on d.id = a.fixme
+        where a.name = 'fixme-key'
+              and a.value = rn.fixmekey
+      )
+
     |]
 
 
@@ -372,11 +381,12 @@ instance IsContext c => HasPredicate [Syntax c] where
 {- HLINT ignore "Eta reduce" -}
 
 selectFixmeHash :: (FixmePerks m) => Text -> FixmeM m (Maybe Text)
-selectFixmeHash what = withState do
+selectFixmeHash what = listToMaybe <$> selectFixmeHashes what
 
+selectFixmeHashes :: (FixmePerks m) => Text -> FixmeM m [Text]
+selectFixmeHashes what = withState do
   let w = what <> "%"
-
-  r <- select @(Only Text)
+  select @(Only Text)
             [qc| select fixme
                  from fixmejson
                  where json_extract(json,'$."fixme-key"') like ?
@@ -387,18 +397,6 @@ selectFixmeHash what = withState do
             |] (w,w)
          <&> fmap fromOnly
 
-
-  let rs = listToMaybe r
-  -- catMaybes [ (x,) <$> Text.length . view _1 <$> Text.commonPrefixes what x
-  --                    | x <- r ]
-  --            & sortBy (comparing (Down . snd))
-  --            & headMay
-  --            & fmap fst
-  -- debug $ red "selectFixmeHash" <+> pretty r <+> pretty rs
-
-  pure rs
-
-
 selectFixme :: FixmePerks m => Text -> FixmeM m (Maybe Fixme)
 selectFixme txt = do
 
@@ -595,7 +593,6 @@ cleanStage = withState do
   transactional do
     update_ [qc|delete from fixmestagedel|]
     update_ [qc|delete from fixmestagemod|]
-    pure ()
 
 deleteFixme :: (FixmePerks m,MonadReader FixmeEnv m) => Text -> m ()
 deleteFixme hash = withState do