{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Char
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances and monomorphic functions for 'Char' and 'String'.

/Since: 2/
-}
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)

-- | /Since: 2/
$(deriveTextShow ''GeneralCategory)

-- | /Since: 2/
instance TextShow Char where
    showb :: Char -> Builder
showb = Char -> Builder
showbChar
    {-# INLINE showb #-}

    showbList :: [Char] -> Builder
showbList = [Char] -> Builder
showbString
    {-# INLINE showbList #-}

-- | A table of ASCII control characters that needs to be escaped with a backslash.
--
-- /Since: 2/
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 (Int
0, Int
32) [Builder
"NUL", Builder
"SOH", Builder
"STX", Builder
"ETX", Builder
"EOT", Builder
"ENQ", Builder
"ACK", Builder
"BEL",
                               Builder
"BS" , Builder
"HT" , Builder
"LF" , Builder
"VT" , Builder
"FF" , Builder
"CR" , Builder
"SO" , Builder
"SI" ,
                               Builder
"DLE", Builder
"DC1", Builder
"DC2", Builder
"DC3", Builder
"DC4", Builder
"NAK", Builder
"SYN", Builder
"ETB",
                               Builder
"CAN", Builder
"EM" , Builder
"SUB", Builder
"ESC", Builder
"FS" , Builder
"GS" , Builder
"RS" , Builder
"US" ,
                               Builder
"SP"]

-- | Convert a 'Char' to a 'Builder' (surrounded by single quotes).
--
-- /Since: 2/
showbChar :: Char -> Builder
showbChar :: Char -> Builder
showbChar Char
'\'' = Builder
"'\\''"
showbChar Char
c    = Char -> Builder
singleton Char
'\'' 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 Char
'\''
{-# INLINE showbChar #-}

-- | Convert a 'Char' to a 'Builder' (without single quotes).
--
-- /Since: 2/
showbLitChar :: Char -> Builder
showbLitChar :: Char -> Builder
showbLitChar Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\DEL' = Char -> Builder
singleton Char
'\\' 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 Char
'\DEL'         = Builder
"\\DEL"
showbLitChar Char
'\\'           = Builder
"\\\\"
showbLitChar Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' '   = Char -> Builder
singleton Char
c
showbLitChar Char
'\a'           = Builder
"\\a"
showbLitChar Char
'\b'           = Builder
"\\b"
showbLitChar Char
'\f'           = Builder
"\\f"
showbLitChar Char
'\n'           = Builder
"\\n"
showbLitChar Char
'\r'           = Builder
"\\r"
showbLitChar Char
'\t'           = Builder
"\\t"
showbLitChar Char
'\v'           = Builder
"\\v"
showbLitChar Char
'\SO'          = Builder
"\\SO"
showbLitChar Char
c              = Char -> Builder
singleton Char
'\\' 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)

-- | Convert a 'String' to a 'Builder' (surrounded by double quotes).
--
-- /Since: 2/
showbString :: String -> Builder
showbString :: [Char] -> Builder
showbString [Char]
cs = Char -> Builder
singleton Char
'"' 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 Char
'"'
{-# INLINE showbString #-}

-- | Convert a 'String' to a 'Builder' (without double quotes).
--
-- /Since: 2/
showbLitString :: String -> Builder
showbLitString :: [Char] -> Builder
showbLitString []             = Builder
forall a. Monoid a => a
mempty
showbLitString (Char
'\SO':Char
'H':[Char]
cs) = Builder
"\\SO\\&H" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbLitString (Char
'"':[Char]
cs)       = Builder
"\\\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs
showbLitString (Char
c:Char
d:[Char]
cs)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\DEL' Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
d = Char -> Builder
singleton Char
'\\' 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 -> 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 (Char
c:[Char]
cs)         = Char -> Builder
showbLitChar Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
showbLitString [Char]
cs

-- | Convert a 'GeneralCategory' to a 'Builder'.
--
-- /Since: 2/
showbGeneralCategory :: GeneralCategory -> Builder
showbGeneralCategory :: GeneralCategory -> Builder
showbGeneralCategory = GeneralCategory -> Builder
forall a. TextShow a => a -> Builder
showb
{-# INLINE showbGeneralCategory #-}