summaryrefslogtreecommitdiffstats
path: root/src/Blessings/Extra.hs
blob: caa8e2d9358df728a301b4dea0e15ca0b8ad470d (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
module Blessings.Extra where

import Blessings
import Data.Char (isPrint,showLitChar)
import Data.MonoTraversable (Element, oall, ofoldMap)
import Data.Sequences (singleton)
import Data.String (fromString)

quoteSpecials :: (Blessable a, Element a ~ Char) => Blessings a -> Blessings a
quoteSpecials = cataBlessings quoteSpecialsPlain SGR Append

quoteSpecialsPlain :: (Blessable a, Element a ~ Char) => a -> Blessings a
quoteSpecialsPlain =
    quoteSpecialsPlain' id (SGR [35])

quoteSpecialsPlain'
    :: forall a. (Blessable a, Element a ~ Char)
    => (Blessings a -> Blessings a)
    -> (Blessings a -> Blessings a)
    -> a
    -> Blessings a
quoteSpecialsPlain' printable unprintable s =
    if oall isPrint s
      then printable (Plain s)
      else normalize (ofoldMap quoteSpecialChar s)
  where

    quoteSpecialChar :: (Blessable a, Element a ~ Char) => Char -> Blessings a
    quoteSpecialChar c =
        if isPrint c
          then printable (Plain (singleton c))
          else unprintable (Plain (fromString (showLitChar' c)))

    showLitChar' :: Char -> String
    showLitChar' = \case
        '\ESC' -> "^["
        c -> showLitChar c ""