{- |

The __American Standard Code for Information Interchange__ (ASCII) comprises a set of 128 characters, each represented by 7 bits. 33 of these characters are /'Control' codes/; a few of these are still in use, but most are obsolete relics of the early days of computing. The other 95 are /'Printable' characters/ such as letters and numbers, mostly corresponding to the keys on an American English keyboard.

Nowadays instead of ASCII we typically work with text using an encoding such as UTF-8 that can represent the entire Unicode character set, which includes over a hundred thousand characters and is not limited to the symbols of any particular writing system or culture. However, ASCII is still relevant to network protocols; for example, we can see it in the specification of [HTTP message headers](https://tools.ietf.org/html/rfc7230#section-1.2).

There is a convenient relationship between ASCII and Unicode: the ASCII characters are the first 128 characters of the much larger Unicode character set. The [C0 Controls and Basic Latin](https://www.unicode.org/charts/PDF/U0000.pdf) section of the Unicode standard contains a list of all the ASCII characters. You may also find this list replicated in the "ASCII.Char" module; each ASCII character corresponds to a constructor of the 'ASCII.Char' type.

We do not elaborate on the semantics of the control characters here, because this information is both obsolete and restricted by copyright law. It is described by a document entitled /"Coded Character Sets - 7-Bit American National Standard Code for Information Interchange (7-Bit ASCII)"/, published by American National Standards Institute (ANSI) and available for purchase [on their website](https://webstore.ansi.org/Standards/INCITS/INCITS1986R2012).

-}

module ASCII
  (
    {- * @Char@ -} {- $char -} Char,

    {- * Character classifications -}
    {- ** Print/control groups -} {- $groups -} Group (..), charGroup,  inGroup,
    {- ** Upper/lower case     -} {- $case   -} Case (..),  letterCase, isCase, toCaseChar, toCaseString,
    {- ** Letters and numbers  -} isAlphaNum, isLetter, isDigit, isOctDigit, isHexDigit,
    {- ** Spaces and symbols   -} isSpace, isPunctuation, isSymbol,

    {- * Monomorphic conversions -} {- $monomorphicConversions -}
    {- ** @Int@        -} {- $intConversions           -} charToInt,               intToCharMaybe,               intToCharUnsafe,
    {- ** @Word8@      -} {- $word8Conversions         -} charToWord8,             word8ToCharMaybe,             word8ToCharUnsafe,
    {- ** @Char@       -} {- $unicodeCharConversions   -} charToUnicode,           unicodeToCharMaybe,           unicodeToCharUnsafe,
    {- ** @String@     -} {- $unicodeStringConversions -} charListToUnicodeString, unicodeStringToCharListMaybe, unicodeStringToCharListUnsafe,
    {- ** @Text@       -} {- $textConversions          -} charListToText,          textToCharListMaybe,          textToCharListUnsafe,
    {- ** @ByteString@ -} {- $byteStringConversions    -} charListToByteString,    byteStringToCharListMaybe,    byteStringToCharListUnsafe,

    {- * Monomorphic conversions between ASCII supersets -} {- $monoSupersetConversions -}
    {- ** @ByteString@ / @String@ -} byteStringToUnicodeStringMaybe, unicodeStringToByteStringMaybe,
    {- ** @[Word8]@      / @String@ -} byteListToUnicodeStringMaybe,   unicodeStringToByteListMaybe,

    {- * Refinement type -} {- $refinement -} {- ** @ASCII@ -} ASCII,

    {- * Polymorphic conversions -}
    {- ** Validate -} validateChar, validateString,
    {- ** Lift -} {- $lift -} lift,
    {- ** Convert -} {- $supersetConversions -} convertCharMaybe, convertCharOrFail, convertStringMaybe, convertStringOrFail,

    {- * Classes -} {- ** @CharSuperset@ -} CharSuperset, {- ** @StringSuperset@ -} StringSuperset, {- ** @Lift@ -} Lift, {- ** @CharIso@ -} CharIso, {- ** @StringIso@ -} StringIso,

    {- * Quasi-quoters -} {- ** @char@ -} char, {- ** @string@ -} string
  )
  where

import ASCII.Case          ( Case (..) )
import ASCII.Char          ( Char )
import ASCII.Group         ( Group (..) )
import ASCII.Isomorphism   ( CharIso, StringIso )
import ASCII.Lift          ( Lift )
import ASCII.QuasiQuoters  ( char, string )
import ASCII.Refinement    ( ASCII, validateChar, validateString )
import ASCII.Superset      ( CharSuperset, StringSuperset )

import Control.Monad       ( (>=>) )
import Control.Monad.Fail  ( MonadFail )
import Data.Bool           ( Bool (..) )
import Data.Foldable       ( any )
import Data.Function       ( (.) )
import Data.Int            ( Int )
import Data.Maybe          ( Maybe, maybe )
import Data.Word           ( Word8 )

import qualified  ASCII.Case
import qualified  ASCII.Group
import qualified  ASCII.Isomorphism
import qualified  ASCII.Lift
import qualified  ASCII.Predicates
import qualified  ASCII.Superset

import qualified  Data.ByteString  as  BS
import qualified  Data.Char        as  Unicode
import qualified  Data.String      as  Unicode
import qualified  Data.Text        as  Text

{- $char

See also: "ASCII.Char"

-}

{- $groups

ASCII characters are broadly categorized into two groups: /control codes/ and /printable characters/.

See also: "ASCII.Group"

-}


{- | Determine which group a particular character belongs to.

>>> map charGroup [CapitalLetterA,EndOfTransmission]
[Printable,Control]

-}

charGroup :: CharIso char => char -> Group
charGroup :: char -> Group
charGroup = Char -> Group
ASCII.Group.charGroup (Char -> Group) -> (char -> Char) -> char -> Group
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char -> Char
forall char. CharIso char => char -> Char
ASCII.Isomorphism.toChar

{- | Test whether a character belongs to a particular ASCII group.

>>> inGroup Printable EndOfTransmission
False

>>> inGroup Control EndOfTransmission
True

>>> map (inGroup Printable) ( [-1, 5, 65, 97, 127, 130] :: [Int] )
[False,False,True,True,False,False]

-}

inGroup :: CharSuperset char => Group -> char -> Bool
inGroup :: Group -> char -> Bool
inGroup Group
g = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Group -> Char -> Bool
ASCII.Group.inGroup Group
g) (Maybe Char -> Bool) -> (char -> Maybe Char) -> char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe

{- $case

/Case/ is a property of letters. /A-Z/ are /upper case/ letters, and /a-z/ are /lower case/ letters. No other ASCII characters have case.

See also: "ASCII.Case"

-}

{- | Determines whether a character is an ASCII letter, and if so, whether it is upper or lower case.

>>> map letterCase [SmallLetterA, CapitalLetterA, ExclamationMark]
[Just LowerCase,Just UpperCase,Nothing]

>>> map letterCase ( [string|Hey!|] :: [ASCII Word8] )
[Just UpperCase,Just LowerCase,Just LowerCase,Nothing]

-}

letterCase :: CharSuperset char => char -> Maybe Case
letterCase :: char -> Maybe Case
letterCase = char -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe (char -> Maybe Char) -> (Char -> Maybe Case) -> char -> Maybe Case
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Char -> Maybe Case
ASCII.Case.letterCase

{- | Determines whether a character is an ASCII letter of a particular case.

>>> map (isCase UpperCase) [SmallLetterA, CapitalLetterA, ExclamationMark]
[False,True,False]

>>> map (isCase UpperCase) ( [string|Hey!|] :: [ASCII Word8] )
[True,False,False,False]

>>> map (isCase UpperCase) ( [-1, 65, 97, 150] :: [Int] )
[False,True,False,False]

-}

isCase :: CharSuperset char => Case -> char -> Bool
isCase :: Case -> char -> Bool
isCase Case
c = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Case -> Char -> Bool
ASCII.Case.isCase Case
c) (Maybe Char -> Bool) -> (char -> Maybe Char) -> char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe

{- | Maps a letter character to its upper/lower case equivalent.

>>> toCaseChar UpperCase SmallLetterA
CapitalLetterA

>>> ([char|a|] :: ASCII Word8, toCaseChar UpperCase [char|a|] :: ASCII Word8)
(asciiUnsafe 97,asciiUnsafe 65)

-}

toCaseChar :: CharIso char => Case -> char -> char
toCaseChar :: Case -> char -> char
toCaseChar Case
c = (Char -> Char) -> char -> char
forall char. CharIso char => (Char -> Char) -> char -> char
ASCII.Isomorphism.asChar (Case -> Char -> Char
ASCII.Case.toCase Case
c)

{- | Maps each of the characters in a string to its upper/lower case equivalent.

>>> toCaseString UpperCase [CapitalLetterH,SmallLetterE,SmallLetterY,ExclamationMark]
[CapitalLetterH,CapitalLetterE,CapitalLetterY,ExclamationMark]

>>> toCaseString UpperCase [string|Hey!|] :: ASCII Text
asciiUnsafe "HEY!"

-}

toCaseString :: StringIso string => Case -> string -> string
toCaseString :: Case -> string -> string
toCaseString Case
c = (Char -> Char) -> string -> string
forall string.
StringIso string =>
(Char -> Char) -> string -> string
ASCII.Isomorphism.mapChars (Case -> Char -> Char
ASCII.Case.toCase Case
c)

{- $monomorphicConversions

These are a few simple monomorphic functions to convert between ASCII and types representing some other character set.

This is not intended to be an exhaustive list of all possible conversions. For more options, see "ASCII.Superset".

-}

{- $intConversions

These functions convert between the ASCII 'Char' type and 'Int'.

-}

{- |

>>> map charToInt [Null, CapitalLetterA, SmallLetterA, Delete]
[0,65,97,127]

-}

charToInt :: Char -> Int
charToInt :: Char -> Int
charToInt = Char -> Int
forall char. CharSuperset char => Char -> char
ASCII.Superset.fromChar

intToCharMaybe :: Int -> Maybe Char
intToCharMaybe :: Int -> Maybe Char
intToCharMaybe = Int -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe

intToCharUnsafe :: Int -> Char
intToCharUnsafe :: Int -> Char
intToCharUnsafe = Int -> Char
forall char. CharSuperset char => char -> Char
ASCII.Superset.toCharUnsafe

{- $word8Conversions

These functions convert between the ASCII 'Char' type and 'Word8'.

-}

{- |

>>> map charToWord8 [Null, CapitalLetterA, SmallLetterA, Delete]
[0,65,97,127]

-}

charToWord8 :: Char -> Word8
charToWord8 :: Char -> Word8
charToWord8 = Char -> Word8
forall char. CharSuperset char => Char -> char
ASCII.Superset.fromChar

word8ToCharMaybe :: Word8 -> Maybe Char
word8ToCharMaybe :: Word8 -> Maybe Char
word8ToCharMaybe = Word8 -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe

word8ToCharUnsafe :: Word8 -> Char
word8ToCharUnsafe :: Word8 -> Char
word8ToCharUnsafe = Word8 -> Char
forall char. CharSuperset char => char -> Char
ASCII.Superset.toCharUnsafe

{- $unicodeCharConversions

These functions convert between the ASCII 'Char' type and the Unicode 'Unicode.Char' type.

-}

charToUnicode :: Char -> Unicode.Char
charToUnicode :: Char -> Char
charToUnicode = Char -> Char
forall char. CharSuperset char => Char -> char
ASCII.Superset.fromChar

unicodeToCharMaybe :: Unicode.Char -> Maybe Char
unicodeToCharMaybe :: Char -> Maybe Char
unicodeToCharMaybe = Char -> Maybe Char
forall char. CharSuperset char => char -> Maybe Char
ASCII.Superset.toCharMaybe

unicodeToCharUnsafe :: Unicode.Char -> Char
unicodeToCharUnsafe :: Char -> Char
unicodeToCharUnsafe = Char -> Char
forall char. CharSuperset char => char -> Char
ASCII.Superset.toCharUnsafe

{- $unicodeStringConversions

These functions convert between @['Char']@ (a list of ASCII characters) and 'Unicode.String' (a list of Unicode characters).

-}

charListToUnicodeString :: [Char] -> Unicode.String
charListToUnicodeString :: [Char] -> String
charListToUnicodeString = [Char] -> String
forall string. StringSuperset string => [Char] -> string
ASCII.Superset.fromCharList

unicodeStringToCharListMaybe :: Unicode.String -> Maybe [Char]
unicodeStringToCharListMaybe :: String -> Maybe [Char]
unicodeStringToCharListMaybe = String -> Maybe [Char]
forall string. StringSuperset string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

unicodeStringToCharListUnsafe :: Unicode.String -> [Char]
unicodeStringToCharListUnsafe :: String -> [Char]
unicodeStringToCharListUnsafe = String -> [Char]
forall string. StringSuperset string => string -> [Char]
ASCII.Superset.toCharListUnsafe

{- $textConversions

These functions convert between @['Char']@ and 'Text.Text'.

-}

{- |

>>> charListToText [CapitalLetterH,SmallLetterI,ExclamationMark]
"Hi!"

-}

charListToText :: [Char] -> Text.Text
charListToText :: [Char] -> Text
charListToText = [Char] -> Text
forall string. StringSuperset string => [Char] -> string
ASCII.Superset.fromCharList

textToCharListMaybe :: Text.Text -> Maybe [Char]
textToCharListMaybe :: Text -> Maybe [Char]
textToCharListMaybe = Text -> Maybe [Char]
forall string. StringSuperset string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

textToCharListUnsafe :: Text.Text -> [Char]
textToCharListUnsafe :: Text -> [Char]
textToCharListUnsafe = Text -> [Char]
forall string. StringSuperset string => string -> [Char]
ASCII.Superset.toCharListUnsafe

{- $byteStringConversions

These functions convert between @['Char']@ and 'BS.ByteString'.

-}

charListToByteString :: [Char] -> BS.ByteString
charListToByteString :: [Char] -> ByteString
charListToByteString = [Char] -> ByteString
forall string. StringSuperset string => [Char] -> string
ASCII.Superset.fromCharList

byteStringToCharListMaybe :: BS.ByteString -> Maybe [Char]
byteStringToCharListMaybe :: ByteString -> Maybe [Char]
byteStringToCharListMaybe = ByteString -> Maybe [Char]
forall string. StringSuperset string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

byteStringToCharListUnsafe :: BS.ByteString -> [Char]
byteStringToCharListUnsafe :: ByteString -> [Char]
byteStringToCharListUnsafe = ByteString -> [Char]
forall string. StringSuperset string => string -> [Char]
ASCII.Superset.toCharListUnsafe

{- $refinement

See also: "ASCII.Refinement"

-}

{- $lift

See also: "ASCII.Lift"

-}

{- | Converts from ASCII to any larger type.

For example, @(lift \@ASCII.Char \@Word8)@ is the same function as 'charToWord8'.

>>> lift CapitalLetterA :: Word8
65

And @(lift \@[ASCII.Char] \@Text)@ is equivalent to 'charListToText'.

>>> lift [CapitalLetterH,SmallLetterI,ExclamationMark] :: Text
"Hi!"

Due to the highly polymorphic nature of the 'lift' function, often it must used with an explicit type signature or type application to avoid any type ambiguity.

-}

lift :: Lift ascii superset => ascii -> superset
lift :: ascii -> superset
lift = ascii -> superset
forall ascii superset. Lift ascii superset => ascii -> superset
ASCII.Lift.lift

{- $supersetConversions

These functions all convert from one ASCII-superset type to another, failing if any of the characters in the input is outside the ASCII character set.

-}

convertCharMaybe :: (CharSuperset char1, CharSuperset char2) => char1 -> Maybe char2
convertCharMaybe :: char1 -> Maybe char2
convertCharMaybe = char1 -> Maybe char2
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
ASCII.Superset.convertCharMaybe

convertCharOrFail :: (CharSuperset char1, CharSuperset char2, MonadFail context) => char1 -> context char2
convertCharOrFail :: char1 -> context char2
convertCharOrFail = char1 -> context char2
forall char1 char2 (context :: * -> *).
(CharSuperset char1, CharSuperset char2, MonadFail context) =>
char1 -> context char2
ASCII.Superset.convertCharOrFail

convertStringMaybe :: (StringSuperset string1, StringSuperset string2) => string1 -> Maybe string2
convertStringMaybe :: string1 -> Maybe string2
convertStringMaybe = string1 -> Maybe string2
forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
ASCII.Superset.convertStringMaybe

convertStringOrFail :: (StringSuperset string1, StringSuperset string2, MonadFail context) => string1 -> context string2
convertStringOrFail :: string1 -> context string2
convertStringOrFail = string1 -> context string2
forall string1 string2 (context :: * -> *).
(StringSuperset string1, StringSuperset string2,
 MonadFail context) =>
string1 -> context string2
ASCII.Superset.convertStringOrFail

{- $monoSupersetConversions

These functions are all specializations of 'convertStringMaybe'. They convert a string from one ASCII-superset type to another.

>>> ASCII.byteListToUnicodeStringMaybe [0x48, 0x54, 0x54, 0x50]
Just "HTTP"

If any of the characters in the input is outside the ASCII character set, the result is 'Nothing'.

>>> ASCII.byteListToUnicodeStringMaybe [0x48, 0x54, 0x54, 0x80]
Nothing

-}

byteStringToUnicodeStringMaybe :: BS.ByteString -> Maybe Unicode.String
byteStringToUnicodeStringMaybe :: ByteString -> Maybe String
byteStringToUnicodeStringMaybe = ByteString -> Maybe String
forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

unicodeStringToByteStringMaybe :: Unicode.String -> Maybe BS.ByteString
unicodeStringToByteStringMaybe :: String -> Maybe ByteString
unicodeStringToByteStringMaybe = String -> Maybe ByteString
forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

byteListToUnicodeStringMaybe :: [Word8] -> Maybe Unicode.String
byteListToUnicodeStringMaybe :: [Word8] -> Maybe String
byteListToUnicodeStringMaybe = [Word8] -> Maybe String
forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

unicodeStringToByteListMaybe :: Unicode.String -> Maybe [Word8]
unicodeStringToByteListMaybe :: String -> Maybe [Word8]
unicodeStringToByteListMaybe = String -> Maybe [Word8]
forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

{- | Returns True for ASCII letters:

- 'ASCII.Char.SmallLetterA' to 'ASCII.Char.SmallLetterZ'
- 'ASCII.Char.CapitalLetterA' to 'ASCII.Char.CapitalLetterZ'

-}

isLetter :: CharSuperset char => char -> Bool
isLetter :: char -> Bool
isLetter char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isLetter (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- | Returns True for the characters from 'ASCII.Char.Digit0' to 'ASCII.Char.Digit9'. -}

isDigit :: CharSuperset char => char -> Bool
isDigit :: char -> Bool
isDigit char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isDigit (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)


{- | Returns True for the characters from 'ASCII.Char.Digit0' to 'ASCII.Char.Digit7'. -}

isOctDigit :: CharSuperset char => char -> Bool
isOctDigit :: char -> Bool
isOctDigit char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isOctDigit (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)


{- | Returns True for characters in any of the following ranges:

- 'ASCII.Char.Digit0' to 'ASCII.Char.Digit9'
- 'ASCII.Char.CapitalLetterA' to 'ASCII.Char.CapitalLetterF'
- 'ASCII.Char.SmallLetterA' to 'ASCII.Char.SmallLetterF'

-}

isHexDigit :: CharSuperset char => char -> Bool
isHexDigit :: char -> Bool
isHexDigit char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isHexDigit (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- | Returns True for the following characters:

- 'ASCII.Char.Space'
- 'ASCII.Char.HorizontalTab'
- 'ASCII.Char.LineFeed'
- 'ASCII.Char.VerticalTab'
- 'ASCII.Char.FormFeed'
- 'ASCII.Char.CarriageReturn'

-}

isSpace :: CharSuperset char => char -> Bool
isSpace :: char -> Bool
isSpace char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isSpace (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- | Returns True if the character is either an ASCII letter ('isLetter') or an ASCII digit ('isDigit'). -}

isAlphaNum :: CharSuperset char => char -> Bool
isAlphaNum :: char -> Bool
isAlphaNum char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isAlphaNum (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- | Returns True for the following characters:

- 'ASCII.Char.ExclamationMark'
- 'ASCII.Char.QuotationMark'
- 'ASCII.Char.NumberSign'
- 'ASCII.Char.PercentSign'
- 'ASCII.Char.Ampersand'
- 'ASCII.Char.Apostrophe'
- 'ASCII.Char.LeftParenthesis'
- 'ASCII.Char.RightParenthesis'
- 'ASCII.Char.Asterisk'
- 'ASCII.Char.Comma'
- 'ASCII.Char.HyphenMinus'
- 'ASCII.Char.FullStop'
- 'ASCII.Char.Slash'
- 'ASCII.Char.Colon'
- 'ASCII.Char.Semicolon'
- 'ASCII.Char.QuestionMark'
- 'ASCII.Char.AtSign'
- 'ASCII.Char.LeftSquareBracket'
- 'ASCII.Char.Backslash'
- 'ASCII.Char.RightSquareBracket'
- 'ASCII.Char.Underscore'
- 'ASCII.Char.LeftCurlyBracket'
- 'ASCII.Char.RightCurlyBracket'

-}

isPunctuation :: CharSuperset char => char -> Bool
isPunctuation :: char -> Bool
isPunctuation char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isPunctuation (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- | Returns True for the following characters:

- 'ASCII.Char.DollarSign'
- 'ASCII.Char.PlusSign'
- 'ASCII.Char.LessThanSign'
- 'ASCII.Char.EqualsSign'
- 'ASCII.Char.GreaterThanSign'
- 'ASCII.Char.Caret'
- 'ASCII.Char.GraveAccent'
- 'ASCII.Char.VerticalLine'
- 'ASCII.Char.Tilde'

-}

isSymbol :: CharSuperset char => char -> Bool
isSymbol :: char -> Bool
isSymbol char
x = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isSymbol (char -> Maybe Char
forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)