From 28b6b7b71d3c9f9113af1ab2a40e09a941a2f0c4 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Mon, 9 Sep 2024 18:05:54 +0300
Subject: [PATCH] wip, modify command

---
 fixme-new/lib/Fixme/Run.hs   | 11 +++++++++--
 fixme-new/lib/Fixme/State.hs | 23 +++++++++++++++++++++++
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs
index ae36a347..496924e5 100644
--- a/fixme-new/lib/Fixme/Run.hs
+++ b/fixme-new/lib/Fixme/Run.hs
@@ -231,9 +231,8 @@ runTop forms = do
 
        entry $ bindMatch "fixme-attribs" $ nil_ \case
         StringLikeList xs -> do
-          w <- fixmeWorkDir
           ta <- lift $ asks fixmeEnvAttribs
-          atomically $ modifyTVar ta (<> HS.fromList (fmap (fromString . (</> w)) xs))
+          atomically $ modifyTVar ta (<> HS.fromList (fmap fromString xs))
 
         _ -> throwIO $ BadFormException @C nil
 
@@ -310,6 +309,14 @@ runTop forms = do
         _ -> throwIO $ BadFormException @C nil
 
 
+       entry $ bindMatch "modify" $ nil_ \case
+        [ FixmeHashLike w, StringLike k, StringLike v ] -> lift do
+          void $ runMaybeT do
+            key <- lift (selectFixmeKey w) >>= toMPlus
+            lift $ modifyFixme key [(fromString k, fromString v)]
+
+        _ -> throwIO $ BadFormException @C nil
+
        entry $ bindMatch "dump" $ nil_ $ \case
         [ FixmeHashLike w ] -> lift $ void $ runMaybeT do
           key <- lift (selectFixmeKey w) >>= toMPlus
diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs
index aebb8376..95b980ad 100644
--- a/fixme-new/lib/Fixme/State.hs
+++ b/fixme-new/lib/Fixme/State.hs
@@ -5,6 +5,7 @@ module Fixme.State
   , withState
   , cleanupDatabase
   , insertFixme
+  , modifyFixme
   , insertScanned
   , selectIsAlreadyScanned
   , selectFixmeKey
@@ -284,6 +285,28 @@ getFixme key = do
       <&> headMay
       >>= toMPlus
 
+
+modifyFixme :: (FixmePerks m)
+            => FixmeKey
+            -> [(FixmeAttrName, FixmeAttrVal)]
+            -> FixmeM m ()
+modifyFixme o a' = do
+  FixmeEnv{..} <- ask
+
+  attrNames <- readTVarIO fixmeEnvAttribs
+  values    <- readTVarIO fixmeEnvAttribValues
+
+  now <- liftIO getPOSIXTime <&> fromIntegral . round
+
+  let a = [ (k,v) | (k,v) <- a'
+          , k `HS.member` attrNames
+          , not (HM.member k values) || v `HS.member` fromMaybe mempty (HM.lookup k values)
+          ]
+
+  let w = mempty { fixmeAttr = HM.fromList a, fixmeKey = o, fixmeTs = Just now }
+
+  withState $ insertFixme w
+
 insertFixme :: (FixmePerks m, MonadReader FixmeEnv m) => Fixme -> DBPipeM m ()
 insertFixme fme = do