wip, ansi colors

Makefile

@@ -42,7 +42,8 @@ rt: $(OUT_FILES)
 > @hbs2-cli \
 	 [define r [eq? [parse:top:file root $(dir $<)$(notdir $@)] \
    [parse:top:file root $(dir $<)$(basename $(notdir $@)).baseline]]] \
-   and [println '"[RT]"' space [if r OK FAIL] : space $(notdir $(basename $@))]
+   and [print '"[RT]"' space [if r [ansi green OK] [ansi red FAIL]] : space $(notdir $(basename $@))] \
+	 and println
 
 > $(RM) $(dir $<)$(notdir $@)
 

miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs

@@ -847,6 +847,52 @@ internalEntries = do
       [ sy ] -> display sy
       ss     -> display (mkList ss)
 
+    let colorz = HM.fromList
+          [ ("red",     (Red, True))
+          , ("red~",    (Red, False))
+          , ("green",   (Green, True))
+          , ("green~",  (Green, False))
+          , ("yellow",  (Yellow, True))
+          , ("yellow~", (Yellow, False))
+          , ("blue",    (Blue, True))
+          , ("blue~",   (Blue, False))
+          , ("magenta", (Magenta, True))
+          , ("magenta~",(Magenta, False))
+          , ("cyan",    (Cyan, True))
+          , ("cyan~",   (Cyan, False))
+          , ("white",   (White, True))
+          , ("white~",  (White, False))
+          , ("black",   (Black, True))
+          , ("black~",  (Black, False))
+          ]
+
+
+    let fgc fg = case HM.lookup fg colorz of
+          Just (co, True)  -> color co
+          Just (co, False) -> colorDull co
+          Nothing             -> mempty
+
+    entry $ bindMatch "ansi" $  \case
+      [ SymbolVal fg, SymbolVal bg, term ] | HM.member fg colorz && HM.member bg colorz -> do
+        let b = case HM.lookup bg colorz of
+                  Just (co, True)  -> bgColor co
+                  Just (co, False) -> bgColorDull co
+                  Nothing -> mempty
+
+        let f = b <> fgc fg
+        let wtf = show $ pretty term
+        let x = Text.unpack $ renderStrict $ layoutPretty defaultLayoutOptions (annotate f $ pretty wtf)
+        pure $ mkStr x
+
+      [ SymbolVal fg, s] | HM.member fg colorz -> do
+        let f = fgc fg
+        let wtf = show $ pretty s
+        let x = Text.unpack $ renderStrict $ layoutPretty defaultLayoutOptions (annotate f $ pretty wtf)
+        -- error $ show x
+        pure $ mkStr x
+
+      _  -> throwIO (BadFormException @c nil)
+
     brief "prints new line character to stdout"
       $ entry $ bindMatch "newline" $ nil_ $ \case
           [] -> liftIO (putStrLn "")

test/RT/test-basic-policy-1.rt

@@ -82,4 +82,5 @@ println sender || s1 || allowed || [accept:sender s1 shitty-policy]
 println sender || s2 || allowed || [accept:sender s2 shitty-policy]
 
 
+; print :fuck