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 ""