wip, ok

.fixme-new/config

@@ -38,7 +38,7 @@ fixme-comments ";" "--"
 )
 
 (fixme-play-log-action
-;  (hello kitty)
+  (hello kitty)
 )
 
 (define-template short

.fixme-new/log

@@ -1,2 +1,7 @@
 deleted "6R2raAzjbViHZVk24zwUr7rwgfepHTdXeW6Lbqw3q25A"
 deleted "DtcQir9mHe7R5ixYGXTbsXGPeVGV8TqAMmrvYgGy1wGB"
+modified "2XpT9uxrz3yu9jtYtu46jfs8ZFr8s3PVAZREJWTCSdYx" "workflow" "done"
+modified 0 "2XpT9uxrz3yu9jtYtu46jfs8ZFr8s3PVAZREJWTCSdYx" "workflow" "done"
+modified "2XpT9uxrz3yu9jtYtu46jfs8ZFr8s3PVAZREJWTCSdYx" "workflow" "done"
+modified "2XpT9uxrz3yu9jtYtu46jfs8ZFr8s3PVAZREJWTCSdYx" "workflow" "done"
+modified "2XpT9uxrz3yu9jtYtu46jfs8ZFr8s3PVAZREJWTCSdYx" "workflow" "backlog"

fixme-new/lib/Fixme/Run.hs

@@ -583,6 +583,22 @@ delete txt = do
       liftIO $ what (Literal noContext syn)
 
 
+modify_ :: FixmePerks m => Text -> String -> String -> FixmeM m ()
+modify_ txt a b = do
+  acts <- asks fixmeEnvUpdateActions >>= readTVarIO
+
+  void $ runMaybeT do
+
+    ha <- toMPlus =<< lift (selectFixmeHash txt)
+    let syn = mkLit @Text [qc|modified "{pretty ha}" "{a}" "{b}"|]
+
+    debug $ red $ pretty syn
+
+    for_ acts $ \(UpdateAction what) -> do
+      liftIO $ what (Literal noContext syn)
+
+
+
 printEnv :: FixmePerks m => FixmeM m ()
 printEnv = do
   g <- asks fixmeEnvGitDir
@@ -646,6 +662,7 @@ splitForms s0 = runIdentity $ S.toList_ (go mempty s0)
 sanitizeLog :: [Syntax c] -> [Syntax c]
 sanitizeLog lls = flip filter lls $ \case
   ListVal (SymbolVal "deleted" : _) -> True
+  ListVal (SymbolVal "modified" : _) -> True
   _ -> False
 
 pattern Template :: forall {c}. Maybe Id -> [Syntax c] -> [Syntax c]
@@ -757,6 +774,17 @@ run what = do
         ListVal [SymbolVal "delete", FixmeHashLike hash] -> do
           delete hash
 
+        ListVal [SymbolVal "modify", FixmeHashLike hash, StringLike a, StringLike b] -> do
+          modify_ hash a b
+
+        ListVal [SymbolVal "modified", TimeStampLike t, FixmeHashLike hash, StringLike a, StringLike b] -> do
+          debug $ green $ pretty s
+          updateFixme (Just t) hash (fromString a) (fromString b)
+
+        ListVal [SymbolVal "modified", FixmeHashLike hash, StringLike a, StringLike b] -> do
+          debug $ green $ pretty s
+          updateFixme Nothing hash (fromString a) (fromString b)
+
         ListVal [SymbolVal "deleted", FixmeHashLike hash] -> do
           deleteFixme hash
 
@@ -769,7 +797,7 @@ run what = do
           notice $ "hello" <+> pretty xs
 
         ListVal (SymbolVal "define-template" : SymbolVal who : IsSimpleTemplate xs) -> do
-          debug $ "define-template" <+> pretty who <+> "simple" <+> hsep (fmap pretty xs)
+          trace $ "define-template" <+> pretty who <+> "simple" <+> hsep (fmap pretty xs)
           t <- asks fixmeEnvTemplates
           atomically $ modifyTVar t (HM.insert who (Simple (SimpleTemplate xs)))
 
@@ -785,7 +813,9 @@ run what = do
           env <- ask
           t <- asks fixmeEnvUpdateActions
           let repl syn = [ ( "$1", syn ) ]
-          let action = UpdateAction @c $ \syn -> liftIO (withFixmeEnv env (runForms (inject (repl syn) xs)))
+          let action = UpdateAction @c $ \syn -> do
+                           liftIO (withFixmeEnv env (runForms (inject (repl syn) xs)))
+
           atomically $ modifyTVar t (<> [action])
 
         ListVal (SymbolVal "fixme-play-log-action" : xs) -> do

fixme-new/lib/Fixme/State.hs

@@ -8,6 +8,7 @@ module Fixme.State
   , selectFixmeHash
   , selectFixme
   , deleteFixme
+  , updateFixme
   , insertCommit
   , insertBlob
   , selectObjectHash
@@ -154,8 +155,8 @@ createTables = do
           row_number() over (partition by fixme, name order by ts desc nulls first) as rn
         from fixmeattr
         where not ({commits})
-      ),
-      ranked2 as (
+      )
+      , ranked2 as (
         select
           fixme,
           name,
@@ -520,6 +521,20 @@ deleteFixme hash = withState do
             |] (Only hash)
 
 
+updateFixme :: (FixmePerks m,MonadReader FixmeEnv m)
+            => Maybe FixmeTimestamp
+            -> Text
+            -> FixmeAttrName
+            ->  FixmeAttrVal
+            -> m ()
+
+updateFixme ts hash a b = withState do
+  warn $ red "updateFixme" <+> pretty hash
+  insert [qc| insert into fixmeattr (fixme,ts,name,value)
+              values (?,coalesce(?,strftime('%s', 'now')),?,?)
+              on conflict(fixme,ts,name) do update set value = excluded.value
+            |] (hash,ts,a,b)
+
 updateIndexes :: (FixmePerks m, MonadReader FixmeEnv m) => m ()
 updateIndexes = withState $ transactional do
   update_ [qc|delete from fixmeactual|]

fixme-new/lib/Fixme/Types.hs

@@ -24,11 +24,9 @@ import Data.Maybe
 import Data.Coerce
 import Data.Text qualified as Text
 import Data.List qualified as List
-import Data.Either
 import Data.Map qualified as Map
 import System.FilePath
 import Text.InterpolatedString.Perl6 (qc)
-import Lens.Micro.Platform
 
 
 pattern StringLike :: forall {c} . String -> Syntax c
@@ -40,6 +38,10 @@ pattern StringLikeList e <- (stringLikeList -> e)
 pattern FixmeHashLike :: forall {c} . Text -> Syntax c
 pattern FixmeHashLike  e <- (fixmeHashFromSyn -> Just e)
 
+
+pattern TimeStampLike :: forall {c} . FixmeTimestamp -> Syntax c
+pattern TimeStampLike  e <- (tsFromFromSyn -> Just e)
+
 stringLike :: Syntax c -> Maybe String
 stringLike = \case
   LitStrVal s -> Just $ Text.unpack s
@@ -57,6 +59,11 @@ fixmeHashFromSyn = \case
 
   _            -> Nothing
 
+tsFromFromSyn :: Syntax c -> Maybe FixmeTimestamp
+tsFromFromSyn = \case
+  LitIntVal n -> Just (fromIntegral n)
+  _ -> Nothing
+
 newtype FixmeTag = FixmeTag { fromFixmeTag :: Text }
                    deriving newtype (Eq,Ord,Show,IsString,Hashable,Semigroup,Monoid,ToField,FromField)
                    deriving stock (Data,Generic)