diff options
| -rw-r--r-- | much.cabal | 3 | ||||
| -rw-r--r-- | src/Blessings/String/Extra.hs | 41 |
2 files changed, 43 insertions, 1 deletions
@@ -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) |