module Text.XML.Basic.Entity (
Name,
list, listInternetExploder,
mapNameToChar, mapCharToName,
numberToChar,
) where
import qualified Data.Map as Map
import qualified Data.Char as Char
import Control.Monad.Exception.Synchronous (Exceptional, assert, throw, )
import Control.Monad.HT ((<=<), )
import Data.Monoid (Monoid(mempty, mappend), mconcat, )
import Data.Semigroup (Semigroup((<>)), )
import Data.Tuple.HT (swap, )
numberToChar :: String -> Exceptional String Char
numberToChar :: Name -> Exceptional Name Char
numberToChar Name
s =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
Char.chr forall a b. (a -> b) -> a -> b
$
case Name
s of
(Char
'x':Name
ds) -> Int -> (Char -> Bool) -> Name -> Exceptional Name Int
readBounded Int
16 Char -> Bool
Char.isHexDigit Name
ds
Name
ds -> Int -> (Char -> Bool) -> Name -> Exceptional Name Int
readBounded Int
10 Char -> Bool
Char.isDigit Name
ds
readBounded :: Int -> (Char -> Bool) -> String -> Exceptional String Int
readBounded :: Int -> (Char -> Bool) -> Name -> Exceptional Name Int
readBounded Int
base Char -> Bool
validChar Name
str =
case Name
str of
Name
"" -> forall e a. e -> Exceptional e a
throw Name
"empty number string"
Name
"0" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
Name
_ ->
let m :: Char -> Update Name Int
m Char
digit =
forall e a. (a -> Exceptional e a) -> Update e a
Update forall a b. (a -> b) -> a -> b
$ \Int
mostSig ->
let n :: Int
n = Int
mostSigforall a. Num a => a -> a -> a
*Int
base forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
digit
in forall e. e -> Bool -> Exceptional e ()
assert (Name
"invalid character "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> Name
show Char
digit)
(Char -> Bool
validChar Char
digit) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall e. e -> Bool -> Exceptional e ()
assert Name
"leading zero not allowed for security reasons"
(Bool -> Bool
not (Int
mostSigforall a. Eq a => a -> a -> Bool
==Int
0 Bool -> Bool -> Bool
&& Char
digitforall a. Eq a => a -> a -> Bool
==Char
'0')) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall e. e -> Bool -> Exceptional e ()
assert Name
"number too big"
(Int
n forall a. Ord a => a -> a -> Bool
<= Char -> Int
Char.ord forall a. Bounded a => a
maxBound) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
in forall e a. Update e a -> a -> Exceptional e a
evalUpdate (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Update Name Int
m Name
str) Int
0
newtype Update e a = Update {forall e a. Update e a -> a -> Exceptional e a
evalUpdate :: a -> Exceptional e a}
instance Semigroup (Update e a) where
Update a -> Exceptional e a
x <> :: Update e a -> Update e a -> Update e a
<> Update a -> Exceptional e a
y = forall e a. (a -> Exceptional e a) -> Update e a
Update (a -> Exceptional e a
y forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> Exceptional e a
x)
instance Monoid (Update e a) where
mempty :: Update e a
mempty = forall e a. (a -> Exceptional e a) -> Update e a
Update forall (m :: * -> *) a. Monad m => a -> m a
return
mappend :: Update e a -> Update e a -> Update e a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
type Name = String
mapNameToChar :: Map.Map Name Char
mapNameToChar :: Map Name Char
mapNameToChar =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Char)]
list
mapCharToName :: Map.Map Char Name
mapCharToName :: Map Char Name
mapCharToName =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap [(Name, Char)]
list
list :: [(Name, Char)]
list :: [(Name, Char)]
list =
(Name
"apos", Char
'\'') forall a. a -> [a] -> [a]
:
[(Name, Char)]
listInternetExploder
listInternetExploder :: [(Name, Char)]
listInternetExploder :: [(Name, Char)]
listInternetExploder =
(Name
"quot", Char
'"') forall a. a -> [a] -> [a]
:
(Name
"amp", Char
'&') forall a. a -> [a] -> [a]
:
(Name
"lt", Char
'<') forall a. a -> [a] -> [a]
:
(Name
"gt", Char
'>') forall a. a -> [a] -> [a]
:
[]