From 79139245a2c811147524cf884a0c6d14a84de1b1 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Thu, 17 Oct 2024 13:44:02 +0300
Subject: [PATCH] wip, ansi colors

---
 Makefile                                      |  3 +-
 .../Data/Config/Suckless/Script/Internal.hs   | 46 +++++++++++++++++++
 test/RT/test-basic-policy-1.rt                |  1 +
 3 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index e176e3d0..f6dd8b34 100644
--- a/Makefile
+++ b/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 $@)
 
diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs
index 4dbfd82d..e7c707d7 100644
--- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs
+++ b/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 "")
diff --git a/test/RT/test-basic-policy-1.rt b/test/RT/test-basic-policy-1.rt
index a8fe8abb..358e2585 100644
--- a/test/RT/test-basic-policy-1.rt
+++ b/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