summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--much.cabal3
-rw-r--r--src/Blessings/String/Extra.hs41
2 files changed, 43 insertions, 1 deletions
diff --git a/much.cabal b/much.cabal
index 75f633d..cb6b989 100644
--- a/much.cabal
+++ b/much.cabal
@@ -72,7 +72,8 @@ library
, Notmuch.Class
, Notmuch.Message
, Notmuch.SearchResult
- other-modules: Codec.MIME.Base64
+ other-modules: Blessings.String.Extra
+ , Codec.MIME.Base64
, Codec.MIME.Decode
, Codec.MIME.Parse
, Codec.MIME.QuotedPrintable
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)