{-# OPTIONS_GHC -cpp #-}
module HaskellChars where
import Char

data HaskellChar
  = ASCII Char
  | UniWhite   -- any Unicode character defined as whitespace
  | UniSymbol  -- any Unicode symbol or punctuation
  | UniDigit   -- any Unicode numeric
  | UniLarge   -- any uppercase or titlecase Unicode letter
  | UniSmall   -- any Unicode lowercase letter
  deriving (Eq,Ord{-,Show-})

acs = map ASCII

-- Character classifications:
special   = acs "(),;[]`{}"
creturn   = acs "\r"
linefeed  = acs "\LF"
vertab    = acs "\VT"
formfeed  = acs "\FF"
space     = acs " \xa0"
tab       = acs "\t"
uniWhite  = [UniWhite]
cany      = graphic++space++tab
graphic   = small++large++symbol++digit++special++acs ":\"'"++latin1Print
small     = ascSmall++uniSmall++acs "_"
ascSmall  = acs ['a'..'z']
uniSmall  = [UniSmall] ++acs latin1Lower -- because of isSymbol workaround
large     = ascLarge++uniLarge
ascLarge  = acs ['A'..'Z']
uniLarge  = [UniLarge] ++acs latin1Upper -- because of isSymbol workaround
symbol    = ascSymbol++uniSymbol
ascSymbol = acs "!#$%&*+./<=>?@\\^|-~"
uniSymbol = [UniSymbol]++acs latin1Symbol -- !! GHC missing isSymbol workaround
digit     = ascDigit++uniDigit
ascDigit  = acs ['0'..'9']
uniDigit  = [UniDigit]
octit     = acs ['0'..'7']
hexit     = digit ++ acs ['A'..'F'] ++ acs ['a'..'f']

-- Some of these are actually UniSmall, UniLarge, UniSymbol, but since GHC's
-- isUpper etc doesn't recognize them, we include them here, as a partial
-- workaround.
latin1Print = acs ['\160'..'\255']





latin1Upper = "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
latin1Lower = "ßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
latin1Symbol = "¡¢£¤¥¦§¨©¬­®¯°±´¶·¸¿×÷"


----

instance Show HaskellChar where
  showsPrec d h =
    case h of
      ASCII c   -> showsPrec d c
      UniWhite  -> showString "UW"
      UniSymbol -> showString "US"
      UniDigit  -> showString "UD"
      UniLarge  -> showString "UU"
      UniSmall  -> showString "UL"

  showList s = showChar '"' . foldr ((.).shC) id s . showChar '"'
    where
      shC h =
	case h of
	  ASCII c   -> showString (init . tail $ show c)
	  UniWhite  -> showS "UW"
	  UniSymbol -> showS "US"
	  UniDigit  -> showS "UD"
	  UniLarge  -> showS "UU"
	  UniSmall  -> showS "UL"
        where showS s = showChar '"' . showString s . showChar '"'