{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Show.Text.Data.Char -- Copyright : (C) 2014 Ryan Scott -- License : BSD-style (see the file LICENSE) -- Maintainer : Ryan Scott -- Stability : Experimental -- Portability : GHC -- -- Monomorphic 'Show' functions for 'Char' and 'String'. ---------------------------------------------------------------------------- module Text.Show.Text.Data.Char ( showbChar , showbLitChar , showbString , showbLitString , showbGeneralCategory ) where import Data.Array (Array, (!), listArray) import Data.Char (GeneralCategory(..), isDigit, ord) import Data.Monoid (mempty) import Data.Text.Buildable (build) import Data.Text.Lazy.Builder (Builder) import Prelude hiding (Show) import Text.Show.Text.Class (Show(..)) import Text.Show.Text.Utils ((<>), s) -- | A table of ASCII control characters that needs to be escaped with a backslash. asciiTabB :: Array Int Builder asciiTabB = 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"] -- | Convert a 'Char' to a 'Builder' (surrounded by single quotes). showbChar :: Char -> Builder showbChar '\'' = "'\\''" showbChar c = s '\'' <> showbLitChar c <> s '\'' {-# INLINE showbChar #-} -- | Convert a 'Char' to a 'Builder' (without single quotes). showbLitChar :: Char -> Builder showbLitChar c | c > '\DEL' = s '\\' <> build (ord c) showbLitChar '\DEL' = "\\DEL" showbLitChar '\\' = "\\\\" showbLitChar c | c >= ' ' = s 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 = s '\\' <> (asciiTabB ! ord c) {-# INLINE showbLitChar #-} -- | Convert a 'String' to a 'Builder' (surrounded by double quotes). showbString :: String -> Builder showbString cs = s '"' <> showbLitString cs <> s '"' {-# INLINE showbString #-} -- | Convert a 'String' to a 'Builder' (without double quotes). showbLitString :: String -> Builder showbLitString [] = mempty showbLitString ('\SO':'H':cs) = "\\SO\\&H" <> showbLitString cs showbLitString ('"':cs) = "\\\"" <> showbLitString cs showbLitString (c:d:cs) | c > '\DEL' && isDigit d = s '\\' <> build (ord c) <> "\\&" <> s d <> showbLitString cs showbLitString (c:cs) = showbLitChar c <> showbLitString cs {-# INLINE showbLitString #-} -- | Convert a 'GeneralCategory' to a 'Builder'. showbGeneralCategory :: GeneralCategory -> Builder showbGeneralCategory UppercaseLetter = "UppercaseLetter" showbGeneralCategory LowercaseLetter = "LowercaseLetter" showbGeneralCategory TitlecaseLetter = "TitlecaseLetter" showbGeneralCategory ModifierLetter = "ModifierLetter" showbGeneralCategory OtherLetter = "OtherLetter" showbGeneralCategory NonSpacingMark = "NonSpacingMark" showbGeneralCategory SpacingCombiningMark = "SpacingCombiningMark" showbGeneralCategory EnclosingMark = "EnclosingMark" showbGeneralCategory DecimalNumber = "DecimalNumber" showbGeneralCategory LetterNumber = "LetterNumber" showbGeneralCategory OtherNumber = "OtherNumber" showbGeneralCategory ConnectorPunctuation = "ConnectorPunctuation" showbGeneralCategory DashPunctuation = "DashPunctuation" showbGeneralCategory OpenPunctuation = "OpenPunctuation" showbGeneralCategory ClosePunctuation = "ClosePunctuation" showbGeneralCategory InitialQuote = "InitialQuote" showbGeneralCategory FinalQuote = "FinalQuote" showbGeneralCategory OtherPunctuation = "OtherPunctuation" showbGeneralCategory MathSymbol = "MathSymbol" showbGeneralCategory CurrencySymbol = "CurrencySymbol" showbGeneralCategory ModifierSymbol = "ModifierSymbol" showbGeneralCategory OtherSymbol = "OtherSymbol" showbGeneralCategory Space = "Space" showbGeneralCategory LineSeparator = "LineSeparator" showbGeneralCategory ParagraphSeparator = "ParagraphSeparator" showbGeneralCategory Control = "Control" showbGeneralCategory Format = "Format" showbGeneralCategory Surrogate = "Surrogate" showbGeneralCategory PrivateUse = "PrivateUse" showbGeneralCategory NotAssigned = "NotAssigned" {-# INLINE showbGeneralCategory #-} instance Show Char where showb = showbChar {-# INLINE showb #-} showbList = showbString {-# INLINE showbList #-} instance Show GeneralCategory where showb = showbGeneralCategory {-# INLINE showb #-}