From fdeb641fde5f82c3ad617c5c801ab40955fe62af Mon Sep 17 00:00:00 2001 From: tv Date: Thu, 19 Mar 2026 22:09:58 +0100 Subject: blessings: 2 -> 3 --- src/Blessings/Extra.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 src/Blessings/Extra.hs (limited to 'src/Blessings/Extra.hs') diff --git a/src/Blessings/Extra.hs b/src/Blessings/Extra.hs new file mode 100644 index 0000000..caa8e2d --- /dev/null +++ b/src/Blessings/Extra.hs @@ -0,0 +1,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 "" -- cgit v1.2.3