-- ------------------------------------------------------------

{- |
   Module     : Data.String.Unicode
   Copyright  : Copyright (C) 2010- Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   Unicode and UTF-8 Conversion Functions

-}

-- ------------------------------------------------------------

module Data.String.Unicode
    (
     -- * Unicode Type declarations
     Unicode,
     UString,
     UTF8Char,
     UTF8String,
     UStringWithErrors,
     DecodingFct,
     DecodingFctEmbedErrors,

      utf8ToUnicode
    , utf8ToUnicodeEmbedErrors
    , latin1ToUnicode
    , ucs2ToUnicode
    , ucs2BigEndianToUnicode
    , ucs2LittleEndianToUnicode
    , utf16beToUnicode
    , utf16leToUnicode

    , unicodeCharToUtf8

    , unicodeToUtf8
    , unicodeToXmlEntity
    , unicodeToLatin1
    , unicodeRemoveNoneAscii
    , unicodeRemoveNoneLatin1

    , intToCharRef
    , intToCharRefHex
    , intToHexString

    , getDecodingFct
    , getDecodingFctEmbedErrors
    , getOutputEncodingFct

    , normalizeNL
    , guessEncoding

    , getOutputEncodingFct'
    , unicodeCharToUtf8'
    , unicodeCharToXmlEntity'
    , unicodeCharToLatin1'
    )
where

import           Data.Char                         (toUpper)

import           Data.Char.IsoLatinTables
import           Data.Char.Properties.XMLCharProps (isXml1ByteChar,
                                                    isXmlLatin1Char)

import           Data.String.EncodingNames
import           Data.String.UTF8Decoding          (decodeUtf8,
                                                    decodeUtf8EmbedErrors)

-- ------------------------------------------------------------

-- | Unicode is represented as the Char type
--   Precondition for this is the support of Unicode character range
--   in the compiler (e.g. ghc but not hugs)

type Unicode    = Char

-- | the type for Unicode strings

type UString    = [Unicode]

-- | UTF-8 charachters are represented by the Char type

type UTF8Char   = Char

-- | UTF-8 strings are implemented as Haskell strings

type UTF8String = String

-- | Decoding function with a pair containing the result string and a list of decoding errors as result

type DecodingFct = String -> (UString, [String])

type UStringWithErrors = [Either String Char]

-- | Decoding function where decoding errors are interleaved with decoded characters

type DecodingFctEmbedErrors = String -> UStringWithErrors

-- ------------------------------------------------------------

-- |
-- conversion from Unicode strings (UString) to UTF8 encoded strings.

unicodeToUtf8           :: UString -> UTF8String
unicodeToUtf8 :: [Char] -> [Char]
unicodeToUtf8           = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
unicodeCharToUtf8

-- |
-- conversion from Unicode (Char) to a UTF8 encoded string.

unicodeCharToUtf8       :: Unicode -> UTF8String
unicodeCharToUtf8 :: Char -> [Char]
unicodeCharToUtf8 Char
c
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0          Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x0000007F        -- 1 byte UTF8 (7 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i ]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00000080 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x000007FF        -- 2 byte UTF8 (5 + 6 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xC0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i                  Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          ]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00000800 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x0000FFFF        -- 3 byte UTF8 (4 + 6 + 6 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xE0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`   Int
0x1000)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          ]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00010000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x001FFFFF        -- 4 byte UTF8 (3 + 6 + 6 + 6 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xF0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          ]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00200000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x03FFFFFF        -- 5 byte UTF8 (2 + 6 + 6 + 6 + 6 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xF8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
0x1000000)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          ]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x04000000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7FFFFFFF        -- 6 byte UTF8 (1 + 6 + 6 + 6 + 6 + 6 bits)
        = [ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xFC Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x40000000)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
0x1000000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          , Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)
          ]
    | Bool
otherwise                                 -- other values not supported
        = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"unicodeCharToUtf8: illegal integer argument " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
    where
    i :: Int
i = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c

-- ------------------------------------------------------------

-- |
-- code conversion from latin1 to Unicode

latin1ToUnicode :: String -> UString
latin1ToUnicode :: [Char] -> [Char]
latin1ToUnicode = [Char] -> [Char]
forall a. a -> a
id

latinToUnicode  :: [(Char, Char)] -> String -> UString
latinToUnicode :: [(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
tt
    = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
charToUni
    where
    charToUni :: Char -> Char
charToUni Char
c =
       ((Char, Char) -> Char -> Char) -> Char -> [(Char, Char)] -> Char
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Char
src,Char
dst) Char
r ->
          case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
c Char
src of
             Ordering
EQ -> Char
dst
             Ordering
LT -> Char
c {- not found in table -}
             Ordering
GT -> Char
r) Char
c [(Char, Char)]
tt

-- | conversion from ASCII to unicode with check for legal ASCII char set
--
-- Structure of decoding function copied from 'Data.Char.UTF8.decode'.

decodeAscii     :: DecodingFct
decodeAscii :: DecodingFct
decodeAscii
    = ([[Char]], [Char]) -> ([Char], [[Char]])
forall a b. (a, b) -> (b, a)
swap (([[Char]], [Char]) -> ([Char], [[Char]]))
-> ([Char] -> ([[Char]], [Char])) -> DecodingFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either [Char] Char] -> ([[Char]], [Char])
forall a b. [Either a b] -> ([a], [b])
partitionEither ([Either [Char] Char] -> ([[Char]], [Char]))
-> ([Char] -> [Either [Char] Char]) -> [Char] -> ([[Char]], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Either [Char] Char]
decodeAsciiEmbedErrors

decodeAsciiEmbedErrors  :: String -> UStringWithErrors
decodeAsciiEmbedErrors :: [Char] -> [Either [Char] Char]
decodeAsciiEmbedErrors [Char]
str
    = ((Char, Int) -> Either [Char] Char)
-> [(Char, Int)] -> [Either [Char] Char]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,Int
pos) -> if Char -> Bool
isValid Char
c
                         then Char -> Either [Char] Char
forall a b. b -> Either a b
Right Char
c
                         else [Char] -> Either [Char] Char
forall a b. a -> Either a b
Left (Char -> Int -> [Char]
forall {a} {a}. (Show a, Show a) => a -> a -> [Char]
toErrStr Char
c Int
pos)) [(Char, Int)]
posStr
    where
    posStr :: [(Char, Int)]
posStr = [Char] -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char]
str [(Int
0::Int)..]
    toErrStr :: a -> a -> [Char]
toErrStr a
errChr a
pos
        = [Char]
" at input position " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
pos [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": none ASCII char " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
errChr
    isValid :: Char -> Bool
isValid Char
x = Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x80'

-- |
-- UCS-2 big endian to Unicode conversion

ucs2BigEndianToUnicode  :: String -> UString

ucs2BigEndianToUnicode :: [Char] -> [Char]
ucs2BigEndianToUnicode (Char
b : Char
l : [Char]
r)
    = Int -> Char
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
l) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
ucs2BigEndianToUnicode [Char]
r

ucs2BigEndianToUnicode []
    = []

ucs2BigEndianToUnicode [Char]
_
    = []                                -- error "illegal UCS-2 byte input sequence with odd length"
                                        -- is ignored (garbage in, garbage out)

-- ------------------------------------------------------------

-- |
-- UCS-2 little endian to Unicode conversion

ucs2LittleEndianToUnicode       :: String -> UString

ucs2LittleEndianToUnicode :: [Char] -> [Char]
ucs2LittleEndianToUnicode (Char
l : Char
b : [Char]
r)
    = Int -> Char
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
l) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
ucs2LittleEndianToUnicode [Char]
r

ucs2LittleEndianToUnicode []
    = []

ucs2LittleEndianToUnicode [Char
_]
    = []                                -- error "illegal UCS-2 byte input sequence with odd length"
                                        -- is ignored

-- ------------------------------------------------------------

-- |
-- UCS-2 to UTF-8 conversion with byte order mark analysis

ucs2ToUnicode           :: String -> UString

ucs2ToUnicode :: [Char] -> [Char]
ucs2ToUnicode (Char
'\xFE':Char
'\xFF':[Char]
s)         -- 2 byte mark for big endian encoding
    = [Char] -> [Char]
ucs2BigEndianToUnicode [Char]
s

ucs2ToUnicode (Char
'\xFF':Char
'\xFE':[Char]
s)         -- 2 byte mark for little endian encoding
    = [Char] -> [Char]
ucs2LittleEndianToUnicode [Char]
s

ucs2ToUnicode [Char]
s
    = [Char] -> [Char]
ucs2BigEndianToUnicode [Char]
s          -- default: big endian

-- ------------------------------------------------------------

-- |
-- UTF-8 to Unicode conversion with deletion of leading byte order mark, as described in XML standard F.1

utf8ToUnicode           :: DecodingFct

utf8ToUnicode :: DecodingFct
utf8ToUnicode (Char
'\xEF':Char
'\xBB':Char
'\xBF':[Char]
s)  -- remove byte order mark ( XML standard F.1 )
    = DecodingFct
decodeUtf8 [Char]
s

utf8ToUnicode [Char]
s
    = DecodingFct
decodeUtf8 [Char]
s

utf8ToUnicodeEmbedErrors        :: DecodingFctEmbedErrors

utf8ToUnicodeEmbedErrors :: [Char] -> [Either [Char] Char]
utf8ToUnicodeEmbedErrors (Char
'\xEF':Char
'\xBB':Char
'\xBF':[Char]
s)       -- remove byte order mark ( XML standard F.1 )
    = [Char] -> [Either [Char] Char]
decodeUtf8EmbedErrors [Char]
s

utf8ToUnicodeEmbedErrors [Char]
s
    = [Char] -> [Either [Char] Char]
decodeUtf8EmbedErrors [Char]
s

-- ------------------------------------------------------------

-- |
-- UTF-16 big endian to UTF-8 conversion with removal of byte order mark

utf16beToUnicode                :: String -> UString

utf16beToUnicode :: [Char] -> [Char]
utf16beToUnicode (Char
'\xFE':Char
'\xFF':[Char]
s)              -- remove byte order mark
    = [Char] -> [Char]
ucs2BigEndianToUnicode [Char]
s

utf16beToUnicode [Char]
s
    = [Char] -> [Char]
ucs2BigEndianToUnicode [Char]
s

-- ------------------------------------------------------------

-- |
-- UTF-16 little endian to UTF-8 conversion with removal of byte order mark

utf16leToUnicode                :: String -> UString

utf16leToUnicode :: [Char] -> [Char]
utf16leToUnicode (Char
'\xFF':Char
'\xFE':[Char]
s)              -- remove byte order mark
    = [Char] -> [Char]
ucs2LittleEndianToUnicode [Char]
s

utf16leToUnicode [Char]
s
    = [Char] -> [Char]
ucs2LittleEndianToUnicode [Char]
s


-- ------------------------------------------------------------

-- |
-- substitute all Unicode characters, that are not legal 1-byte
-- UTF-8 XML characters by a character reference.
--
-- This function can be used to translate all text nodes and
-- attribute values into pure ascii.
--
-- see also : 'unicodeToLatin1'

unicodeToXmlEntity      :: UString -> String
unicodeToXmlEntity :: [Char] -> [Char]
unicodeToXmlEntity
    = (Char -> Bool) -> (Char -> [Char]) -> [Char] -> [Char]
escape Char -> Bool
isXml1ByteChar (Int -> [Char]
intToCharRef (Int -> [Char]) -> (Char -> Int) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

-- |
-- substitute all Unicode characters, that are not legal latin1
-- UTF-8 XML characters by a character reference.
--
-- This function can be used to translate all text nodes and
-- attribute values into ISO latin1.
--
-- see also : 'unicodeToXmlEntity'

unicodeToLatin1 :: UString -> String
unicodeToLatin1 :: [Char] -> [Char]
unicodeToLatin1
    = (Char -> Bool) -> (Char -> [Char]) -> [Char] -> [Char]
escape Char -> Bool
isXmlLatin1Char (Int -> [Char]
intToCharRef (Int -> [Char]) -> (Char -> Int) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)


-- |
-- substitute selected characters
-- The @check@ function returns 'True' whenever a character needs to substitution
-- The function @esc@ computes a substitute.

escape :: (Unicode -> Bool) -> (Unicode -> String) -> UString -> String
escape :: (Char -> Bool) -> (Char -> [Char]) -> [Char] -> [Char]
escape Char -> Bool
check Char -> [Char]
esc =
    (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
uc -> if Char -> Bool
check Char
uc then [Char
uc] else Char -> [Char]
esc Char
uc)

-- |
-- removes all non ascii chars, may be used to transform
-- a document into a pure ascii representation by removing
-- all non ascii chars from tag and attibute names
--
-- see also : 'unicodeRemoveNoneLatin1', 'unicodeToXmlEntity'

unicodeRemoveNoneAscii  :: UString -> String
unicodeRemoveNoneAscii :: [Char] -> [Char]
unicodeRemoveNoneAscii
    = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isXml1ByteChar

-- |
-- removes all non latin1 chars, may be used to transform
-- a document into a pure ascii representation by removing
-- all non ascii chars from tag and attibute names
--
-- see also : 'unicodeRemoveNoneAscii', 'unicodeToLatin1'

unicodeRemoveNoneLatin1 :: UString -> String
unicodeRemoveNoneLatin1 :: [Char] -> [Char]
unicodeRemoveNoneLatin1
    = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isXmlLatin1Char

-- ------------------------------------------------------------

-- |
-- convert an Unicode into a XML character reference.
--
-- see also : 'intToCharRefHex'

intToCharRef            :: Int -> String
intToCharRef :: Int -> [Char]
intToCharRef Int
i
    = [Char]
"&#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"

-- |
-- convert an Unicode into a XML hexadecimal character reference.
--
-- see also: 'intToCharRef'

intToCharRefHex         :: Int -> String
intToCharRefHex :: Int -> [Char]
intToCharRefHex Int
i
    = [Char]
"&#x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
h2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
      where
      h1 :: [Char]
h1 = Int -> [Char]
intToHexString Int
i
      h2 :: [Char]
h2 = if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
           then Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
h1
           else [Char]
h1

-- ------------------------------------------------------------

intToHexString          :: Int -> String
intToHexString :: Int -> [Char]
intToHexString Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        = [Char]
"0"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        = Int -> [Char]
intToStr Int
i
    | Bool
otherwise
        = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"intToHexString: negative argument " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
    where
    intToStr :: Int -> [Char]
intToStr Int
0  = [Char]
""
    intToStr Int
i' = Int -> [Char]
intToStr (Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int -> Char
fourBitsToChar (Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16)]

fourBitsToChar          :: Int -> Char
fourBitsToChar :: Int -> Char
fourBitsToChar Int
i        = [Char]
"0123456789ABCDEF" [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
{-# INLINE fourBitsToChar #-}

-- ------------------------------------------------------------
--
-- | White Space (XML Standard 2.3) and
-- end of line handling (2.11)
--
-- \#x0D and \#x0D\#x0A are mapped to \#x0A

normalizeNL     :: String -> String
normalizeNL :: [Char] -> [Char]
normalizeNL (Char
'\r' : Char
'\n' : [Char]
rest)        = Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
normalizeNL [Char]
rest
normalizeNL (Char
'\r' : [Char]
rest)               = Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
normalizeNL [Char]
rest
normalizeNL (Char
c : [Char]
rest)                  = Char
c    Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
normalizeNL [Char]
rest
normalizeNL []                          = []


-- ------------------------------------------------------------

-- |
-- the table of supported character encoding schemes and the associated
-- conversion functions into Unicode:q

{-
This table could be derived from decodingTableEither,
but this way it is certainly more efficient.
-}

decodingTable   :: [(String, DecodingFct)]
decodingTable :: [([Char], DecodingFct)]
decodingTable
    = [ ([Char]
utf8,          DecodingFct
utf8ToUnicode                           )
      , ([Char]
isoLatin1,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
latin1ToUnicode              )
      , ([Char]
usAscii,       DecodingFct
decodeAscii                             )
      , ([Char]
ucs2,          ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
ucs2ToUnicode                )
      , ([Char]
utf16,         ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
ucs2ToUnicode                )
      , ([Char]
utf16be,       ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
utf16beToUnicode             )
      , ([Char]
utf16le,       ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
utf16leToUnicode             )
      , ([Char]
iso8859_2,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_2)  )
      , ([Char]
iso8859_3,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_3)  )
      , ([Char]
iso8859_4,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_4)  )
      , ([Char]
iso8859_5,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_5)  )
      , ([Char]
iso8859_6,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_6)  )
      , ([Char]
iso8859_7,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_7)  )
      , ([Char]
iso8859_8,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_8)  )
      , ([Char]
iso8859_9,     ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_9)  )
      , ([Char]
iso8859_10,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_10) )
      , ([Char]
iso8859_11,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_11) )
      , ([Char]
iso8859_13,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_13) )
      , ([Char]
iso8859_14,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_14) )
      , ([Char]
iso8859_15,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_15) )
      , ([Char]
iso8859_16,    ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_16) )
      , ([Char]
unicodeString, ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
forall a. a -> a
id                           )
      , ([Char]
"",            ([Char] -> [Char]) -> DecodingFct
forall {t} {a} {a}. (t -> a) -> t -> (a, [a])
liftDecFct [Char] -> [Char]
forall a. a -> a
id                           )       -- default
      ]
    where
    liftDecFct :: (t -> a) -> t -> (a, [a])
liftDecFct t -> a
df = \ t
s -> (t -> a
df t
s, [])

-- |
-- the lookup function for selecting the decoding function

getDecodingFct          :: String -> Maybe DecodingFct
getDecodingFct :: [Char] -> Maybe DecodingFct
getDecodingFct [Char]
enc
    = [Char] -> [([Char], DecodingFct)] -> Maybe DecodingFct
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
enc) [([Char], DecodingFct)]
decodingTable


-- |
-- Similar to 'decodingTable' but it embeds errors
-- in the string of decoded characters.

decodingTableEmbedErrors        :: [(String, DecodingFctEmbedErrors)]
decodingTableEmbedErrors :: [([Char], [Char] -> [Either [Char] Char])]
decodingTableEmbedErrors
    = [ ([Char]
utf8,          [Char] -> [Either [Char] Char]
utf8ToUnicodeEmbedErrors                )
      , ([Char]
isoLatin1,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
latin1ToUnicode              )
      , ([Char]
usAscii,       [Char] -> [Either [Char] Char]
decodeAsciiEmbedErrors                  )
      , ([Char]
ucs2,          ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
ucs2ToUnicode                )
      , ([Char]
utf16,         ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
ucs2ToUnicode                )
      , ([Char]
utf16be,       ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
utf16beToUnicode             )
      , ([Char]
utf16le,       ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
utf16leToUnicode             )
      , ([Char]
iso8859_2,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_2)  )
      , ([Char]
iso8859_3,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_3)  )
      , ([Char]
iso8859_4,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_4)  )
      , ([Char]
iso8859_5,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_5)  )
      , ([Char]
iso8859_6,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_6)  )
      , ([Char]
iso8859_7,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_7)  )
      , ([Char]
iso8859_8,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_8)  )
      , ([Char]
iso8859_9,     ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_9)  )
      , ([Char]
iso8859_10,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_10) )
      , ([Char]
iso8859_11,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_11) )
      , ([Char]
iso8859_13,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_13) )
      , ([Char]
iso8859_14,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_14) )
      , ([Char]
iso8859_15,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_15) )
      , ([Char]
iso8859_16,    ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct ([(Char, Char)] -> [Char] -> [Char]
latinToUnicode [(Char, Char)]
iso_8859_16) )
      , ([Char]
unicodeString, ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
forall a. a -> a
id                           )
      , ([Char]
"",            ([Char] -> [Char]) -> [Char] -> [Either [Char] Char]
forall {a} {a} {a}. (a -> [a]) -> a -> [Either a a]
liftDecFct [Char] -> [Char]
forall a. a -> a
id                           )       -- default
      ]
    where
    liftDecFct :: (a -> [a]) -> a -> [Either a a]
liftDecFct a -> [a]
df = (a -> Either a a) -> [a] -> [Either a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a a
forall a b. b -> Either a b
Right ([a] -> [Either a a]) -> (a -> [a]) -> a -> [Either a a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
df

-- |
-- the lookup function for selecting the decoding function

getDecodingFctEmbedErrors       :: String -> Maybe DecodingFctEmbedErrors
getDecodingFctEmbedErrors :: [Char] -> Maybe ([Char] -> [Either [Char] Char])
getDecodingFctEmbedErrors [Char]
enc
    = [Char]
-> [([Char], [Char] -> [Either [Char] Char])]
-> Maybe ([Char] -> [Either [Char] Char])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
enc) [([Char], [Char] -> [Either [Char] Char])]
decodingTableEmbedErrors



-- |
-- the table of supported output encoding schemes and the associated
-- conversion functions from Unicode

outputEncodingTable     :: [(String, (UString -> String))]
outputEncodingTable :: [([Char], [Char] -> [Char])]
outputEncodingTable
    = [ ([Char]
utf8,          [Char] -> [Char]
unicodeToUtf8           )
      , ([Char]
isoLatin1,     [Char] -> [Char]
unicodeToLatin1         )
      , ([Char]
usAscii,       [Char] -> [Char]
unicodeToXmlEntity      )
      , ([Char]
unicodeString, [Char] -> [Char]
forall a. a -> a
id                      )
      , ([Char]
"",            [Char] -> [Char]
unicodeToUtf8           )       -- default
      ]

-- |
-- the lookup function for selecting the encoding function

getOutputEncodingFct            :: String -> Maybe (String -> UString)
getOutputEncodingFct :: [Char] -> Maybe ([Char] -> [Char])
getOutputEncodingFct [Char]
enc
    = [Char] -> [([Char], [Char] -> [Char])] -> Maybe ([Char] -> [Char])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
enc) [([Char], [Char] -> [Char])]
outputEncodingTable

-- ------------------------------------------------------------
--

guessEncoding           :: String -> String

guessEncoding :: [Char] -> [Char]
guessEncoding (Char
'\xFF':Char
'\xFE':Char
'\x00':Char
'\x00':[Char]
_)   = [Char]
"UCS-4LE"             -- with byte order mark
guessEncoding (Char
'\xFF':Char
'\xFE':[Char]
_)                 = [Char]
"UTF-16LE"            -- with byte order mark

guessEncoding (Char
'\xFE':Char
'\xFF':Char
'\x00':Char
'\x00':[Char]
_)   = [Char]
"UCS-4-3421"          -- with byte order mark
guessEncoding (Char
'\xFE':Char
'\xFF':[Char]
_)                 = [Char]
"UTF-16BE"            -- with byte order mark

guessEncoding (Char
'\xEF':Char
'\xBB':Char
'\xBF':[Char]
_)          = [Char]
utf8                  -- with byte order mark

guessEncoding (Char
'\x00':Char
'\x00':Char
'\xFE':Char
'\xFF':[Char]
_)   = [Char]
"UCS-4BE"             -- with byte order mark
guessEncoding (Char
'\x00':Char
'\x00':Char
'\xFF':Char
'\xFE':[Char]
_)   = [Char]
"UCS-4-2143"          -- with byte order mark

guessEncoding (Char
'\x00':Char
'\x00':Char
'\x00':Char
'\x3C':[Char]
_)   = [Char]
"UCS-4BE"             -- "<" of "<?xml"
guessEncoding (Char
'\x3C':Char
'\x00':Char
'\x00':Char
'\x00':[Char]
_)   = [Char]
"UCS-4LE"             -- "<" of "<?xml"
guessEncoding (Char
'\x00':Char
'\x00':Char
'\x3C':Char
'\x00':[Char]
_)   = [Char]
"UCS-4-2143"          -- "<" of "<?xml"
guessEncoding (Char
'\x00':Char
'\x3C':Char
'\x00':Char
'\x00':[Char]
_)   = [Char]
"UCS-4-3412"          -- "<" of "<?xml"

guessEncoding (Char
'\x00':Char
'\x3C':Char
'\x00':Char
'\x3F':[Char]
_)   = [Char]
"UTF-16BE"            -- "<?" of "<?xml"
guessEncoding (Char
'\x3C':Char
'\x00':Char
'\x3F':Char
'\x00':[Char]
_)   = [Char]
"UTF-16LE"            -- "<?" of "<?xml"

guessEncoding (Char
'\x4C':Char
'\x6F':Char
'\xA7':Char
'\x94':[Char]
_)   = [Char]
"EBCDIC"              -- "<?xm" of "<?xml"

guessEncoding [Char]
_                                 = [Char]
""                    -- no guess

-- ------------------------------------------------------------

swap :: (a,b) -> (b,a)
swap :: forall a b. (a, b) -> (b, a)
swap (a
x,b
y) = (b
y,a
x)
{-# INLINE swap #-}

partitionEither :: [Either a b] -> ([a], [b])
partitionEither :: forall a b. [Either a b] -> ([a], [b])
partitionEither =
   (Either a b -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [Either a b] -> ([a], [b])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Either a b
x ~([a]
ls,[b]
rs) -> (a -> ([a], [b])) -> (b -> ([a], [b])) -> Either a b -> ([a], [b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
l -> (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls,[b]
rs)) (\b
r -> ([a]
ls,b
rb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
rs)) Either a b
x) ([],[])
{-# INLINE partitionEither #-}

-- ------------------------------------------------------------

-- output encoding for bytestrings

-- |
-- the table of supported output encoding schemes and the associated
-- conversion functions from Unicode

type StringFct          = String -> String

outputEncodingTable'     :: [(String, (Char -> StringFct))]
outputEncodingTable' :: [([Char], Char -> [Char] -> [Char])]
outputEncodingTable'
    = [ ([Char]
utf8,          Char -> [Char] -> [Char]
unicodeCharToUtf8'           )
      , ([Char]
isoLatin1,     Char -> [Char] -> [Char]
unicodeCharToLatin1'         )
      , ([Char]
usAscii,       Char -> [Char] -> [Char]
unicodeCharToXmlEntity'      )
      , ([Char]
"",            Char -> [Char] -> [Char]
unicodeCharToUtf8'           )       -- default
      ]

-- |
-- the lookup function for selecting the encoding function

getOutputEncodingFct'            :: String -> Maybe (Char -> StringFct)
getOutputEncodingFct' :: [Char] -> Maybe (Char -> [Char] -> [Char])
getOutputEncodingFct' [Char]
enc
    = [Char]
-> [([Char], Char -> [Char] -> [Char])]
-> Maybe (Char -> [Char] -> [Char])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
enc) [([Char], Char -> [Char] -> [Char])]
outputEncodingTable'


-- ------------------------------------------------------------

-- |
-- conversion from Unicode (Char) to a UTF8 encoded string.

unicodeCharToUtf8'      :: Char -> StringFct
unicodeCharToUtf8' :: Char -> [Char] -> [Char]
unicodeCharToUtf8' Char
c
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0          Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x0000007F        -- 1 byte UTF8 (7 bits)
        = (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00000080 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x000007FF        -- 2 byte UTF8 (5 + 6 bits)
        = ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xC0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x40)                   ) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i                    Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00000800 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x0000FFFF        -- 3 byte UTF8 (4 + 6 + 6 bits)
        = ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xE0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000)            ) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00010000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x001FFFFF        -- 4 byte UTF8 (3 + 6 + 6 + 6 bits) -- extension to encode 21 bit values
        = ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xF0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000)            ) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00200000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x03FFFFFF        -- 5 byte UTF8 (2 + 6 + 6 + 6 + 6 bits) -- extension to encode 26 bit values
        = ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xF8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
0x1000000)            ) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x04000000 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7FFFFFFF        -- 6 byte UTF8 (1 + 6 + 6 + 6 + 6 + 6 bits) -- extension to encode 31 bit values
        = ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0xFC Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x40000000)            ) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
0x1000000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`    Int
0x40000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`     Int
0x1000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`       Int
0x40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
i                   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x40)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

    | Bool
otherwise                                 -- other values not supported
        = [Char] -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"unicodeCharToUtf8: illegal integer argument " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
    where
    i :: Int
i = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c

-- ------------------------------------------------------------

-- |
-- substitute all Unicode characters, that are not legal 1-byte
-- UTF-8 XML characters by a character reference.

unicodeCharToXmlEntity' :: Char -> StringFct
unicodeCharToXmlEntity' :: Char -> [Char] -> [Char]
unicodeCharToXmlEntity' Char
c
    | Char -> Bool
isXml1ByteChar Char
c  = (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
    | Bool
otherwise         = ((Int -> [Char]
intToCharRef (Int -> [Char]) -> (Char -> Int) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> [Char]) -> Char -> [Char]
forall a b. (a -> b) -> a -> b
$ Char
c) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)

-- ------------------------------------------------------------

-- |
-- substitute all Unicode characters, that are not legal latin1
-- UTF-8 XML characters by a character reference.

unicodeCharToLatin1'    :: Char -> StringFct
unicodeCharToLatin1' :: Char -> [Char] -> [Char]
unicodeCharToLatin1' Char
c
    | Char -> Bool
isXmlLatin1Char Char
c = (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
    | Bool
otherwise         = ((Int -> [Char]
intToCharRef (Int -> [Char]) -> (Char -> Int) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> [Char]) -> Char -> [Char]
forall a b. (a -> b) -> a -> b
$ Char
c) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)

-- ------------------------------------------------------------