-- | Unicode character parsers. The character classification is identical to the
-- classification in the "Data.Char" module.
module Text.Parsers.Frisby.Char where

import Data.Char
import Text.Parsers.Frisby (P, anyChar, onlyIf)

-- | Match a control character.
control :: P s Char
control :: forall s. P s Char
control = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isControl

-- | Match a white-space character in the Latin-1 range.
space :: P s Char
space :: forall s. P s Char
space = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isSpace

-- | Match a lower-case alphabetic Unicode character.
lower :: P s Char
lower :: forall s. P s Char
lower = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isLower

-- | Match an upper-case or title-case alphabetic Unicode character.
upper :: P s Char
upper :: forall s. P s Char
upper = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isUpper

-- | Match an alphabetic Unicode character. Equivalent to 'letter'.
alpha :: P s Char
alpha :: forall s. P s Char
alpha = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isAlpha

-- | Match an alphabetic or numeric digit Unicode character.
alphaNum :: P s Char
alphaNum :: forall s. P s Char
alphaNum = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isAlphaNum

-- | Match a printable Unicode character.
printable :: P s Char
printable :: forall s. P s Char
printable = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isPrint

-- | Match an ASCII digit.
digit :: P s Char
digit :: forall s. P s Char
digit = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isDigit

-- | Match an ASCII octal digit.
octDigit :: P s Char
octDigit :: forall s. P s Char
octDigit = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isOctDigit

-- | Match an ASCII hexadecimal digit.
hexDigit :: P s Char
hexDigit :: forall s. P s Char
hexDigit = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isHexDigit

-- | Match an alphabetic Unicode character. Equivalent to 'alpha'.
letter :: P s Char
letter :: forall s. P s Char
letter = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isLetter

-- | Match a Unicode mark character.
mark :: P s Char
mark :: forall s. P s Char
mark = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isMark

-- | Match a Unicode numeric character.
number :: P s Char
number :: forall s. P s Char
number = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isNumber

-- | Match a Unicode punctuation character.
punctuation :: P s Char
punctuation :: forall s. P s Char
punctuation = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isPunctuation

-- | Match a Unicode symbol character.
symbol :: P s Char
symbol :: forall s. P s Char
symbol = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isSymbol

-- | Match a Unicode space or separator character.
separator :: P s Char
separator :: forall s. P s Char
separator = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isSeparator

-- | Match a character of the ASCII character set.
ascii :: P s Char
ascii :: forall s. P s Char
ascii = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isAscii

-- | Match a character of the ISO 8859-1 (Latin-1) character set.
latin1 :: P s Char
latin1 :: forall s. P s Char
latin1 = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isLatin1

-- | Match an ASCII upper-case letter.
asciiUpper :: P s Char
asciiUpper :: forall s. P s Char
asciiUpper = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isAsciiUpper

-- | Match an ASCII lower-case letter.
asciiLower :: P s Char
asciiLower :: forall s. P s Char
asciiLower = forall s. P s Char
anyChar forall s a. P s a -> (a -> Bool) -> P s a
`onlyIf` Char -> Bool
isAsciiLower