{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.Data.Char (
showbChar
, showbLitChar
, showbString
, showbLitString
, showbGeneralCategory
, asciiTabB
) where
import Data.Array (Array, (!), listArray)
import Data.Char (GeneralCategory, isDigit, ord)
import Data.Text.Lazy.Builder (Builder, singleton)
import Prelude ()
import Prelude.Compat
import TextShow.Classes (TextShow(..))
import TextShow.Data.Integral ()
import TextShow.TH.Internal (deriveTextShow)
$(deriveTextShow ''GeneralCategory)
instance TextShow Char where
showb :: Char -> Builder
showb = Char -> Builder
showbChar
{-# INLINE showb #-}
showbList :: [Char] -> Builder
showbList = [Char] -> Builder
showbString
{-# INLINE showbList #-}
asciiTabB :: Array Int Builder
asciiTabB :: Array Int Builder
asciiTabB = (Int, Int) -> [Builder] -> Array Int Builder
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (0, 32) ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
"BS" , "HT" , "LF" , "VT" , "FF" , "CR" , "SO" , "SI" ,
"DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
"CAN", "EM" , "SUB", "ESC", "FS" , "GS" , "RS" , "US" ,
"SP"]
showbChar :: Char -> Builder
showbChar :: Char -> Builder
showbChar '\'' = "'\\''"
showbChar c :: Char
c = Char -> Builder
singleton '\'' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
showbLitChar Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton '\''
{-# INLINE showbChar #-}
showbLitChar :: Char -> Builder
showbLitChar :: Char -> Builder
showbLitChar c :: Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> '\DEL' = Char -> Builder
singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. TextShow a => a -> Builder
showb (Char -> Int
ord Char
c)
showbLitChar '\DEL' = "\\DEL"
showbLitChar '\\' = "\\\\"
showbLitChar c :: Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= ' ' = Char -> Builder
singleton Char
c
showbLitChar '\a' = "\\a"
showbLitChar '\b' = "\\b"
showbLitChar '\f' = "\\f"
showbLitChar '\n' = "\\n"
showbLitChar '\r' = "\\r"
showbLitChar '\t' = "\\t"
showbLitChar '\v' = "\\v"
showbLitChar '\SO' = "\\SO"
showbLitChar c :: Char
c = Char -> Builder
singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Array Int Builder
asciiTabB Array Int Builder -> Int -> Builder
forall i e. Ix i => Array i e -> i -> e
! Char -> Int
ord Char
c)
showbString :: String -> Builder
showbString :: [Char] -> Builder
showbString cs :: [Char]
cs = Char -> Builder
singleton '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton '"'
{-# INLINE showbString #-}
showbLitString :: String -> Builder
showbLitString :: [Char] -> Builder
showbLitString [] = Builder
forall a. Monoid a => a
mempty
showbLitString ('\SO':'H':cs :: [Char]
cs) = "\\SO\\&H" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbLitString ('"':cs :: [Char]
cs) = "\\\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbLitString (c :: Char
c:d :: Char
d:cs :: [Char]
cs)
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> '\DEL' Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
d = Char -> Builder
singleton '\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. TextShow a => a -> Builder
showb (Char -> Int
ord Char
c) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "\\&"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbLitString (c :: Char
c:cs :: [Char]
cs) = Char -> Builder
showbLitChar Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbGeneralCategory :: GeneralCategory -> Builder
showbGeneralCategory :: GeneralCategory -> Builder
showbGeneralCategory = GeneralCategory -> Builder
forall a. TextShow a => a -> Builder
showb
{-# INLINE showbGeneralCategory #-}