From c5d7955e41cf16c566bd0f57304580225d93b930 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 4 Jun 2024 08:49:29 +0300
Subject: [PATCH] wip, introduced simple macros to fixme-new

---
 .fixme-new/config            |  27 +++++++++++++++++++++++++++
 .fixme-new/log               | Bin 1422 -> 1581 bytes
 fixme-new/lib/Fixme/Run.hs   |  20 +++++++++++++++++++-
 fixme-new/lib/Fixme/Types.hs |  14 ++++++++++++++
 4 files changed, 60 insertions(+), 1 deletion(-)

diff --git a/.fixme-new/config b/.fixme-new/config
index f0f221c9..138155ec 100644
--- a/.fixme-new/config
+++ b/.fixme-new/config
@@ -41,6 +41,33 @@ fixme-comments ";" "--"
   (hello kitty)
 )
 
+(define-macro done
+  (modify $1 workflow done)
+)
+
+(define-macro wip
+  (modify $1 workflow wip)
+)
+
+(define-macro test
+  (modify $1 workflow test)
+)
+
+(define-macro backlog
+  (modify $1 workflow backlog)
+)
+
+(define-macro fixed
+  (modify $1 workflow fixed)
+)
+
+(define-macro new
+  (modify $1 workflow new)
+)
+
+(define-macro stage
+  (builtin:show-stage))
+
 (define-template short
   (simple
      (trim 10  $fixme-key) " "
diff --git a/.fixme-new/log b/.fixme-new/log
index 6ab628b565b466820e3eb053e13c655858d09c98..2edf31a7b174a22817d5ae6a0b5767f0bedff284 100644
GIT binary patch
delta 168
zcmeC<UdywgkF}lw4A^*E8Ku(VRz7HAXkv&^n3M7SqycZZkC@1!`PQ*=oNpI~h<Zt=
z?)2B5zu7YR9AgthMtOcwc3Mt;c@slQN`77{gIOC;rzGpNCI$(6hA$E7zQmcNP{+Z*
Q2yp{zAC$fdq+w!t0ERa&i2wiq

delta 7
OcmZ3>)5pD`j}-t5EdrJR

diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs
index dc7b08be..8a5b60cd 100644
--- a/fixme-new/lib/Fixme/Run.hs
+++ b/fixme-new/lib/Fixme/Run.hs
@@ -113,6 +113,7 @@ runFixmeCLI m = do
             <*>  newTVarIO mempty
             <*>  newTVarIO defaultCatAction
             <*>  newTVarIO defaultTemplate
+            <*>  newTVarIO mempty
             <*>  newTVarIO (1,3)
 
   runReaderT ( setupLogger >> fromFixmeM (evolve >> m) ) env
@@ -321,6 +322,11 @@ printEnv = do
 
   liftIO $ print $ "fixme-def-context" <+> pretty before <+> pretty after
 
+  ma <- asks fixmeEnvMacro >>= readTVarIO <&> HM.toList
+
+  for_ ma $ \(n, syn) -> do
+    liftIO $ print $ parens ("define-macro" <+> pretty n <+> pretty syn)
+
 
 help :: FixmePerks m => m ()
 help = do
@@ -372,10 +378,18 @@ run what = do
              -> FixmeM m ()
     runForms ss = for_  ss $ \s -> do
 
+      macros  <- asks fixmeEnvMacro >>= readTVarIO
+
       debug $ pretty s
 
       case s of
 
+        (ListVal (SymbolVal name : rest)) | HM.member name macros -> do
+          let repl = [ (mkId ("$",i), syn) | (i,syn) <- zip [1..] rest ]
+          maybe1 (inject repl (HM.lookup name macros)) none $ \macro -> do
+            debug $ yellow "run macro" <+> pretty macro
+            runForms [macro]
+
         FixmeFiles xs -> do
           t <- asks fixmeEnvFileMask
           atomically (modifyTVar t (<> xs))
@@ -446,7 +460,6 @@ run what = do
           debug $ "list" <+> pretty n
           list_ n whatever
 
-
         ListVal [SymbolVal "cat", SymbolVal "metadata", FixmeHashLike hash] -> do
           catFixmeMetadata hash
 
@@ -481,6 +494,11 @@ run what = do
         ListVal (SymbolVal "hello" : xs) -> do
           notice $ "hello" <+> pretty xs
 
+        ListVal [SymbolVal "define-macro", SymbolVal name, macro@(ListVal{})] -> do
+          debug $ yellow "define-macro" <+> pretty name <+> pretty macro
+          macros <- asks fixmeEnvMacro
+          atomically $ modifyTVar macros (HM.insert name (fixContext macro))
+
         ListVal (SymbolVal "define-template" : SymbolVal who : IsSimpleTemplate xs) -> do
           trace $ "define-template" <+> pretty who <+> "simple" <+> hsep (fmap pretty xs)
           t <- asks fixmeEnvTemplates
diff --git a/fixme-new/lib/Fixme/Types.hs b/fixme-new/lib/Fixme/Types.hs
index 2fee830d..ad87810f 100644
--- a/fixme-new/lib/Fixme/Types.hs
+++ b/fixme-new/lib/Fixme/Types.hs
@@ -45,6 +45,13 @@ pattern FixmeHashLike  e <- (fixmeHashFromSyn -> Just e)
 pattern TimeStampLike :: forall {c} . FixmeTimestamp -> Syntax c
 pattern TimeStampLike  e <- (tsFromFromSyn -> Just e)
 
+fixContext :: IsContext c => Syntax c -> Syntax C
+fixContext = go
+  where
+    go = \case
+      List    _ xs -> List noContext (fmap go xs)
+      Symbol  _ w  -> Symbol noContext w
+      Literal _ l  -> Literal noContext l
 
 mklist :: IsContext c => [Syntax c] -> Syntax c
 mklist = List noContext
@@ -61,6 +68,12 @@ class MkId a where
 instance MkId FixmeAttrName where
   mkId (k :: FixmeAttrName) = Id ("$" <> coerce k)
 
+instance MkId (Text,Int) where
+  mkId (p, i) = Id (p <> fromString (show i))
+
+instance MkId (String,Integer) where
+  mkId (p, i) = Id (fromString p <> fromString (show i))
+
 class IsContext c => MkStr c a where
   mkstr :: a -> Syntax c
 
@@ -241,6 +254,7 @@ data FixmeEnv =
   , fixmeEnvReadLogActions :: TVar [ReadLogAction]
   , fixmeEnvCatAction      :: TVar CatAction
   , fixmeEnvTemplates      :: TVar (HashMap Id FixmeTemplate)
+  , fixmeEnvMacro          :: TVar (HashMap Id (Syntax C))
   , fixmeEnvCatContext     :: TVar (Int,Int)
   }