module Data.Char
(
Char
, String
, isControl, isSpace
, isLower, isUpper, isAlpha, isAlphaNum, isPrint
, isDigit, isOctDigit, isHexDigit
, isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator
, isAscii, isLatin1
, isAsciiUpper, isAsciiLower
, GeneralCategory(..), generalCategory
, toUpper, toLower, toTitle
, digitToInt
, intToDigit
, ord
, chr
, showLitChar
, lexLitChar
, readLitChar
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.Arr (Ix)
import GHC.Real (fromIntegral)
import GHC.Show
import GHC.Read (Read, readLitChar, lexLitChar)
import GHC.Unicode
import GHC.Num
import GHC.Enum
#endif
#ifdef __HUGS__
import Hugs.Prelude (Ix)
import Hugs.Char
#endif
#ifdef __NHC__
import Prelude
import Prelude(Char,String)
import Char
import Ix
import NHC.FFI (CInt)
foreign import ccall unsafe "WCsubst.h u_gencat" wgencat :: CInt -> CInt
#endif
digitToInt :: Char -> Int
digitToInt c
| isDigit c = ord c ord '0'
| c >= 'a' && c <= 'f' = ord c ord 'a' + 10
| c >= 'A' && c <= 'F' = ord c ord 'A' + 10
| otherwise = error ("Char.digitToInt: not a digit " ++ show c)
#ifndef __GLASGOW_HASKELL__
isAsciiUpper, isAsciiLower :: Char -> Bool
isAsciiLower c = c >= 'a' && c <= 'z'
isAsciiUpper c = c >= 'A' && c <= 'Z'
#endif
data GeneralCategory
= UppercaseLetter
| LowercaseLetter
| TitlecaseLetter
| ModifierLetter
| OtherLetter
| NonSpacingMark
| SpacingCombiningMark
| EnclosingMark
| DecimalNumber
| LetterNumber
| OtherNumber
| ConnectorPunctuation
| DashPunctuation
| OpenPunctuation
| ClosePunctuation
| InitialQuote
| FinalQuote
| OtherPunctuation
| MathSymbol
| CurrencySymbol
| ModifierSymbol
| OtherSymbol
| Space
| LineSeparator
| ParagraphSeparator
| Control
| Format
| Surrogate
| PrivateUse
| NotAssigned
deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)
generalCategory :: Char -> GeneralCategory
#if defined(__GLASGOW_HASKELL__) || defined(__NHC__)
generalCategory c = toEnum $ fromIntegral $ wgencat $ fromIntegral $ ord c
#endif
#ifdef __HUGS__
generalCategory c = toEnum (primUniGenCat c)
#endif
isLetter :: Char -> Bool
isLetter c = case generalCategory c of
UppercaseLetter -> True
LowercaseLetter -> True
TitlecaseLetter -> True
ModifierLetter -> True
OtherLetter -> True
_ -> False
isMark :: Char -> Bool
isMark c = case generalCategory c of
NonSpacingMark -> True
SpacingCombiningMark -> True
EnclosingMark -> True
_ -> False
isNumber :: Char -> Bool
isNumber c = case generalCategory c of
DecimalNumber -> True
LetterNumber -> True
OtherNumber -> True
_ -> False
isPunctuation :: Char -> Bool
isPunctuation c = case generalCategory c of
ConnectorPunctuation -> True
DashPunctuation -> True
OpenPunctuation -> True
ClosePunctuation -> True
InitialQuote -> True
FinalQuote -> True
OtherPunctuation -> True
_ -> False
isSymbol :: Char -> Bool
isSymbol c = case generalCategory c of
MathSymbol -> True
CurrencySymbol -> True
ModifierSymbol -> True
OtherSymbol -> True
_ -> False
isSeparator :: Char -> Bool
isSeparator c = case generalCategory c of
Space -> True
LineSeparator -> True
ParagraphSeparator -> True
_ -> False
#ifdef __NHC__
toTitle :: Char -> Char
toTitle = toUpper
#endif