Data/Char.hs (original) (raw)

module Data.Char ( Char

, 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.Char 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