Blessings: add quoteSpecials

1 files changed, 41 insertions, 0 deletions

diff --git a/src/Blessings/String/Extra.hs b/src/Blessings/String/Extra.hs
new file mode 100644
index 0000000..51d13eb
--- /dev/null
+++ b/src/Blessings/String/Extra.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE LambdaCase #-}
+module Blessings.String.Extra where
+
+import Blessings
+import Control.Arrow ((&&&))
+import Data.Char (isPrint,showLitChar)
+import Data.Function (on)
+import Data.List (groupBy)
+
+
+quoteSpecials :: Blessings String -> Blessings String
+quoteSpecials = \case
+  Plain s -> quoteSpecials' s
+  SGR pm x -> SGR pm (quoteSpecials x)
+  Append a b -> Append (quoteSpecials a) (quoteSpecials b)
+  Empty -> Empty
+
+
+quoteSpecials' :: String -> Blessings String
+quoteSpecials' s =
+    mconcat . map (uncurry renderClassifiedString) $ classifiedGroupBy isPrint s
+  where
+    renderClassifiedString :: Bool -> String -> Blessings String
+    renderClassifiedString = \case
+        True -> printableColor . Plain
+        False -> unprintableColor . Plain . showLitChar'
+
+    (printableColor, unprintableColor) =
+        (id, SGR [35])
+        --if hasFocus
+          --then (color focus colorConfig, color unprintableFocus colorConfig)
+          --else (color quote colorConfig, color unprintableNormal colorConfig)
+
+    showLitChar' :: String -> String
+    showLitChar' = (>>= f)
+      where f '\ESC' = "^["
+            f c = showLitChar c ""
+
+    classifiedGroupBy :: Eq b => (a -> b) -> [a] -> [(b, [a])]
+    classifiedGroupBy f =
+        map (f . head &&& id) . groupBy ((==) `on` f)