    {-# LANGUAGE TypeSynonymInstances #-}

    module Text.XML.Light.Lexer where

    import Text.XML.Light.Types

    import Data.Char (chr,isSpace)
    import Numeric (readHex)
    import qualified Data.ByteString      as S
    import qualified Data.ByteString.Lazy as L
    import qualified Data.Text            as TS
    import qualified Data.Text.Lazy       as TL

    class XmlSource s where
      uncons :: s -> Maybe (Char,s)

    instance XmlSource String where
      uncons :: String -> Maybe (Char, String)
    uncons (Char
    c:String
    s) = (Char, String) -> Maybe (Char, String)
    forall a. a -> Maybe a
    Just (Char
    c,String
    s)
      uncons String
    ""    = Maybe (Char, String)
    forall a. Maybe a
    Nothing

    instance XmlSource S.ByteString where
      uncons :: ByteString -> Maybe (Char, ByteString)
    uncons ByteString
    bs = (Word8, ByteString) -> (Char, ByteString)
    forall {a} {b}. Enum a => (a, b) -> (Char, b)
    f ((Word8, ByteString) -> (Char, ByteString))
    -> Maybe (Word8, ByteString) -> Maybe (Char, ByteString)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ByteString -> Maybe (Word8, ByteString)
    S.uncons ByteString
    bs
        where f :: (a, b) -> (Char, b)
    f (a
    c,b
    s) = (Int -> Char
    chr (a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c), b
    s)

    instance XmlSource L.ByteString where
      uncons :: ByteString -> Maybe (Char, ByteString)
    uncons ByteString
    bs = (Word8, ByteString) -> (Char, ByteString)
    forall {a} {b}. Enum a => (a, b) -> (Char, b)
    f ((Word8, ByteString) -> (Char, ByteString))
    -> Maybe (Word8, ByteString) -> Maybe (Char, ByteString)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ByteString -> Maybe (Word8, ByteString)
    L.uncons ByteString
    bs
        where f :: (a, b) -> (Char, b)
    f (a
    c,b
    s) = (Int -> Char
    chr (a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c), b
    s)

    instance XmlSource TS.Text where
      uncons :: Text -> Maybe (Char, Text)
    uncons = Text -> Maybe (Char, Text)
    TS.uncons

    instance XmlSource TL.Text where
      uncons :: Text -> Maybe (Char, Text)
    uncons = Text -> Maybe (Char, Text)
    TL.uncons

    linenumber :: XmlSource s => Integer -> s -> LString
    linenumber :: forall s. XmlSource s => Integer -> s -> LString
    linenumber Integer
    n s
    s = case s -> Maybe (Char, s)
    forall s. XmlSource s => s -> Maybe (Char, s)
    uncons s
    s of
      Maybe (Char, s)
    Nothing -> []
      Just (Char
    '\r', s
    s')   -> case s -> Maybe (Char, s)
    forall s. XmlSource s => s -> Maybe (Char, s)
    uncons s
    s' of
        Just (Char
    '\n',s
    s'') -> s -> LString
    forall {s}. XmlSource s => s -> LString
    next s
    s''
        Maybe (Char, s)
    _               -> s -> LString
    forall {s}. XmlSource s => s -> LString
    next s
    s'
      Just (Char
    '\n', s
    s') -> s -> LString
    forall {s}. XmlSource s => s -> LString
    next s
    s'
      Just (Char
    c   , s
    s') -> (Integer
    n,Char
    c) LChar -> LString -> LString
    forall a. a -> [a] -> [a]
    : Integer -> s -> LString
    forall s. XmlSource s => Integer -> s -> LString
    linenumber Integer
    n s
    s'
      where
      next :: s -> LString
    next s
    s' = Integer
    n' Integer -> LString -> LString
    forall a b. a -> b -> b
    `seq` ((Integer
    n,Char
    '\n')LChar -> LString -> LString
    forall a. a -> [a] -> [a]
    :Integer -> s -> LString
    forall s. XmlSource s => Integer -> s -> LString
    linenumber Integer
    n' s
    s') where n' :: Integer
    n' = Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1

    -- | This type may be used to provide a custom scanning function
    -- for extracting characters.
    data Scanner s = Scanner (Maybe (Char,s)) (s -> Maybe (Char,s))

    -- | This type may be used to provide a custom scanning function
    -- for extracting characters.
    customScanner :: (s -> Maybe (Char,s)) -> s -> Scanner s
    customScanner :: forall s. (s -> Maybe (Char, s)) -> s -> Scanner s
    customScanner s -> Maybe (Char, s)
    next s
    s = Maybe (Char, s) -> (s -> Maybe (Char, s)) -> Scanner s
    forall s. Maybe (Char, s) -> (s -> Maybe (Char, s)) -> Scanner s
    Scanner (s -> Maybe (Char, s)
    next s
    s) s -> Maybe (Char, s)
    next

    instance XmlSource (Scanner s) where
      uncons :: Scanner s -> Maybe (Char, Scanner s)
    uncons (Scanner Maybe (Char, s)
    this s -> Maybe (Char, s)
    next) = do (c,s1) <- Maybe (Char, s)
    this
                                      return (c, Scanner (next s1) next)

    -- Lexer -----------------------------------------------------------------------

    type LChar              = (Line,Char)
    type LString            = [LChar]
    data Token              = TokStart Line QName [Attr] Bool  -- is empty?
                            | TokEnd Line QName
                            | TokCRef String
                            | TokText CData
                              deriving Int -> Token -> ShowS
    [Token] -> ShowS
    Token -> String
    (Int -> Token -> ShowS)
    -> (Token -> String) -> ([Token] -> ShowS) -> Show Token
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Token -> ShowS
    showsPrec :: Int -> Token -> ShowS
    $cshow :: Token -> String
    show :: Token -> String
    $cshowList :: [Token] -> ShowS
    showList :: [Token] -> ShowS
    Show

    tokens             :: XmlSource source => source -> [Token]
    tokens :: forall source. XmlSource source => source -> [Token]
    tokens = LString -> [Token]
    tokens' (LString -> [Token]) -> (source -> LString) -> source -> [Token]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> source -> LString
    forall s. XmlSource s => Integer -> s -> LString
    linenumber Integer
    1

    tokens' :: LString -> [Token]
    tokens' :: LString -> [Token]
    tokens' ((Integer
    _,Char
    '<') : c :: LChar
    c@(Integer
    _,Char
    '!') : LString
    cs) = LChar -> LString -> [Token]
    special LChar
    c LString
    cs

    tokens' ((Integer
    _,Char
    '<') : LString
    cs)   = LString -> [Token]
    tag (LString -> LString
    dropSpace LString
    cs) -- we are being nice here
    tokens' [] = []
    tokens' cs :: LString
    cs@((Integer
    l,Char
    _):LString
    _) = let (String
    as,LString
    bs) = (Char -> Bool) -> LString -> (String, LString)
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    breakn (Char
    '<' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) LString
    cs
                           in (Txt -> Token) -> [Txt] -> [Token]
    forall a b. (a -> b) -> [a] -> [b]
    map Txt -> Token
    cvt (String -> [Txt]
    decode_text String
    as) [Token] -> [Token] -> [Token]
    forall a. [a] -> [a] -> [a]
    ++ LString -> [Token]
    tokens' LString
    bs

      -- XXX: Note, some of the lines might be a bit inacuarate
      where cvt :: Txt -> Token
    cvt (TxtBit String
    x)  = CData -> Token
    TokText CData { cdLine :: Maybe Integer
    cdLine = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    l
                                            , cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataText
                                            , cdData :: String
    cdData = String
    x
                                            }
            cvt (CRefBit String
    x) = case String -> Maybe Char
    cref_to_char String
    x of
                                Just Char
    c -> CData -> Token
    TokText CData { cdLine :: Maybe Integer
    cdLine = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    l
                                                        , cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataText
                                                        , cdData :: String
    cdData = [Char
    c]
                                                        }
                                Maybe Char
    Nothing -> String -> Token
    TokCRef String
    x

    special :: LChar -> LString -> [Token]
    special :: LChar -> LString -> [Token]
    special LChar
    _ ((Integer
    _,Char
    '-') : (Integer
    _,Char
    '-') : LString
    cs) = LString -> [Token]
    skip LString
    cs
      where skip :: LString -> [Token]
    skip ((Integer
    _,Char
    '-') : (Integer
    _,Char
    '-') : (Integer
    _,Char
    '>') : LString
    ds) = LString -> [Token]
    tokens' LString
    ds
            skip (LChar
    _ : LString
    ds) = LString -> [Token]
    skip LString
    ds
            skip [] = [] -- unterminated comment

    special LChar
    c ((Integer
    _,Char
    '[') : (Integer
    _,Char
    'C') : (Integer
    _,Char
    'D') : (Integer
    _,Char
    'A') : (Integer
    _,Char
    'T') : (Integer
    _,Char
    'A') : (Integer
    _,Char
    '[')
             : LString
    cs) =
      let (String
    xs,LString
    ts) = LString -> (String, LString)
    forall {a}. [(a, Char)] -> (String, [(a, Char)])
    cdata LString
    cs
      in CData -> Token
    TokText CData { cdLine :: Maybe Integer
    cdLine = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (LChar -> Integer
    forall a b. (a, b) -> a
    fst LChar
    c), cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataVerbatim, cdData :: String
    cdData = String
    xs }
                                                                      Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : LString -> [Token]
    tokens' LString
    ts
      where cdata :: [(a, Char)] -> (String, [(a, Char)])
    cdata ((a
    _,Char
    ']') : (a
    _,Char
    ']') : (a
    _,Char
    '>') : [(a, Char)]
    ds) = ([],[(a, Char)]
    ds)
            cdata ((a
    _,Char
    d) : [(a, Char)]
    ds)  = let (String
    xs,[(a, Char)]
    ys) = [(a, Char)] -> (String, [(a, Char)])
    cdata [(a, Char)]
    ds in (Char
    dChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    xs,[(a, Char)]
    ys)
            cdata []        = ([],[])

    special LChar
    c LString
    cs =
      let (String
    xs,LString
    ts) = String -> Int -> LString -> (String, LString)
    forall {a}. String -> Int -> [(a, Char)] -> (String, [(a, Char)])
    munch String
    "" Int
    0 LString
    cs
      in CData -> Token
    TokText CData { cdLine :: Maybe Integer
    cdLine = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (LChar -> Integer
    forall a b. (a, b) -> a
    fst LChar
    c)
                       , cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataRaw
                       , cdData :: String
    cdData = Char
    '<'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Char
    '!'Char -> ShowS
    forall a. a -> [a] -> [a]
    :(ShowS
    forall a. [a] -> [a]
    reverse String
    xs)
                       } Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : LString -> [Token]
    tokens' LString
    ts
      where munch :: String -> Int -> [(a, Char)] -> (String, [(a, Char)])
    munch String
    acc Int
    nesting ((a
    _,Char
    '>') : [(a, Char)]
    ds)
             | Int
    nesting Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    0::Int) = (Char
    '>'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc,[(a, Char)]
    ds)
    	 | Bool
    otherwise           = String -> Int -> [(a, Char)] -> (String, [(a, Char)])
    munch (Char
    '>'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) (Int
    nestingInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [(a, Char)]
    ds
            munch String
    acc Int
    nesting ((a
    _,Char
    '<') : [(a, Char)]
    ds)
    	 = String -> Int -> [(a, Char)] -> (String, [(a, Char)])
    munch (Char
    '<'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) (Int
    nestingInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [(a, Char)]
    ds
            munch String
    acc Int
    n ((a
    _,Char
    x) : [(a, Char)]
    ds) = String -> Int -> [(a, Char)] -> (String, [(a, Char)])
    munch (Char
    xChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Int
    n [(a, Char)]
    ds
            munch String
    acc Int
    _ [] = (String
    acc,[]) -- unterminated DTD markup

    --special c cs = tag (c : cs) -- invalid specials are processed as tags

    qualName           :: LString -> (QName,LString)
    qualName :: LString -> (QName, LString)
    qualName LString
    xs         = let (String
    as,LString
    bs) = (Char -> Bool) -> LString -> (String, LString)
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    breakn Char -> Bool
    endName LString
    xs
                              (Maybe String
    q,String
    n)   = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char
    ':'Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) String
    as of
                                          (String
    q1,Char
    _:String
    n1) -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    q1, String
    n1)
                                          (String, String)
    _         -> (Maybe String
    forall a. Maybe a
    Nothing, String
    as)
                          in (QName { qURI :: Maybe String
    qURI = Maybe String
    forall a. Maybe a
    Nothing, qPrefix :: Maybe String
    qPrefix = Maybe String
    q, qName :: String
    qName = String
    n }, LString
    bs)
      where endName :: Char -> Bool
    endName Char
    x = Char -> Bool
    isSpace Char
    x Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '>' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/'

    tag              :: LString -> [Token]
    tag :: LString -> [Token]
    tag ((Integer
    p,Char
    '/') : LString
    cs)    = let (QName
    n,LString
    ds) = LString -> (QName, LString)
    qualName (LString -> LString
    dropSpace LString
    cs)
                            in Integer -> QName -> Token
    TokEnd Integer
    p QName
    n Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : case (LString -> LString
    dropSpace LString
    ds) of
                                              (Integer
    _,Char
    '>') : LString
    es -> LString -> [Token]
    tokens' LString
    es
                                              -- tag was not properly closed...
                                              LString
    _        -> LString -> [Token]
    tokens' LString
    ds
    tag []            = []
    tag LString
    cs            = let (QName
    n,LString
    ds)  = LString -> (QName, LString)
    qualName LString
    cs
                            ([Attr]
    as,Bool
    b,[Token]
    ts) = LString -> ([Attr], Bool, [Token])
    attribs (LString -> LString
    dropSpace LString
    ds)
                        in Integer -> QName -> [Attr] -> Bool -> Token
    TokStart (LChar -> Integer
    forall a b. (a, b) -> a
    fst (LString -> LChar
    forall a. HasCallStack => [a] -> a
    head LString
    cs)) QName
    n [Attr]
    as Bool
    b Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    ts

    attribs          :: LString -> ([Attr], Bool, [Token])
    attribs :: LString -> ([Attr], Bool, [Token])
    attribs LString
    cs        = case LString
    cs of
                          (Integer
    _,Char
    '>') : LString
    ds -> ([], Bool
    False, LString -> [Token]
    tokens' LString
    ds)

                          (Integer
    _,Char
    '/') : LString
    ds -> ([], Bool
    True, case LString
    ds of
                                                  (Integer
    _,Char
    '>') : LString
    es -> LString -> [Token]
    tokens' LString
    es
                                                  -- insert missing >  ...
                                                  LString
    _ -> LString -> [Token]
    tokens' LString
    ds)

                          (Integer
    _,Char
    '?') : (Integer
    _,Char
    '>') : LString
    ds -> ([], Bool
    True, LString -> [Token]
    tokens' LString
    ds)

                          -- doc ended within a tag..
                          []       -> ([],Bool
    False,[])

                          LString
    _        -> let (Attr
    a,LString
    cs1) = LString -> (Attr, LString)
    attrib LString
    cs
                                          ([Attr]
    as,Bool
    b,[Token]
    ts) = LString -> ([Attr], Bool, [Token])
    attribs LString
    cs1
                                      in (Attr
    aAttr -> [Attr] -> [Attr]
    forall a. a -> [a] -> [a]
    :[Attr]
    as,Bool
    b,[Token]
    ts)

    attrib             :: LString -> (Attr,LString)
    attrib :: LString -> (Attr, LString)
    attrib LString
    cs           = let (QName
    ks,LString
    cs1)  = LString -> (QName, LString)
    qualName LString
    cs
                              (String
    vs,LString
    cs2)  = LString -> (String, LString)
    attr_val (LString -> LString
    dropSpace LString
    cs1)
                          in ((QName -> String -> Attr
    Attr QName
    ks (ShowS
    decode_attr String
    vs)),LString -> LString
    dropSpace LString
    cs2)

    attr_val           :: LString -> (String,LString)
    attr_val :: LString -> (String, LString)
    attr_val ((Integer
    _,Char
    '=') : LString
    cs) = LString -> (String, LString)
    string (LString -> LString
    dropSpace LString
    cs)
    attr_val LString
    cs         = (String
    "",LString
    cs)

    dropSpace :: LString -> LString
    dropSpace :: LString -> LString
    dropSpace = (LChar -> Bool) -> LString -> LString
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Bool
    isSpace (Char -> Bool) -> (LChar -> Char) -> LChar -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LChar -> Char
    forall a b. (a, b) -> b
    snd)

    -- | Match the value for an attribute.  For malformed XML we do
    -- our best to guess the programmer's intention.
    string             :: LString -> (String,LString)
    string :: LString -> (String, LString)
    string ((Integer
    _,Char
    '"') : LString
    cs)   = (Char -> Bool) -> LString -> (String, LString)
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    break' (Char
    '"' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) LString
    cs

    -- Allow attributes to be enclosed between ' '.
    string ((Integer
    _,Char
    '\'') : LString
    cs)  = (Char -> Bool) -> LString -> (String, LString)
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    break' (Char
    '\'' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) LString
    cs

    -- Allow attributes that are not enclosed by anything.
    string LString
    cs           = (Char -> Bool) -> LString -> (String, LString)
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    breakn Char -> Bool
    eos LString
    cs
      where eos :: Char -> Bool
    eos Char
    x = Char -> Bool
    isSpace Char
    x Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '>' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/'

    break' :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])
    break' :: forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    break' a -> Bool
    p [(b, a)]
    xs         = let ([a]
    as,[(b, a)]
    bs) = (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    breakn a -> Bool
    p [(b, a)]
    xs
                          in ([a]
    as, case [(b, a)]
    bs of
                                    [] -> []
                                    (b, a)
    _ : [(b, a)]
    cs -> [(b, a)]
    cs)

    breakn :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])
    breakn :: forall a b. (a -> Bool) -> [(b, a)] -> ([a], [(b, a)])
    breakn a -> Bool
    p [(b, a)]
    l = (((b, a) -> a) -> [(b, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (b, a) -> a
    forall a b. (a, b) -> b
    snd [(b, a)]
    as,[(b, a)]
    bs) where ([(b, a)]
    as,[(b, a)]
    bs) = ((b, a) -> Bool) -> [(b, a)] -> ([(b, a)], [(b, a)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (a -> Bool
    p (a -> Bool) -> ((b, a) -> a) -> (b, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b, a) -> a
    forall a b. (a, b) -> b
    snd) [(b, a)]
    l

    decode_attr :: String -> String
    decode_attr :: ShowS
    decode_attr String
    cs = (Txt -> String) -> [Txt] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Txt -> String
    cvt (String -> [Txt]
    decode_text String
    cs)
      where cvt :: Txt -> String
    cvt (TxtBit String
    x) = String
    x
            cvt (CRefBit String
    x) = case String -> Maybe Char
    cref_to_char String
    x of
                                Just Char
    c -> [Char
    c]
                                Maybe Char
    Nothing -> Char
    '&' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ";"

    data Txt = TxtBit String | CRefBit String deriving Int -> Txt -> ShowS
    [Txt] -> ShowS
    Txt -> String
    (Int -> Txt -> ShowS)
    -> (Txt -> String) -> ([Txt] -> ShowS) -> Show Txt
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Txt -> ShowS
    showsPrec :: Int -> Txt -> ShowS
    $cshow :: Txt -> String
    show :: Txt -> String
    $cshowList :: [Txt] -> ShowS
    showList :: [Txt] -> ShowS
    Show

    decode_text :: [Char] -> [Txt]
    decode_text :: String -> [Txt]
    decode_text xs :: String
    xs@(Char
    '&' : String
    cs) = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char
    ';' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) String
    cs of
                                  (String
    as,Char
    _:String
    bs) -> String -> Txt
    CRefBit String
    as Txt -> [Txt] -> [Txt]
    forall a. a -> [a] -> [a]
    : String -> [Txt]
    decode_text String
    bs
                                  (String, String)
    _ -> [String -> Txt
    TxtBit String
    xs]
    decode_text []  = []
    decode_text String
    cs  = let (String
    as,String
    bs) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char
    '&' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) String
    cs
                      in String -> Txt
    TxtBit String
    as Txt -> [Txt] -> [Txt]
    forall a. a -> [a] -> [a]
    : String -> [Txt]
    decode_text String
    bs

    cref_to_char :: [Char] -> Maybe Char
    cref_to_char :: String -> Maybe Char
    cref_to_char String
    cs = case String
    cs of
      Char
    '#' : String
    ds  -> String -> Maybe Char
    num_esc String
    ds
      String
    "lt"      -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '<'
      String
    "gt"      -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '>'
      String
    "amp"     -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '&'
      String
    "apos"    -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '\''
      String
    "quot"    -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '"'
      String
    _         -> Maybe Char
    forall a. Maybe a
    Nothing

    num_esc :: String -> Maybe Char
    num_esc :: String -> Maybe Char
    num_esc String
    cs = case String
    cs of
                   Char
    'x' : String
    ds -> [(Int, String)] -> Maybe Char
    check (ReadS Int
    forall a. (Eq a, Num a) => ReadS a
    readHex String
    ds)
                   String
    _        -> [(Int, String)] -> Maybe Char
    check (ReadS Int
    forall a. Read a => ReadS a
    reads String
    cs)

      where check :: [(Int, String)] -> Maybe Char
    check [(Int
    n,String
    "")]  = Int -> Maybe Char
    cvt_char Int
    n
            check [(Int, String)]
    _         = Maybe Char
    forall a. Maybe a
    Nothing

    cvt_char :: Int -> Maybe Char
    cvt_char :: Int -> Maybe Char
    cvt_char Int
    x
      | Char -> Int
    forall a. Enum a => a -> Int
    fromEnum (Char
    forall a. Bounded a => a
    minBound :: Char) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    x Bool -> Bool -> Bool
    && Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Int
    forall a. Enum a => a -> Int
    fromEnum (Char
    forall a. Bounded a => a
    maxBound::Char)
                    = Char -> Maybe Char
    forall a. a -> Maybe a
    Just (Int -> Char
    forall a. Enum a => Int -> a
    toEnum Int
    x)
      | Bool
    otherwise = Maybe Char
    forall a. Maybe a
    Nothing