module Text.HTML.Basic.Character (
   T(..), toUnicode, toUnicodeOrFormat,
   fromUnicode, fromCharRef, fromEntityRef,
   maybeUnicode, maybeCharRef, maybeEntityRef,
   isUnicode, isCharRef, isEntityRef, isRef,
   unicode, refC, refE,
   asciiFromUnicode,
   asciiFromUnicodeInternetExploder,
   minimalRefFromUnicode,
   reduceRef,
   validCharRef, switchUnicodeRuns,
   isLower, isUpper, toLower, toUpper,
   ) where

import Text.XML.Basic.Character
   hiding (toUnicode, toUnicodeOrFormat, asciiFromUnicode, reduceRef, )
import qualified Text.HTML.Basic.Entity as Ent
import qualified Data.Char as Char
import qualified Data.Map  as Map
import Data.Maybe (fromMaybe, )

import qualified Control.Monad.Exception.Synchronous as Exc


toUnicode :: T -> Exc.Exceptional String Char
toUnicode :: T -> Exceptional Name Char
toUnicode = Map Name Char -> T -> Exceptional Name Char
toUnicodeGen Map Name Char
Ent.mapNameToChar

toUnicodeOrFormat :: T -> ShowS
toUnicodeOrFormat :: T -> ShowS
toUnicodeOrFormat =
   Map Name Char -> T -> ShowS
toUnicodeOrFormatGen Map Name Char
Ent.mapNameToChar

{-|
Convert unicode character to XML Char.
If there is a named reference, use this.
If it is ASCII, represent it as Char.
Otherwise use a numeric reference.
-}
asciiFromUnicode :: Char -> T
asciiFromUnicode :: Char -> T
asciiFromUnicode =
   Map Char Name -> Char -> T
asciiFromUnicodeGen Map Char Name
Ent.mapCharToName

asciiFromUnicodeInternetExploder :: Char -> T
asciiFromUnicodeInternetExploder :: Char -> T
asciiFromUnicodeInternetExploder =
   Map Char Name -> Char -> T
asciiFromUnicodeGen Map Char Name
Ent.mapCharToNameInternetExploder

reduceRef :: T -> T
reduceRef :: T -> T
reduceRef = Map Name Char -> T -> T
reduceRefGen Map Name Char
Ent.mapNameToChar


isLower :: T -> Bool
isLower :: T -> Bool
isLower =
   forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
Exc.switch (forall a b. a -> b -> a
const Bool
False) Char -> Bool
Char.isLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Exceptional Name Char
toUnicode

isUpper :: T -> Bool
isUpper :: T -> Bool
isUpper =
   forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
Exc.switch (forall a b. a -> b -> a
const Bool
False) Char -> Bool
Char.isUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Exceptional Name Char
toUnicode


toLower :: T -> T
toLower :: T -> T
toLower = (Char -> Char) -> T -> T
lift Char -> Char
Char.toLower

toUpper :: T -> T
toUpper :: T -> T
toUpper = (Char -> Char) -> T -> T
lift Char -> Char
Char.toUpper

lift :: (Char -> Char) -> T -> T
lift :: (Char -> Char) -> T -> T
lift Char -> Char
f T
x =
   case T
x of
      Unicode Char
c -> Char -> T
Unicode forall a b. (a -> b) -> a -> b
$ Char -> Char
f Char
c
      CharRef Int
n -> Int -> T
CharRef forall a b. (a -> b) -> a -> b
$
         if Int -> Bool
validCharRef Int
n then Char -> Int
Char.ord forall a b. (a -> b) -> a -> b
$ Char -> Char
f forall a b. (a -> b) -> a -> b
$ Int -> Char
Char.chr Int
n else Int
n
      EntityRef Name
n -> Name -> T
EntityRef forall a b. (a -> b) -> a -> b
$
         forall a. a -> Maybe a -> a
fromMaybe Name
n forall a b. (a -> b) -> a -> b
$
         forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Char Name
Ent.mapCharToName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Name Char
Ent.mapNameToChar Name
n