wip, introduced simple macros to fixme-new

.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) " "

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

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)
   }