    -- | You don't normally need to use this Lex module directly - it is
    --   called automatically by the parser.  (This interface is only exposed
    --   for debugging purposes.)
    --
    -- This is a hand-written lexer for tokenising the text of an XML
    -- document so that it is ready for parsing.  It attaches position
    -- information in (line,column) format to every token.  The main
    -- entry point is 'xmlLex'.  A secondary entry point, 'xmlReLex', is
    -- provided for when the parser needs to stuff a string back onto
    -- the front of the text and re-tokenise it (typically when expanding
    -- macros).
    --
    -- As one would expect, the lexer is essentially a small finite
    -- state machine.

    module Text.XML.HaXml.Lex
      (
      -- * Entry points to the lexer
        xmlLex         -- :: String -> String -> [Token]
      , xmlReLex       -- :: Posn   -> String -> [Token]
      , reLexEntityValue -- :: (String->Maybe String) -> Posn -> String -> [Token]
      -- * Token types
      , Token
      , TokenT(..)
      , Special(..)
      , Section(..)
      ) where

    import Data.Char
    import Text.XML.HaXml.Posn

    data Where = InTag String | NotInTag
        deriving (Where -> Where -> Bool
    (Where -> Where -> Bool) -> (Where -> Where -> Bool) -> Eq Where
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Where -> Where -> Bool
    == :: Where -> Where -> Bool
    $c/= :: Where -> Where -> Bool
    /= :: Where -> Where -> Bool
    Eq)

    -- | All tokens are paired up with a source position.
    --   Lexical errors are passed back as a special @TokenT@ value.
    type Token = (Posn, TokenT)

    -- | The basic token type.
    data TokenT =
          TokCommentOpen            -- ^   \<!--
        | TokCommentClose           -- ^   -->
        | TokPIOpen                 -- ^   \<?
        | TokPIClose                -- ^   ?>
        | TokSectionOpen            -- ^   \<![
        | TokSectionClose           -- ^   ]]>
        | TokSection Section        -- ^   CDATA INCLUDE IGNORE etc
        | TokSpecialOpen            -- ^   \<!
        | TokSpecial Special        -- ^   DOCTYPE ELEMENT ATTLIST etc
        | TokEndOpen                -- ^   \<\/
        | TokEndClose               -- ^   \/>
        | TokAnyOpen                -- ^   \<
        | TokAnyClose               -- ^   >
        | TokSqOpen                 -- ^   \[
        | TokSqClose                -- ^   \]
        | TokEqual                  -- ^   =
        | TokQuery                  -- ^   ?
        | TokStar                   -- ^   \*
        | TokPlus                   -- ^   +
        | TokAmp                    -- ^   &
        | TokSemi                   -- ^   ;
        | TokHash                   -- ^   #
        | TokBraOpen                -- ^   (
        | TokBraClose               -- ^   )
        | TokPipe                   -- ^   |
        | TokPercent                -- ^   %
        | TokComma                  -- ^   ,
        | TokQuote                  -- ^   \'\' or \"\"
        | TokName      String       -- ^   begins with letter, no spaces
        | TokFreeText  String       -- ^   any character data
        | TokNull                   -- ^   fake token
        | TokError     String       -- ^   lexical error
        deriving (TokenT -> TokenT -> Bool
    (TokenT -> TokenT -> Bool)
    -> (TokenT -> TokenT -> Bool) -> Eq TokenT
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TokenT -> TokenT -> Bool
    == :: TokenT -> TokenT -> Bool
    $c/= :: TokenT -> TokenT -> Bool
    /= :: TokenT -> TokenT -> Bool
    Eq)

    data Special =
          DOCTYPEx
        | ELEMENTx
        | ATTLISTx
        | ENTITYx
        | NOTATIONx
        deriving (Special -> Special -> Bool
    (Special -> Special -> Bool)
    -> (Special -> Special -> Bool) -> Eq Special
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Special -> Special -> Bool
    == :: Special -> Special -> Bool
    $c/= :: Special -> Special -> Bool
    /= :: Special -> Special -> Bool
    Eq,Int -> Special -> ShowS
    [Special] -> ShowS
    Special -> String
    (Int -> Special -> ShowS)
    -> (Special -> String) -> ([Special] -> ShowS) -> Show Special
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Special -> ShowS
    showsPrec :: Int -> Special -> ShowS
    $cshow :: Special -> String
    show :: Special -> String
    $cshowList :: [Special] -> ShowS
    showList :: [Special] -> ShowS
    Show)
    data Section =
          CDATAx
        | INCLUDEx
        | IGNOREx
        deriving (Section -> Section -> Bool
    (Section -> Section -> Bool)
    -> (Section -> Section -> Bool) -> Eq Section
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Section -> Section -> Bool
    == :: Section -> Section -> Bool
    $c/= :: Section -> Section -> Bool
    /= :: Section -> Section -> Bool
    Eq,Int -> Section -> ShowS
    [Section] -> ShowS
    Section -> String
    (Int -> Section -> ShowS)
    -> (Section -> String) -> ([Section] -> ShowS) -> Show Section
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Section -> ShowS
    showsPrec :: Int -> Section -> ShowS
    $cshow :: Section -> String
    show :: Section -> String
    $cshowList :: [Section] -> ShowS
    showList :: [Section] -> ShowS
    Show)

    instance Show TokenT where
      showsPrec :: Int -> TokenT -> ShowS
    showsPrec Int
    _p TokenT
    TokCommentOpen           = String -> ShowS
    showString     String
    "<!--"
      showsPrec Int
    _p TokenT
    TokCommentClose          = String -> ShowS
    showString     String
    "-->"
      showsPrec Int
    _p TokenT
    TokPIOpen                = String -> ShowS
    showString     String
    "<?"
      showsPrec Int
    _p TokenT
    TokPIClose               = String -> ShowS
    showString     String
    "?>"
      showsPrec Int
    _p TokenT
    TokSectionOpen           = String -> ShowS
    showString     String
    "<!["
      showsPrec Int
    _p TokenT
    TokSectionClose          = String -> ShowS
    showString     String
    "]]>"
      showsPrec  Int
    p (TokSection Section
    s)           = Int -> Section -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Section
    s
      showsPrec Int
    _p TokenT
    TokSpecialOpen           = String -> ShowS
    showString     String
    "<!"
      showsPrec  Int
    p (TokSpecial Special
    s)           = Int -> Special -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Special
    s
      showsPrec Int
    _p TokenT
    TokEndOpen               = String -> ShowS
    showString     String
    "</"
      showsPrec Int
    _p TokenT
    TokEndClose              = String -> ShowS
    showString     String
    "/>"
      showsPrec Int
    _p TokenT
    TokAnyOpen               = String -> ShowS
    showString     String
    "<"
      showsPrec Int
    _p TokenT
    TokAnyClose              = String -> ShowS
    showString     String
    ">"
      showsPrec Int
    _p TokenT
    TokSqOpen                = String -> ShowS
    showString     String
    "["
      showsPrec Int
    _p TokenT
    TokSqClose               = String -> ShowS
    showString     String
    "]"
      showsPrec Int
    _p TokenT
    TokEqual                 = String -> ShowS
    showString     String
    "="
      showsPrec Int
    _p TokenT
    TokQuery                 = String -> ShowS
    showString     String
    "?"
      showsPrec Int
    _p TokenT
    TokStar                  = String -> ShowS
    showString     String
    "*"
      showsPrec Int
    _p TokenT
    TokPlus                  = String -> ShowS
    showString     String
    "+"
      showsPrec Int
    _p TokenT
    TokAmp                   = String -> ShowS
    showString     String
    "&"
      showsPrec Int
    _p TokenT
    TokSemi                  = String -> ShowS
    showString     String
    ";"
      showsPrec Int
    _p TokenT
    TokHash                  = String -> ShowS
    showString     String
    "#"
      showsPrec Int
    _p TokenT
    TokBraOpen               = String -> ShowS
    showString     String
    "("
      showsPrec Int
    _p TokenT
    TokBraClose              = String -> ShowS
    showString     String
    ")"
      showsPrec Int
    _p TokenT
    TokPipe                  = String -> ShowS
    showString     String
    "|"
      showsPrec Int
    _p TokenT
    TokPercent               = String -> ShowS
    showString     String
    "%"
      showsPrec Int
    _p TokenT
    TokComma                 = String -> ShowS
    showString     String
    ","
      showsPrec Int
    _p TokenT
    TokQuote                 = String -> ShowS
    showString     String
    "' or \""
      showsPrec Int
    _p (TokName      String
    s)         = String -> ShowS
    showString     String
    s
      showsPrec Int
    _p (TokFreeText  String
    s)         = String -> ShowS
    showString     String
    s
      showsPrec Int
    _p TokenT
    TokNull                  = String -> ShowS
    showString     String
    "(null)"
      showsPrec Int
    _p (TokError     String
    s)         = String -> ShowS
    showString     String
    s

    --trim, revtrim :: String -> String
    --trim    = f . f         where f = reverse . dropWhile isSpace
    --revtrim = f.reverse.f   where f = dropWhile isSpace
    --revtrim = reverse . dropWhile (=='\n')  -- most recently used defn.

    emit :: TokenT -> Posn -> Token
    emit :: TokenT -> Posn -> Token
    emit TokenT
    tok Posn
    p = Posn -> Int
    forcep Posn
    p Int -> Token -> Token
    forall a b. a -> b -> b
    `seq` (Posn
    p,TokenT
    tok)

    lexerror :: String -> Posn -> [Token]
    lexerror :: String -> Posn -> [Token]
    lexerror String
    s Posn
    p = [(Posn
    p, String -> TokenT
    TokError (String
    "Lexical error:\n  "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    s))]

    skip :: Int -> Posn -> String -> (Posn->String->[Token]) -> [Token]
    skip :: Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    n Posn
    p String
    s Posn -> String -> [Token]
    k = Posn -> String -> [Token]
    k (Int -> Posn -> Posn
    addcol Int
    n Posn
    p) (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    n String
    s)

    blank :: ([Where]->Posn->String->[Token]) -> [Where]-> Posn-> String-> [Token]
    blank :: ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    _  (InTag String
    t:[Where]
    _) Posn
    p [] = String -> Posn -> [Token]
    lexerror (String
    "unexpected EOF within "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    t) Posn
    p
    blank [Where] -> Posn -> String -> [Token]
    _          [Where]
    _   Posn
    _ [] = []
    blank [Where] -> Posn -> String -> [Token]
    k      [Where]
    w Posn
    p (Char
    ' ': String
    s) = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    k [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    s
    blank [Where] -> Posn -> String -> [Token]
    k      [Where]
    w Posn
    p (Char
    '\t':String
    s) = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    k [Where]
    w (Posn -> Posn
    tab Posn
    p) String
    s
    blank [Where] -> Posn -> String -> [Token]
    k      [Where]
    w Posn
    p (Char
    '\n':String
    s) = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    k [Where]
    w (Posn -> Posn
    newline Posn
    p) String
    s
    blank [Where] -> Posn -> String -> [Token]
    k      [Where]
    w Posn
    p (Char
    '\r':String
    s) = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    k [Where]
    w  Posn
    p String
    s
    blank [Where] -> Posn -> String -> [Token]
    k   [Where]
    w Posn
    p (Char
    '\xa0': String
    s) = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    k [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    s
    blank [Where] -> Posn -> String -> [Token]
    k      [Where]
    w Posn
    p    String
    s     = [Where] -> Posn -> String -> [Token]
    k [Where]
    w Posn
    p String
    s

    prefixes :: String -> String -> Bool
    []     prefixes :: String -> String -> Bool
    `prefixes`   String
    _    = Bool
    True
    (Char
    x:String
    xs) `prefixes` (Char
    y:String
    ys) = Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    y Bool -> Bool -> Bool
    && String
    xs String -> String -> Bool
    `prefixes` String
    ys
    (Char
    _:String
    _)  `prefixes`   []   = Bool
    False --error "unexpected EOF in prefix"

    textUntil, textOrRefUntil
        :: [Char] -> TokenT -> [Char] -> Posn -> Posn -> [Char]
           -> (Posn->String->[Token]) -> [Token]

    textUntil :: String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    close TokenT
    _tok String
    _acc Posn
    pos Posn
    p [] Posn -> String -> [Token]
    _k =
        String -> Posn -> [Token]
    lexerror (String
    "unexpected EOF while looking for closing token "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    close
                  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "\n  to match the opening token in "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    pos) Posn
    p
    textUntil String
    close  TokenT
    tok  String
    acc Posn
    pos Posn
    p (Char
    s:String
    ss) Posn -> String -> [Token]
    k
        | String
    close String -> String -> Bool
    `prefixes` (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss)  = TokenT -> Posn -> Token
    emit (String -> TokenT
    TokFreeText (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     TokenT -> Posn -> Token
    emit TokenT
    tok Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    closeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k
        | TokenT
    tokTokenT -> TokenT -> Bool
    forall a. Eq a => a -> a -> Bool
    ==TokenT
    TokSemi Bool -> Bool -> Bool
    && String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    acc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    8 -- special case for repairing broken &
                                   = TokenT -> Posn -> Token
    emit (String -> TokenT
    TokFreeText String
    "amp") Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     TokenT -> Posn -> Token
    emit TokenT
    tok Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     Posn -> String -> [Token]
    k (Int -> Posn -> Posn
    addcol Int
    1 Posn
    pos) (ShowS
    forall a. [a] -> [a]
    reverse String
    accString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss)
        | Char -> Bool
    isSpace Char
    s  = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    close TokenT
    tok (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Posn
    pos (Char -> Posn -> Posn
    white Char
    s Posn
    p) String
    ss Posn -> String -> [Token]
    k
        | Bool
    otherwise  = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    close TokenT
    tok (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Posn
    pos (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k

    textOrRefUntil :: String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    close TokenT
    _tok String
    _acc Posn
    pos Posn
    p [] Posn -> String -> [Token]
    _k =
        String -> Posn -> [Token]
    lexerror (String
    "unexpected EOF while looking for closing token "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    close
                  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "\n  to match the opening token in "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    pos) Posn
    p
    textOrRefUntil String
    close  TokenT
    tok  String
    acc Posn
    pos Posn
    p (Char
    s:String
    ss) Posn -> String -> [Token]
    k
        | String
    close String -> String -> Bool
    `prefixes` (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss)  = TokenT -> Posn -> Token
    emit (String -> TokenT
    TokFreeText (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     TokenT -> Posn -> Token
    emit TokenT
    tok Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    closeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k
        | Char
    sChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '&'     = (if Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    acc)
                           then (TokenT -> Posn -> Token
    emit (String -> TokenT
    TokFreeText (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :)
                           else [Token] -> [Token]
    forall a. a -> a
    id)
                       (TokenT -> Posn -> Token
    emit TokenT
    TokAmp Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                        String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    ";" TokenT
    TokSemi String
    "" Posn
    p (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
                            (\Posn
    p' String
    i-> String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    close TokenT
    tok String
    "" Posn
    p Posn
    p' String
    i Posn -> String -> [Token]
    k))
        | Char -> Bool
    isSpace Char
    s  = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    close TokenT
    tok (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Posn
    pos (Char -> Posn -> Posn
    white Char
    s Posn
    p) String
    ss Posn -> String -> [Token]
    k
        | Bool
    otherwise  = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    close TokenT
    tok (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Posn
    pos (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k

    ----

    -- | The first argument to 'xmlLex' is the filename (used for source positions,
    --   especially in error messages), and the second is the string content of
    --   the XML file.
    xmlLex :: String -> String -> [Token]
    xmlLex :: String -> String -> [Token]
    xmlLex String
    filename = [Where] -> Posn -> String -> [Token]
    xmlAny [] (String -> Maybe Posn -> Posn
    posInNewCxt String
    filename Maybe Posn
    forall a. Maybe a
    Nothing)

    -- | 'xmlReLex' is used when the parser expands a macro (PE reference).
    --    The expansion of the macro must be re-lexed as if for the first time.
    xmlReLex :: Posn -> String -> [Token]
    xmlReLex :: Posn -> String -> [Token]
    xmlReLex Posn
    p String
    s
          | String
    "INCLUDE"  String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit (Section -> TokenT
    TokSection Section
    INCLUDEx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    7
          | String
    "IGNORE"   String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit (Section -> TokenT
    TokSection Section
    IGNOREx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :  Int -> [Token]
    k Int
    6
          | Bool
    otherwise = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [] Posn
    p String
    s
      where
        k :: Int -> [Token]
    k Int
    n = Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    n Posn
    p String
    s (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [])

    -- | 'reLexEntityValue' is used solely within parsing an entityvalue.
    --   Normally, a PERef is logically separated from its surroundings by
    --   whitespace.  But in an entityvalue, a PERef can be juxtaposed to
    --   an identifier, so the expansion forms a new identifier.
    --   Thus the need to rescan the whole text for possible PERefs.
    reLexEntityValue :: (String->Maybe String) -> Posn -> String -> [Token]
    reLexEntityValue :: (String -> Maybe String) -> Posn -> String -> [Token]
    reLexEntityValue String -> Maybe String
    lookup Posn
    p String
    s =
        String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    "%" TokenT
    TokNull [] Posn
    p Posn
    p (ShowS
    expand String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "%") ([Where] -> Posn -> String -> [Token]
    xmlAny [])
      where
        expand :: ShowS
    expand []       = []
        expand (Char
    '%':String
    xs) = let (String
    sym,String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ';') String
    xs in
                          case String -> Maybe String
    lookup String
    sym of
                            Just String
    val -> ShowS
    expand String
    val String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    expand (ShowS
    forall a. HasCallStack => [a] -> [a]
    tail String
    rest)
                            Maybe String
    Nothing  -> String
    "%"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    symString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ";"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    expand (ShowS
    forall a. HasCallStack => [a] -> [a]
    tail String
    rest) -- hmmm
        expand (Char
    x:String
    xs)   = Char
    xChar -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    expand String
    xs

    --xmltop :: Posn -> String -> [Token]
    --xmltop p [] = []
    --xmltop p s
    --    | "<?"   `prefixes` s = emit TokPIOpen p:      next 2 (xmlPI [InTag "<?...?>"])
    --    | "<!--" `prefixes` s = emit TokCommentOpen p: next 4 (xmlComment [])
    --    | "<!"   `prefixes` s = emit TokSpecialOpen p: next 2 (xmlSpecial [InTag "<!...>"])
    --    | otherwise           = lexerror "expected <?xml?> or <!DOCTYPE>" p
    --  where next n k = skip n p s k

    xmlPI, xmlPIEnd, xmlComment, xmlAny, xmlTag, xmlSection, xmlSpecial
        :: [Where] -> Posn -> String -> [Token]

    xmlPI :: [Where] -> Posn -> String -> [Token]
    xmlPI      [Where]
    w Posn
    p String
    s = Posn -> String -> String -> (Posn -> String -> [Token]) -> [Token]
    xmlName Posn
    p String
    s String
    "name of processor in <? ?>" (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlPIEnd [Where]
    w)
    xmlPIEnd :: [Where] -> Posn -> String -> [Token]
    xmlPIEnd   [Where]
    w Posn
    p String
    s = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    "?>"  TokenT
    TokPIClose String
    "" Posn
    p Posn
    p String
    s (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny ([Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    w))
    xmlComment :: [Where] -> Posn -> String -> [Token]
    xmlComment [Where]
    w Posn
    p String
    s = String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    "-->" TokenT
    TokCommentClose String
    "" Posn
    p Posn
    p String
    s (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)

    -- Note: the order of the clauses in xmlAny is very important.
    -- Some matches must precede the NotInTag test, the rest must follow it.
    xmlAny :: [Where] -> Posn -> String -> [Token]
    xmlAny  (InTag String
    t:[Where]
    _)  Posn
    p [] = String -> Posn -> [Token]
    lexerror (String
    "unexpected EOF within "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    t) Posn
    p
    xmlAny          [Where]
    _    Posn
    _ [] = []
    xmlAny [Where]
    w Posn
    p s :: String
    s@(Char
    '<':String
    ss)
        | String
    "?"   String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokPIOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                             Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    2 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlPI (String -> Where
    InTag String
    "<?...?>"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where]
    w))
        | String
    "!--" String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokCommentOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    4 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlComment [Where]
    w)
        | String
    "!["  String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokSectionOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    3 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlSection [Where]
    w)
        | String
    "!"   String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokSpecialOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                         Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    2 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlSpecial (String -> Where
    InTag String
    "<!...>"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where]
    w))
        | String
    "/"   String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokEndOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                        Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    2 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlTag (String -> Where
    InTag String
    "</...>"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where] -> [Where]
    tale [Where]
    w))
        | Bool
    otherwise           = TokenT -> Posn -> Token
    emit TokenT
    TokAnyOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    1 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlTag (String -> Where
    InTag String
    "<...>"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :Where
    NotInTagWhere -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where]
    w))
        where tale :: [Where] -> [Where]
    tale [] = [Where
    NotInTag] -- cope with non-well-formed input
              tale [Where]
    xs = [Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    xs
    xmlAny (Where
    _:Where
    _:[Where]
    w) Posn
    p s :: String
    s@(Char
    '/':String
    ss)
        | String
    ">"   String -> String -> Bool
    `prefixes` String
    ss = TokenT -> Posn -> Token
    emit TokenT
    TokEndClose Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    2 Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
    xmlAny [Where]
    w Posn
    p (Char
    '&':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokAmp Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :      String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    ";" TokenT
    TokSemi String
    "" Posn
    p
                                                         (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss ([Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
    xmlAny w :: [Where]
    w@(Where
    NotInTag:[Where]
    _) Posn
    p String
    s = String -> [Where] -> Posn -> Posn -> String -> [Token]
    xmlContent String
    "" [Where]
    w Posn
    p Posn
    p String
    s
    -- everything below here is implicitly InTag.
    xmlAny [Where]
    w Posn
    p (Char
    '>':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokAnyClose Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Where] -> Posn -> String -> [Token]
    xmlAny ([Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    w) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '[':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokSqOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny (String -> Where
    InTag String
    "[...]"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where]
    w) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    ']':String
    ss)
        | String
    "]>" String -> String -> Bool
    `prefixes` String
    ss  =
                     TokenT -> Posn -> Token
    emit TokenT
    TokSectionClose Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :  Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    3 Posn
    p (Char
    ']'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss) ([Where] -> Posn -> String -> [Token]
    xmlAny ([Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    w))
        | Bool
    otherwise  =    TokenT -> Posn -> Token
    emit TokenT
    TokSqClose Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :  ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny ([Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    w) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '(':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokBraOpen Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :
                                     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny (String -> Where
    InTag String
    "(...)"Where -> [Where] -> [Where]
    forall a. a -> [a] -> [a]
    :[Where]
    w) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    ')':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokBraClose Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny ([Where] -> [Where]
    forall a. HasCallStack => [a] -> [a]
    tail [Where]
    w) (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '=':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokEqual Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :    ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '*':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokStar Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '+':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokPlus Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '?':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokQuery Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :    ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '|':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokPipe Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '%':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokPercent Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :  ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    ';':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokSemi Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    ',':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokComma Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :    ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '#':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokHash Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss
    xmlAny [Where]
    w Posn
    p (Char
    '"':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokQuote Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :    String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    "\"" TokenT
    TokQuote String
    "" Posn
    p1
                                                              Posn
    p1 String
    ss ([Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
                                                 where p1 :: Posn
    p1 = Int -> Posn -> Posn
    addcol Int
    1 Posn
    p
    xmlAny [Where]
    w Posn
    p (Char
    '\'':String
    ss) = TokenT -> Posn -> Token
    emit TokenT
    TokQuote Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :   String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textOrRefUntil String
    "'" TokenT
    TokQuote String
    "" Posn
    p1
                                                              Posn
    p1 String
    ss ([Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
                                                 where p1 :: Posn
    p1 = Int -> Posn -> Posn
    addcol Int
    1 Posn
    p
    xmlAny [Where]
    w Posn
    p String
    s
        | Char -> Bool
    isSpace (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    s)     = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w Posn
    p String
    s
        | Char -> Bool
    isAlphaNum (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    s) Bool -> Bool -> Bool
    || String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    sChar -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`String
    ":_"
                               = Posn -> String -> String -> (Posn -> String -> [Token]) -> [Token]
    xmlName Posn
    p String
    s String
    "some kind of name" (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
        | Bool
    otherwise            = String -> Posn -> [Token]
    lexerror (String
    "unrecognised token: "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    4 String
    s) Posn
    p

    xmlTag :: [Where] -> Posn -> String -> [Token]
    xmlTag [Where]
    w Posn
    p String
    s = Posn -> String -> String -> (Posn -> String -> [Token]) -> [Token]
    xmlName Posn
    p String
    s String
    "tagname for element in < >" (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)

    xmlSection :: [Where] -> Posn -> String -> [Token]
    xmlSection = ([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlSection0
      where
        xmlSection0 :: [Where] -> Posn -> String -> [Token]
    xmlSection0 [Where]
    w Posn
    p String
    s
          | String
    "CDATA["   String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit (Section -> TokenT
    TokSection Section
    CDATAx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :  [Where] -> Posn -> String -> Int -> [Token]
    accum [Where]
    w Posn
    p String
    s Int
    6
          | String
    "INCLUDE"  String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit (Section -> TokenT
    TokSection Section
    INCLUDEx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :    [Where] -> Posn -> String -> Int -> [Token]
    k [Where]
    w Posn
    p String
    s Int
    7
          | String
    "IGNORE"   String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit (Section -> TokenT
    TokSection Section
    IGNOREx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :     [Where] -> Posn -> String -> Int -> [Token]
    k [Where]
    w Posn
    p String
    s Int
    6
          | String
    "%"        String -> String -> Bool
    `prefixes` String
    s  = TokenT -> Posn -> Token
    emit TokenT
    TokPercent Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :               [Where] -> Posn -> String -> Int -> [Token]
    k [Where]
    w Posn
    p String
    s Int
    1
          | Bool
    otherwise = String -> Posn -> [Token]
    lexerror (String
    "expected CDATA, IGNORE, or INCLUDE, but got "
                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    7 String
    s) Posn
    p
        accum :: [Where] -> Posn -> String -> Int -> [Token]
    accum [Where]
    w Posn
    p String
    s Int
    n =
          let p0 :: Posn
    p0 = Int -> Posn -> Posn
    addcol Int
    n Posn
    p in
          String
    -> TokenT
    -> String
    -> Posn
    -> Posn
    -> String
    -> (Posn -> String -> [Token])
    -> [Token]
    textUntil String
    "]]>" TokenT
    TokSectionClose String
    "" Posn
    p0 Posn
    p0 (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    n String
    s) (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)
        k :: [Where] -> Posn -> String -> Int -> [Token]
    k [Where]
    w Posn
    p String
    s Int
    n =
          Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    n Posn
    p String
    s ([Where] -> Posn -> String -> [Token]
    xmlAny {-InTag "<![section[ ... ]]>": -}[Where]
    w)

    xmlSpecial :: [Where] -> Posn -> String -> [Token]
    xmlSpecial [Where]
    w Posn
    p String
    s
        | String
    "DOCTYPE"  String -> String -> Bool
    `prefixes` String
    s = TokenT -> Posn -> Token
    emit (Special -> TokenT
    TokSpecial Special
    DOCTYPEx)  Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    7
        | String
    "ELEMENT"  String -> String -> Bool
    `prefixes` String
    s = TokenT -> Posn -> Token
    emit (Special -> TokenT
    TokSpecial Special
    ELEMENTx)  Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    7
        | String
    "ATTLIST"  String -> String -> Bool
    `prefixes` String
    s = TokenT -> Posn -> Token
    emit (Special -> TokenT
    TokSpecial Special
    ATTLISTx)  Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    7
        | String
    "ENTITY"   String -> String -> Bool
    `prefixes` String
    s = TokenT -> Posn -> Token
    emit (Special -> TokenT
    TokSpecial Special
    ENTITYx)   Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    6
        | String
    "NOTATION" String -> String -> Bool
    `prefixes` String
    s = TokenT -> Posn -> Token
    emit (Special -> TokenT
    TokSpecial Special
    NOTATIONx) Posn
    pToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Int -> [Token]
    k Int
    8
        | Bool
    otherwise = String -> Posn -> [Token]
    lexerror
                        (String
    "expected DOCTYPE, ELEMENT, ENTITY, ATTLIST, or NOTATION,"
                        String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " but got "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    7 String
    s) Posn
    p
      where k :: Int -> [Token]
    k Int
    n = Int -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    skip Int
    n Posn
    p String
    s (([Where] -> Posn -> String -> [Token])
    -> [Where] -> Posn -> String -> [Token]
    blank [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w)

    xmlName :: Posn -> [Char] -> [Char] -> (Posn->[Char]->[Token]) -> [Token]
    xmlName :: Posn -> String -> String -> (Posn -> String -> [Token]) -> [Token]
    xmlName Posn
    p (Char
    s:String
    ss) String
    cxt Posn -> String -> [Token]
    k
        | Char -> Bool
    isAlphaNum Char
    s Bool -> Bool -> Bool
    || Char
    sChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ':' Bool -> Bool -> Bool
    || Char
    sChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '_'  = String
    -> Posn -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    gatherName [Char
    s] Posn
    p (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k
        | Bool
    otherwise   = String -> Posn -> [Token]
    lexerror (String
    "expected a "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    cxtString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ", but got char "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Char -> String
    forall a. Show a => a -> String
    show Char
    s) Posn
    p
      where
        gatherName :: String
    -> Posn -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    gatherName String
    acc Posn
    pos Posn
    p [] Posn -> String -> [Token]
    k =
            TokenT -> Posn -> Token
    emit (String -> TokenT
    TokName (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Posn -> String -> [Token]
    k Posn
    p []
        --  lexerror ("unexpected EOF in name at "++show pos) p
        gatherName String
    acc Posn
    pos Posn
    p (Char
    s:String
    ss) Posn -> String -> [Token]
    k
            | Char -> Bool
    isAlphaNum Char
    s Bool -> Bool -> Bool
    || Char
    s Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ".-_:"
                          = String
    -> Posn -> Posn -> String -> (Posn -> String -> [Token]) -> [Token]
    gatherName (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) Posn
    pos (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss Posn -> String -> [Token]
    k
            | Bool
    otherwise   = TokenT -> Posn -> Token
    emit (String -> TokenT
    TokName (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Posn -> String -> [Token]
    k Posn
    p (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss)
    xmlName Posn
    p [] String
    cxt Posn -> String -> [Token]
    _ = String -> Posn -> [Token]
    lexerror (String
    "expected a "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    cxtString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ", but got end of input") Posn
    p

    xmlContent :: [Char] -> [Where] -> Posn -> Posn -> [Char] -> [Token]
    xmlContent :: String -> [Where] -> Posn -> Posn -> String -> [Token]
    xmlContent String
    acc [Where]
    _w Posn
    _pos Posn
    p [] = if (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    acc then []
                                else String -> Posn -> [Token]
    lexerror String
    "unexpected EOF between tags" Posn
    p
    xmlContent String
    acc  [Where]
    w  Posn
    pos Posn
    p (Char
    s:String
    ss)
        | Char
    s Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "<&"  = {- if all isSpace acc then xmlAny w p (s:ss) else -}
                           TokenT -> Posn -> Token
    emit (String -> TokenT
    TokFreeText (ShowS
    forall a. [a] -> [a]
    reverse String
    acc)) Posn
    posToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Where] -> Posn -> String -> [Token]
    xmlAny [Where]
    w Posn
    p (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    ss)
        | Char -> Bool
    isSpace Char
    s      = String -> [Where] -> Posn -> Posn -> String -> [Token]
    xmlContent (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) [Where]
    w Posn
    pos (Char -> Posn -> Posn
    white Char
    s Posn
    p) String
    ss
        | Bool
    otherwise      = String -> [Where] -> Posn -> Posn -> String -> [Token]
    xmlContent (Char
    sChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    acc) [Where]
    w Posn
    pos (Int -> Posn -> Posn
    addcol Int
    1 Posn
    p) String
    ss

    --ident :: (String->TokenT) ->
    --          Posn -> String -> [String] ->
    --         (Posn->String->[String]->[Token]) -> [Token]
    --ident tok p s ss k =
    --    let (name,s0) = span (\c-> isAlphaNum c || c `elem` "`-_#.'/\\") s
    --    in emit (tok name) p: skip (length name) p s ss k