summaryrefslogtreecommitdiffstats
path: root/src/Blessings/String/Extra.hs
blob: 51d13ebede532e7de39cf8646ee6f01711b4ba4b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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)