-- | A non-validating XML parser.  For the input grammar, see
--   <http://www.w3.org/TR/REC-xml>.
module Text.XML.HaXml.ParseLazy
  (
  -- * Parse a whole document
    xmlParse  -- , xmlParse'
  -- * Parse just a DTD
  , dtdParse  -- , dtdParse'
  -- * Parse a partial document
  , xmlParseWith
  -- * Individual parsers for use with /xmlParseWith/ and module SAX
  , document, element, content
  , comment, chardata
  , reference, doctypedecl
  , processinginstruction
  , elemtag, qname, name, tok
  , elemOpenTag, elemCloseTag
  , emptySTs, XParser
  -- * These general utility functions don't belong here
  , fst3, snd3, thd3
  ) where

-- An XML parser, written using a slightly extended version of the
-- Hutton/Meijer parser combinators.  The input is tokenised internally
-- by the lexer xmlLex.  Whilst parsing, we gather a symbol
-- table of entity references.  PERefs must be defined before use, so we
-- expand their uses as we encounter them, forcing the remainder of the
-- input to be re-lexed and re-parsed.  GERefs are simply stored for
-- later retrieval.

import Prelude hiding (either,maybe,sequence,catch)
import qualified Prelude (either)
import Data.Maybe hiding (maybe)
import Data.List (intercalate)
import Data.Char (isSpace,isDigit,isHexDigit)
import Control.Monad hiding (sequence)
import Numeric (readDec,readHex)
--import Control.Exception (catch)

import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.Posn
import Text.XML.HaXml.Lex
import Text.ParserCombinators.Poly.StateLazy

import System.FilePath (combine, dropFileName)


#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \
    ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)
import System.IO.Unsafe (unsafePerformIO)
#elif defined(__GLASGOW_HASKELL__)
import IOExts (unsafePerformIO)
#elif defined(__NHC__)
import IOExtras (unsafePerformIO)
#elif defined(__HBC__)
import UnsafePerformIO
#endif

--  #define DEBUG

#if defined(DEBUG)
#  if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \
      ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)
import Debug.Trace(trace)
#  elif defined(__GLASGOW_HASKELL__)
import IOExts(trace)
#  elif defined(__NHC__) || defined(__HBC__)
import NonStdTrace
#  endif
v `debug` s = trace s v
#else
a
v debug :: forall a. a -> String -> a
`debug` String
_ = a
v
#endif
debug :: a -> String -> a


-- | To parse a whole document, @xmlParse file content@ takes a filename
--   (for generating error reports) and the string content of that file.
--   A parse error causes program failure, with message to stderr.
xmlParse :: String -> String -> Document Posn

{-
-- | To parse a whole document, @xmlParse' file content@ takes a filename
--   (for generating error reports) and the string content of that file.
--   Any parse error message is passed back to the caller through the
--   @Either@ type.
xmlParse' :: String -> String -> Either String (Document Posn)
-}

-- | To parse just a DTD, @dtdParse file content@ takes a filename
--   (for generating error reports) and the string content of that
--   file.  If no DTD was found, you get @Nothing@ rather than an error.
--   However, if a DTD is found but contains errors, the program crashes.
dtdParse  :: String -> String -> Maybe DocTypeDecl

{-
-- | To parse just a DTD, @dtdParse' file content@ takes a filename
--   (for generating error reports) and the string content of that
--   file.  If no DTD was found, you get @Right Nothing@.
--   If a DTD was found but contains errors, you get a @Left message@.
dtdParse' :: String -> String -> Either String (Maybe DocTypeDecl)

xmlParse' name inp = xmlParse name inp `catch` (Left . show)
dtdParse' name inp = dtdParse name inp `catch` (Left . show)
-}

xmlParse :: String -> String -> Document Posn
xmlParse  String
name  = forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser (forall a. XParser a -> XParser a
toEOF XParser (Document Posn)
document) SymTabs
emptySTs forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Posn, TokenT)]
xmlLex String
name
dtdParse :: String -> String -> Maybe DocTypeDecl
dtdParse  String
name  = forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser XParser (Maybe DocTypeDecl)
justDTD  SymTabs
emptySTs forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Posn, TokenT)]
xmlLex String
name

toEOF :: XParser a -> XParser a
toEOF :: forall a. XParser a -> XParser a
toEOF = forall a. a -> a
id      -- there are other possible implementations...

-- | To parse a partial document, e.g. from an XML-based stream protocol,
--   where you may later want to get more document elements from the same
--   stream.  Arguments are: a parser for the item you want, and the
--   already-lexed input to parse from.  Returns the item you wanted
--   (or an error message), plus the remainder of the input.
xmlParseWith :: XParser a -> [(Posn,TokenT)]
                -> (Either String a, [(Posn,TokenT)])
xmlParseWith :: forall a.
XParser a
-> [(Posn, TokenT)] -> (Either String a, [(Posn, TokenT)])
xmlParseWith XParser a
p = (\(a
v,SymTabs
_,[(Posn, TokenT)]
s)->(forall a b. b -> Either a b
Right a
v,[(Posn, TokenT)]
s)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser XParser a
p SymTabs
emptySTs


---- Symbol table stuff ----

type SymTabs = (SymTab PEDef, SymTab EntityDef)

-- | Some empty symbol tables for GE and PE references.
emptySTs :: SymTabs
emptySTs :: SymTabs
emptySTs = (forall a. SymTab a
emptyST, forall a. SymTab a
emptyST)

addPE :: String -> PEDef -> SymTabs -> SymTabs
addPE :: String -> PEDef -> SymTabs -> SymTabs
addPE String
n PEDef
v (SymTab PEDef
pe,SymTab EntityDef
ge) = (forall a. String -> a -> SymTab a -> SymTab a
addST String
n PEDef
v SymTab PEDef
pe, SymTab EntityDef
ge)

addGE :: String -> EntityDef -> SymTabs -> SymTabs
addGE :: String -> EntityDef -> SymTabs -> SymTabs
addGE String
n EntityDef
v (SymTab PEDef
pe,SymTab EntityDef
ge) = let newge :: SymTab EntityDef
newge = forall a. String -> a -> SymTab a -> SymTab a
addST String
n EntityDef
v SymTab EntityDef
ge in SymTab EntityDef
newge seq :: forall a b. a -> b -> b
`seq` (SymTab PEDef
pe, SymTab EntityDef
newge)

lookupPE :: String -> SymTabs -> Maybe PEDef
lookupPE :: String -> SymTabs -> Maybe PEDef
lookupPE String
s (SymTab PEDef
pe,SymTab EntityDef
_ge) = forall a. String -> SymTab a -> Maybe a
lookupST String
s SymTab PEDef
pe

flattenEV :: EntityValue -> String
flattenEV :: EntityValue -> String
flattenEV (EntityValue [EV]
evs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EV -> String
flatten [EV]
evs
  where
    flatten :: EV -> String
flatten (EVString String
s)          = String
s
    flatten (EVRef (RefEntity String
r)) = String
"&" forall a. [a] -> [a] -> [a]
++String
rforall a. [a] -> [a] -> [a]
++String
";"
    flatten (EVRef (RefChar CharRef
r))   = String
"&#"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show CharRef
rforall a. [a] -> [a] -> [a]
++String
";"
 -- flatten (EVPERef n)           = "%" ++n++";"


---- Misc ----
fst3 :: (a,b,c) -> a
snd3 :: (a,b,c) -> b
thd3 :: (a,b,c) -> c

fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a
snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
a,c
_) = b
a
thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
a) = c
a


---- Auxiliary Parsing Functions ----

-- | XParser is just a specialisation of the PolyStateLazy parser.
type XParser a = Parser SymTabs (Posn,TokenT) a

-- | Return the next token from the input only if it matches the given token.
tok :: TokenT -> XParser TokenT
tok :: TokenT -> XParser TokenT
tok TokenT
t = do (Posn
p,TokenT
t') <- forall s t. Parser s t t
next
           case TokenT
t' of TokError String
_    -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t'
                      TokenT
_ | TokenT
t'forall a. Eq a => a -> a -> Bool
==TokenT
t     -> forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t
                        | Bool
otherwise -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t'
nottok :: [TokenT] -> XParser TokenT
nottok :: [TokenT] -> XParser TokenT
nottok [TokenT]
ts = do (Posn
p,TokenT
t) <- forall s t. Parser s t t
next
               if TokenT
tforall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[TokenT]
ts then forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"no "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t
                            else forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t

-- | Return a qualified name (although the namespace qualification is not
--   processed here; this is merely to get the correct type).
qname :: XParser QName
qname :: XParser QName
qname = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QName
N XParser String
name

-- | Return just a name, e.g. element name, attribute name.
name :: XParser Name
name :: XParser String
name = do (Posn
p,TokenT
tok) <- forall s t. Parser s t t
next
          case TokenT
tok of
            TokName String
s  -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
            TokError String
_ -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (p :: * -> *) a. PolyParse p => String -> p a
failBad String
"a name" Posn
p TokenT
tok
            TokenT
_          -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"a name" Posn
p TokenT
tok

string, freetext :: XParser String
string :: XParser String
string   = do (Posn
p,TokenT
t) <- forall s t. Parser s t t
next
              case TokenT
t of TokName String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
                        TokenT
_         -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text" Posn
p TokenT
t
freetext :: XParser String
freetext = do (Posn
p,TokenT
t) <- forall s t. Parser s t t
next
              case TokenT
t of TokFreeText String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
                        TokenT
_             -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text" Posn
p TokenT
t

maybe :: XParser a -> XParser (Maybe a)
maybe :: forall a. XParser a -> XParser (Maybe a)
maybe XParser a
p =
    (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser a
p) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

either :: XParser a -> XParser b -> XParser (Either a b)
either :: forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser a
p XParser b
q =
    (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser a
p) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser b
q)

word :: String -> XParser ()
word :: String -> XParser ()
word String
s = do { (Posn, TokenT)
x <- forall s t. Parser s t t
next
            ; case (Posn, TokenT)
x of
                (Posn
_p,TokName String
n)     | String
sforall a. Eq a => a -> a -> Bool
==String
n -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                (Posn
_p,TokFreeText String
n) | String
sforall a. Eq a => a -> a -> Bool
==String
n -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                ( Posn
p,t :: TokenT
t@(TokError String
_)) -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (forall a. Show a => a -> String
show String
s) Posn
p TokenT
t
                ( Posn
p,TokenT
t) -> forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show String
s) Posn
p TokenT
t
            }

posn :: XParser Posn
posn :: XParser Posn
posn = do { x :: (Posn, TokenT)
x@(Posn
p,TokenT
_) <- forall s t. Parser s t t
next
          ; forall t s. [t] -> Parser s t ()
reparse [(Posn, TokenT)
x]
          ; forall (m :: * -> *) a. Monad m => a -> m a
return Posn
p
          }

nmtoken :: XParser NmToken
nmtoken :: XParser String
nmtoken = XParser String
string forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` XParser String
freetext

failP, failBadP :: String -> XParser a
failP :: forall a. String -> XParser a
failP String
msg = do { Posn
p <- XParser Posn
posn; forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
msgforall a. [a] -> [a] -> [a]
++String
"\n    at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p) }
failBadP :: forall a. String -> XParser a
failBadP String
msg = do { Posn
p <- XParser Posn
posn; forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String
msgforall a. [a] -> [a] -> [a]
++String
"\n    at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p) }

report :: (String->XParser a) -> String -> Posn -> TokenT -> XParser a
report :: forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser a
fail String
expect Posn
p TokenT
t = String -> XParser a
fail (String
"Expected "forall a. [a] -> [a] -> [a]
++String
expectforall a. [a] -> [a] -> [a]
++String
" but found "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TokenT
t
                               forall a. [a] -> [a] -> [a]
++String
"\n  in "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)

adjustErrP :: XParser a -> (String->String) -> XParser a
XParser a
p adjustErrP :: forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` String -> String
f = XParser a
p forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` do Posn
pn <- XParser Posn
posn
                                 (XParser a
p forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` String -> String
f) forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
pn)

peRef :: XParser a -> XParser a
peRef :: forall a. XParser a -> XParser a
peRef XParser a
p =
    XParser a
p forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    do Posn
pn <- XParser Posn
posn
       String
n <- XParser String
pereference
       Maybe PEDef
tr <- forall s a t. (s -> a) -> Parser s t a
stQuery (String -> SymTabs -> Maybe PEDef
lookupPE String
n) forall a. a -> String -> a
`debug` (String
"Looking up %"forall a. [a] -> [a] -> [a]
++String
n)
       case Maybe PEDef
tr of
           Just (PEDefEntityValue EntityValue
ev) ->
                      do forall t s. [t] -> Parser s t ()
reparse (Posn -> String -> [(Posn, TokenT)]
xmlReLex (String -> Maybe Posn -> Posn
posInNewCxt (String
"macro %"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";")
                                                        (forall a. a -> Maybe a
Just Posn
pn))
                                           (EntityValue -> String
flattenEV EntityValue
ev))
                               forall a. a -> String -> a
`debug` (String
"  defn:  "forall a. [a] -> [a] -> [a]
++EntityValue -> String
flattenEV EntityValue
ev)
                         forall a. XParser a -> XParser a
peRef XParser a
p
           Just (PEDefExternalID (PUBLIC PubidLiteral
_ (SystemLiteral String
f))) ->
                      do let f' :: String
f' = String -> String -> String
combine (String -> String
dropFileName forall a b. (a -> b) -> a -> b
$ Posn -> String
posnFilename Posn
pn) String
f
                             val :: String
val = forall a. IO a -> a
unsafePerformIO (String -> IO String
readFile String
f')
                         forall t s. [t] -> Parser s t ()
reparse (Posn -> String -> [(Posn, TokenT)]
xmlReLex (String -> Maybe Posn -> Posn
posInNewCxt String
f'
                                                        (forall a. a -> Maybe a
Just Posn
pn)) String
val)
                               forall a. a -> String -> a
`debug` (String
"  reading from file "forall a. [a] -> [a] -> [a]
++String
f')
                         forall a. XParser a -> XParser a
peRef XParser a
p
           Just (PEDefExternalID (SYSTEM (SystemLiteral String
f))) ->
                      do let f' :: String
f' = String -> String -> String
combine (String -> String
dropFileName forall a b. (a -> b) -> a -> b
$ Posn -> String
posnFilename Posn
pn) String
f
                             val :: String
val = forall a. IO a -> a
unsafePerformIO (String -> IO String
readFile String
f')
                         forall t s. [t] -> Parser s t ()
reparse (Posn -> String -> [(Posn, TokenT)]
xmlReLex (String -> Maybe Posn -> Posn
posInNewCxt String
f'
                                                        (forall a. a -> Maybe a
Just Posn
pn)) String
val)
                               forall a. a -> String -> a
`debug` (String
"  reading from file "forall a. [a] -> [a] -> [a]
++String
f')
                         forall a. XParser a -> XParser a
peRef XParser a
p
           Maybe PEDef
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"PEReference use before definition: "forall a. [a] -> [a] -> [a]
++String
"%"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";"
                           forall a. [a] -> [a] -> [a]
++String
"\n    at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
pn)

blank :: XParser a -> XParser a
blank :: forall a. XParser a -> XParser a
blank XParser a
p =
    XParser a
p forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    do String
n <- XParser String
pereference
       Maybe PEDef
tr <- forall s a t. (s -> a) -> Parser s t a
stQuery (String -> SymTabs -> Maybe PEDef
lookupPE String
n) forall a. a -> String -> a
`debug` (String
"Looking up %"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
" (is blank?)")
       case Maybe PEDef
tr of
           Just (PEDefEntityValue EntityValue
ev)
                    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace (EntityValue -> String
flattenEV EntityValue
ev)  ->
                            do forall a. XParser a -> XParser a
blank XParser a
p forall a. a -> String -> a
`debug` String
"Empty macro definition"
           Just PEDef
_  -> forall a. String -> XParser a
failP (String
"expected a blank PERef macro: "forall a. [a] -> [a] -> [a]
++String
"%"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";")
           Maybe PEDef
Nothing -> forall a. String -> XParser a
failP (String
"PEReference use before definition: "forall a. [a] -> [a] -> [a]
++String
"%"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";")



---- XML Parsing Functions ----

justDTD :: XParser (Maybe DocTypeDecl)
justDTD :: XParser (Maybe DocTypeDecl)
justDTD =
  do (ExtSubset Maybe TextDecl
_ [ExtSubsetDecl]
ds) <- Parser SymTabs (Posn, TokenT) ExtSubset
extsubset forall a. a -> String -> a
`debug` String
"Trying external subset"
     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtSubsetDecl]
ds then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
         else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD (String -> QName
N String
"extsubset") forall a. Maybe a
Nothing (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExtSubsetDecl -> [MarkupDecl]
extract [ExtSubsetDecl]
ds)))
  forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
  do (Prolog Maybe XMLDecl
_ [Misc]
_ Maybe DocTypeDecl
dtd [Misc]
_) <- XParser Prolog
prolog
     forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DocTypeDecl
dtd
 where extract :: ExtSubsetDecl -> [MarkupDecl]
extract (ExtMarkupDecl MarkupDecl
m) = [MarkupDecl
m]
       extract (ExtConditionalSect (IncludeSect [ExtSubsetDecl]
i)) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExtSubsetDecl -> [MarkupDecl]
extract [ExtSubsetDecl]
i
       extract (ExtConditionalSect (IgnoreSect IgnoreSect
_)) = []

-- | Return an entire XML document including prolog and trailing junk.
document :: XParser (Document Posn)
document :: XParser (Document Posn)
document = do
 -- p <- prolog `adjustErr` ("unrecognisable XML prolog\n"++)
 -- e <- element
 -- ms <- many misc
 -- (_,ge) <- stGet
 -- return (Document p ge e ms)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (XParser Prolog
prolog forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr`
                                    (String
"unrecognisable XML prolog\n"forall a. [a] -> [a] -> [a]
++))
                    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall s t. Parser s t s
stGet
                    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` XParser (Element Posn)
element
                    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Misc
misc

-- | Return an XML comment.
comment :: XParser Comment
comment :: XParser String
comment = do
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokCommentOpen) (TokenT -> XParser TokenT
tok TokenT
TokCommentClose) XParser String
freetext
--  tok TokCommentOpen
--  commit $ do
--    c <- freetext
--    tok TokCommentClose
--    return c

-- | Parse a processing instruction.
processinginstruction :: XParser ProcessingInstruction
processinginstruction :: XParser ProcessingInstruction
processinginstruction = do
    TokenT -> XParser TokenT
tok TokenT
TokPIOpen
    forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ do
      String
n <- XParser String
string  forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP String
"processing instruction has no target"
      String
f <- XParser String
freetext
      TokenT -> XParser TokenT
tok TokenT
TokPIClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP (String
"missing ?> in <?"forall a. [a] -> [a] -> [a]
++String
n)
      forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, String
f)

cdsect :: XParser CDSect
cdsect :: XParser String
cdsect = do
    TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
CDATAx)) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSectionClose) XParser String
chardata

prolog :: XParser Prolog
prolog :: XParser Prolog
prolog = do
    Maybe XMLDecl
x   <- forall a. XParser a -> XParser (Maybe a)
maybe XParser XMLDecl
xmldecl
    [Misc]
m1  <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Misc
misc
    Maybe DocTypeDecl
dtd <- forall a. XParser a -> XParser (Maybe a)
maybe XParser DocTypeDecl
doctypedecl
    [Misc]
m2  <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Misc
misc
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
Prolog Maybe XMLDecl
x [Misc]
m1 Maybe DocTypeDecl
dtd [Misc]
m2)

xmldecl :: XParser XMLDecl
xmldecl :: XParser XMLDecl
xmldecl = do
    TokenT -> XParser TokenT
tok TokenT
TokPIOpen
    String -> XParser ()
word String
"xml" forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"XML"
    Posn
p <- XParser Posn
posn
    String
s <- XParser String
freetext
    TokenT -> XParser TokenT
tok TokenT
TokPIClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing ?> in <?xml ...?>"
 -- raise ((runParser aux emptySTs . xmlReLex p) s)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. (a, b, c) -> a
fst3 ((forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser XParser XMLDecl
aux SymTabs
emptySTs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> String -> [(Posn, TokenT)]
xmlReLex Posn
p) String
s))
  where
    aux :: XParser XMLDecl
aux = do
        String
v <- XParser String
versioninfo  forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP String
"missing XML version info"
        Maybe EncodingDecl
e <- forall a. XParser a -> XParser (Maybe a)
maybe XParser EncodingDecl
encodingdecl
        Maybe Bool
s <- forall a. XParser a -> XParser (Maybe a)
maybe XParser Bool
sddecl
        forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
XMLDecl String
v Maybe EncodingDecl
e Maybe Bool
s)
 -- raise (Left err, _, _) = failP err
 -- raise (Right ok, _, _) = return ok

versioninfo :: XParser VersionInfo
versioninfo :: XParser String
versioninfo = do
    String -> XParser ()
word String
"version" forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"VERSION"
    TokenT -> XParser TokenT
tok TokenT
TokEqual
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) XParser String
freetext

misc :: XParser Misc
misc :: XParser Misc
misc =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"<!--comment-->",  String -> Misc
Comment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
comment)
           , (String
"<?PI?>",          ProcessingInstruction -> Misc
PI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser ProcessingInstruction
processinginstruction)
           ]

-- | Return a DOCTYPE decl, indicating a DTD.
doctypedecl :: XParser DocTypeDecl
doctypedecl :: XParser DocTypeDecl
doctypedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
DOCTYPEx)
    forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ do
      QName
n   <- XParser QName
qname
      Maybe ExternalID
eid <- forall a. XParser a -> XParser (Maybe a)
maybe XParser ExternalID
externalid
      Maybe [MarkupDecl]
es  <- forall a. XParser a -> XParser (Maybe a)
maybe (forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokSqOpen) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSqClose)
                            (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. XParser a -> XParser a
peRef XParser MarkupDecl
markupdecl)))
      forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose)  forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP String
"missing > in DOCTYPE decl"
      forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD QName
n Maybe ExternalID
eid (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [MarkupDecl]
es))

-- | Return a DTD markup decl, e.g. ELEMENT, ATTLIST, etc
markupdecl :: XParser MarkupDecl
markupdecl :: XParser MarkupDecl
markupdecl =
  forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"ELEMENT",  ElementDecl -> MarkupDecl
Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser ElementDecl
elementdecl)
         , (String
"ATTLIST",  AttListDecl -> MarkupDecl
AttList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser AttListDecl
attlistdecl)
         , (String
"ENTITY",   EntityDecl -> MarkupDecl
Entity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser EntityDecl
entitydecl)
         , (String
"NOTATION", NotationDecl -> MarkupDecl
Notation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser NotationDecl
notationdecl)
         , (String
"misc",     Misc -> MarkupDecl
MarkupMisc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser Misc
misc)
         ]
    forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP`
          (String
"when looking for a markup decl,\n"forall a. [a] -> [a] -> [a]
++)
 --       (\  (ELEMENT, ATTLIST, ENTITY, NOTATION, <!--comment-->, or <?PI?>")

extsubset :: XParser ExtSubset
extsubset :: Parser SymTabs (Posn, TokenT) ExtSubset
extsubset = do
    Maybe TextDecl
td <- forall a. XParser a -> XParser (Maybe a)
maybe XParser TextDecl
textdecl
    [ExtSubsetDecl]
ds <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. XParser a -> XParser a
peRef XParser ExtSubsetDecl
extsubsetdecl)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextDecl -> [ExtSubsetDecl] -> ExtSubset
ExtSubset Maybe TextDecl
td [ExtSubsetDecl]
ds)

extsubsetdecl :: XParser ExtSubsetDecl
extsubsetdecl :: XParser ExtSubsetDecl
extsubsetdecl =
    (MarkupDecl -> ExtSubsetDecl
ExtMarkupDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser MarkupDecl
markupdecl) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    (ConditionalSect -> ExtSubsetDecl
ExtConditionalSect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser ConditionalSect
conditionalsect)

sddecl :: XParser SDDecl
sddecl :: XParser Bool
sddecl = do
    String -> XParser ()
word String
"standalone" forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"STANDALONE"
    forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ do
      TokenT -> XParser TokenT
tok TokenT
TokEqual forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP String
"missing = in 'standalone' decl"
      forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote)
              ( (String -> XParser ()
word String
"yes" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
                (String -> XParser ()
word String
"no" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
                forall a. String -> XParser a
failP String
"'standalone' decl requires 'yes' or 'no' value" )

{-
element :: XParser (Element Posn)
element = do
    tok TokAnyOpen
    (ElemTag n as) <- elemtag
    oneOf' [ ("self-closing tag <"++n++"/>"
             ,  do tok TokEndClose
                   return (Elem n as []))
           , ("after open tag <"++n++">"
             ,  do tok TokAnyClose
                   cs <- many content
                   p  <- posn
                   m  <- bracket (tok TokEndOpen) (commit $ tok TokAnyClose) qname
                   checkmatch p n m
                   return (Elem n as cs))
           ] `adjustErr` (("in element tag "++n++",\n")++)
-}

-- | Return a complete element including all its inner content.
element :: XParser (Element Posn)
element :: XParser (Element Posn)
element = do
    TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
    (ElemTag QName
n [Attribute]
as) <- XParser ElemTag
elemtag
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
as) forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply`
        ( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
             forall (m :: * -> *) a. Monad m => a -> m a
return []
          forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
          do TokenT -> XParser TokenT
tok TokenT
TokAnyClose
             forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall s t a z. Parser s t a -> Parser s t z -> Parser s t [a]
manyFinally XParser (Content Posn)
content
                                  (do Posn
p <- XParser Posn
posn
                                      QName
m <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokEndOpen)
                                                   (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser QName
qname
                                      Posn -> QName -> QName -> XParser ()
checkmatch Posn
p QName
n QName
m)
          ) forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in element tag "forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)

checkmatch :: Posn -> QName -> QName -> XParser ()
checkmatch :: Posn -> QName -> QName -> XParser ()
checkmatch Posn
p QName
n QName
m =
  if QName
n forall a. Eq a => a -> a -> Bool
== QName
m then forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String
"tag <"forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++String
"> terminated by </"forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
m
                forall a. [a] -> [a] -> [a]
++String
">\n  at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)

-- | Parse only the parts between angle brackets in an element tag.
elemtag :: XParser ElemTag
elemtag :: XParser ElemTag
elemtag = do
    QName
n  <- XParser QName
qname forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"malformed element tag\n"forall a. [a] -> [a] -> [a]
++)
    [Attribute]
as <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Attribute
attribute
    forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> ElemTag
ElemTag QName
n [Attribute]
as)

-- | For use with stream parsers - returns the complete opening element tag.
elemOpenTag :: XParser ElemTag
elemOpenTag :: XParser ElemTag
elemOpenTag = do
    TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
    ElemTag
e <- XParser ElemTag
elemtag
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose
    forall (m :: * -> *) a. Monad m => a -> m a
return ElemTag
e

-- | For use with stream parsers - accepts a closing tag, provided it
--   matches the given element name.
elemCloseTag :: QName -> XParser ()
elemCloseTag :: QName -> XParser ()
elemCloseTag QName
n = do
    TokenT -> XParser TokenT
tok TokenT
TokEndOpen
    Posn
p <- XParser Posn
posn
    QName
m <- XParser QName
qname
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose
    Posn -> QName -> QName -> XParser ()
checkmatch Posn
p QName
n QName
m

attribute :: XParser Attribute
attribute :: XParser Attribute
attribute = do
    QName
n <- XParser QName
qname forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"malformed attribute name\n"forall a. [a] -> [a] -> [a]
++)
    TokenT -> XParser TokenT
tok TokenT
TokEqual forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing = in attribute"
    AttValue
v <- Parser SymTabs (Posn, TokenT) AttValue
attvalue forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing attvalue"
    forall (m :: * -> *) a. Monad m => a -> m a
return (QName
n,AttValue
v)

-- | Return a content particle, e.g. text, element, reference, etc
content :: XParser (Content Posn)
content :: XParser (Content Posn)
content =
  do { Posn
p  <- XParser Posn
posn
     ; Posn -> Content Posn
c' <- XParser (Posn -> Content Posn)
content'
     ; forall (m :: * -> *) a. Monad m => a -> m a
return (Posn -> Content Posn
c' Posn
p)
     }
  where
     content' :: XParser (Posn -> Content Posn)
content' = forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"element",   forall i. Element i -> i -> Content i
CElem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser (Element Posn)
element)
                       , (String
"chardata",  forall i. Bool -> String -> i -> Content i
CString Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
chardata)
                       , (String
"reference", forall i. Reference -> i -> Content i
CRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser Reference
reference)
                       , (String
"CDATA",     forall i. Bool -> String -> i -> Content i
CString Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
cdsect)
                       , (String
"misc",      forall i. Misc -> i -> Content i
CMisc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser Misc
misc)
                       ]
                  forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (String
"when looking for a content item,\n"forall a. [a] -> [a] -> [a]
++)
-- (\    (element, text, reference, CDATA section, <!--comment-->, or <?PI?>")

elementdecl :: XParser ElementDecl
elementdecl :: XParser ElementDecl
elementdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ELEMENTx)
    QName
n <- forall a. XParser a -> XParser a
peRef XParser QName
qname forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"expecting identifier in ELEMENT decl\n"forall a. [a] -> [a] -> [a]
++)
    ContentSpec
c <- forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) ContentSpec
contentspec
             forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in content spec of ELEMENT decl: "
                             forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++String
"\n")forall a. [a] -> [a] -> [a]
++)
    forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP
       (String
"expected > terminating ELEMENT decl"
       forall a. [a] -> [a] -> [a]
++String
"\n    element name was "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (QName -> String
printableName QName
n)
       forall a. [a] -> [a] -> [a]
++String
"\n    contentspec was "forall a. [a] -> [a] -> [a]
++(\ (ContentSpec CP
p)-> CP -> String
debugShowCP CP
p) ContentSpec
c)
    forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> ContentSpec -> ElementDecl
ElementDecl QName
n ContentSpec
c)

contentspec :: XParser ContentSpec
contentspec :: Parser SymTabs (Posn, TokenT) ContentSpec
contentspec =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"EMPTY",  forall a. XParser a -> XParser a
peRef (String -> XParser ()
word String
"EMPTY") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
EMPTY)
           , (String
"ANY",    forall a. XParser a -> XParser a
peRef (String -> XParser ()
word String
"ANY") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
ANY)
           , (String
"mixed",  Mixed -> ContentSpec
Mixed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XParser a -> XParser a
peRef XParser Mixed
mixed)
           , (String
"simple", CP -> ContentSpec
ContentSpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. XParser a -> XParser a
peRef XParser CP
cp)
           ]
 --   `adjustErr` ("when looking for content spec,\n"++)
 --   `adjustErr` (++"\nLooking for content spec (EMPTY, ANY, mixed, etc)")

choice :: XParser [CP]
choice :: XParser [CP]
choice = do
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen forall a. a -> String -> a
`debug` String
"Trying choice")
            (forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose forall a. a -> String -> a
`debug` String
"Succeeded with choice"))
            (forall a. XParser a -> XParser a
peRef XParser CP
cp forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy1` forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokPipe))

sequence :: XParser [CP]
sequence :: XParser [CP]
sequence = do
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen forall a. a -> String -> a
`debug` String
"Trying sequence")
            (forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose forall a. a -> String -> a
`debug` String
"Succeeded with sequence"))
            (forall a. XParser a -> XParser a
peRef XParser CP
cp forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy1` forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokComma))

cp :: XParser CP
cp :: XParser CP
cp = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ do QName
n <- XParser QName
qname
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = QName -> Modifier -> CP
TagName QName
n Modifier
m
                forall (m :: * -> *) a. Monad m => a -> m a
return CP
c forall a. a -> String -> a
`debug` (String
"ContentSpec: name "forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           , do [CP]
ss <- XParser [CP]
sequence
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = [CP] -> Modifier -> CP
Seq [CP]
ss Modifier
m
                forall (m :: * -> *) a. Monad m => a -> m a
return CP
c forall a. a -> String -> a
`debug` (String
"ContentSpec: sequence "forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           , do [CP]
cs <- XParser [CP]
choice
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = [CP] -> Modifier -> CP
Choice [CP]
cs Modifier
m
                forall (m :: * -> *) a. Monad m => a -> m a
return CP
c forall a. a -> String -> a
`debug` (String
"ContentSpec: choice "forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           ] forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (forall a. [a] -> [a] -> [a]
++String
"\nwhen looking for a content particle")

modifier :: XParser Modifier
modifier :: XParser Modifier
modifier = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ TokenT -> XParser TokenT
tok TokenT
TokStar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Star
                 , TokenT -> XParser TokenT
tok TokenT
TokQuery forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Query
                 , TokenT -> XParser TokenT
tok TokenT
TokPlus forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Plus
                 , forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
None
                 ]

-- just for debugging
debugShowCP :: CP -> String
debugShowCP :: CP -> String
debugShowCP CP
cp = case CP
cp of
    TagName QName
n Modifier
m  -> QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
    Choice [CP]
cps Modifier
m -> Char
'('forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (forall a b. (a -> b) -> [a] -> [b]
map CP -> String
debugShowCP [CP]
cps)forall a. [a] -> [a] -> [a]
++String
")"forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
    Seq [CP]
cps Modifier
m    -> Char
'('forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map CP -> String
debugShowCP [CP]
cps)forall a. [a] -> [a] -> [a]
++String
")"forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
debugShowModifier :: Modifier -> String
debugShowModifier :: Modifier -> String
debugShowModifier Modifier
modifier = case Modifier
modifier of
    Modifier
None  -> String
""
    Modifier
Query -> String
"?"
    Modifier
Star  -> String
"*"
    Modifier
Plus  -> String
"+"
----

mixed :: XParser Mixed
mixed :: XParser Mixed
mixed = do
    TokenT -> XParser TokenT
tok TokenT
TokBraOpen
    forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokHash
              String -> XParser ()
word String
"PCDATA")
    forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$
      forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ do [QName]
cs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokPipe
                                       forall a. XParser a -> XParser a
peRef XParser QName
qname))
                 forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar)
                 forall (m :: * -> *) a. Monad m => a -> m a
return ([QName] -> Mixed
PCDATAplus [QName]
cs)
            , forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA
            , forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA
            ]
        forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (forall a. [a] -> [a] -> [a]
++String
"\nLooking for mixed content spec (#PCDATA | ...)*\n")

attlistdecl :: XParser AttListDecl
attlistdecl :: XParser AttListDecl
attlistdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ATTLISTx)
    QName
n <- forall a. XParser a -> XParser a
peRef XParser QName
qname forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"expecting identifier in ATTLIST\n"forall a. [a] -> [a] -> [a]
++)
    [AttDef]
ds <- forall a. XParser a -> XParser a
peRef (forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall a. XParser a -> XParser a
peRef XParser AttDef
attdef))
    forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing > terminating ATTLIST"
    forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [AttDef] -> AttListDecl
AttListDecl QName
n [AttDef]
ds)

attdef :: XParser AttDef
attdef :: XParser AttDef
attdef =
  do QName
n <- forall a. XParser a -> XParser a
peRef XParser QName
qname forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"expecting attribute name\n"forall a. [a] -> [a] -> [a]
++)
     AttType
t <- forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) AttType
atttype forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ((String
"within attlist defn: "
                                      forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)
     DefaultDecl
d <- forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) DefaultDecl
defaultdecl forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ((String
"in attlist defn: "
                                          forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)
     forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> AttType -> DefaultDecl -> AttDef
AttDef QName
n AttType
t DefaultDecl
d)

atttype :: XParser AttType
atttype :: Parser SymTabs (Posn, TokenT) AttType
atttype =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"CDATA",      String -> XParser ()
word String
"CDATA" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AttType
StringType)
           , (String
"tokenized",  TokenizedType -> AttType
TokenizedType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser TokenizedType
tokenizedtype)
           , (String
"enumerated", EnumeratedType -> AttType
EnumeratedType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser EnumeratedType
enumeratedtype)
           ]
      forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for ATTTYPE,\n"forall a. [a] -> [a] -> [a]
++)
 --   `adjustErr` (++"\nLooking for ATTTYPE (CDATA, tokenized, or enumerated")

tokenizedtype :: XParser TokenizedType
tokenizedtype :: XParser TokenizedType
tokenizedtype =
    forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ String -> XParser ()
word String
"ID" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ID
          , String -> XParser ()
word String
"IDREF" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREF
          , String -> XParser ()
word String
"IDREFS" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREFS
          , String -> XParser ()
word String
"ENTITY" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITY
          , String -> XParser ()
word String
"ENTITIES" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITIES
          , String -> XParser ()
word String
"NMTOKEN" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKEN
          , String -> XParser ()
word String
"NMTOKENS" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKENS
          ] forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    do { (Posn, TokenT)
t <- forall s t. Parser s t t
next
       ; forall a. String -> XParser a
failP (String
"Expected one of"
               forall a. [a] -> [a] -> [a]
++String
" (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)"
               forall a. [a] -> [a] -> [a]
++String
"\nbut got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (Posn, TokenT)
t)
       }

enumeratedtype :: XParser EnumeratedType
enumeratedtype :: XParser EnumeratedType
enumeratedtype =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"NOTATION",   NotationType -> EnumeratedType
NotationType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser NotationType
notationtype)
           , (String
"enumerated", NotationType -> EnumeratedType
Enumeration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser NotationType
enumeration)
           ]
      forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for an enumerated or NOTATION type,\n"forall a. [a] -> [a] -> [a]
++)

notationtype :: XParser NotationType
notationtype :: XParser NotationType
notationtype = do
    String -> XParser ()
word String
"NOTATION"
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall a. XParser a -> XParser a
blank forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokBraClose)
            (forall a. XParser a -> XParser a
peRef XParser String
name forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy1` forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe))

enumeration :: XParser Enumeration
enumeration :: XParser NotationType
enumeration =
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall a. XParser a -> XParser a
blank forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokBraClose)
            (forall a. XParser a -> XParser a
peRef XParser String
nmtoken forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy1` forall a. XParser a -> XParser a
blank (forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe)))

defaultdecl :: XParser DefaultDecl
defaultdecl :: Parser SymTabs (Posn, TokenT) DefaultDecl
defaultdecl =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"REQUIRED",  TokenT -> XParser TokenT
tok TokenT
TokHash forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"REQUIRED" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DefaultDecl
REQUIRED)
           , (String
"IMPLIED",   TokenT -> XParser TokenT
tok TokenT
TokHash forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"IMPLIED" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DefaultDecl
IMPLIED)
           , (String
"FIXED",     do Maybe FIXED
f <- forall a. XParser a -> XParser (Maybe a)
maybe (TokenT -> XParser TokenT
tok TokenT
TokHash forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"FIXED"
                                                      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FIXED
FIXED)
                              AttValue
a <- forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) AttValue
attvalue
                              forall (m :: * -> *) a. Monad m => a -> m a
return (AttValue -> Maybe FIXED -> DefaultDecl
DefaultTo AttValue
a Maybe FIXED
f) )
           ]
        forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for an attribute default decl,\n"forall a. [a] -> [a] -> [a]
++)

conditionalsect :: XParser ConditionalSect
conditionalsect :: XParser ConditionalSect
conditionalsect = forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf'
    [ ( String
"INCLUDE"
      , do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
           forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
INCLUDEx))
           Posn
p <- XParser Posn
posn
           TokenT -> XParser TokenT
tok TokenT
TokSqOpen forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing [ after INCLUDE"
           [ExtSubsetDecl]
i <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. XParser a -> XParser a
peRef XParser ExtSubsetDecl
extsubsetdecl)
           TokenT -> XParser TokenT
tok TokenT
TokSectionClose
                   forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP (String
"missing ]]> for INCLUDE section"
                                     forall a. [a] -> [a] -> [a]
++String
"\n    begun at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)
           forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtSubsetDecl] -> ConditionalSect
IncludeSect [ExtSubsetDecl]
i))
    , ( String
"IGNORE"
      , do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
           forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
IGNOREx))
           Posn
p <- XParser Posn
posn
           TokenT -> XParser TokenT
tok TokenT
TokSqOpen forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"missing [ after IGNORE"
           [Ignore]
i <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Ignore
newIgnore  -- many ignoresectcontents
           TokenT -> XParser TokenT
tok TokenT
TokSectionClose
                   forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP (String
"missing ]]> for IGNORE section"
                                     forall a. [a] -> [a] -> [a]
++String
"\n    begun at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)
           forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreSect -> ConditionalSect
IgnoreSect []))
    ] forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"in a conditional section,\n"forall a. [a] -> [a] -> [a]
++)

newIgnore :: XParser Ignore
newIgnore :: XParser Ignore
newIgnore =
    ( do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
         forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Ignore
newIgnore forall a. a -> String -> a
`debug` String
"IGNORING conditional section"
         TokenT -> XParser TokenT
tok TokenT
TokSectionClose
         forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore forall a. a -> String -> a
`debug` String
"end of IGNORED conditional section") forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    ( do TokenT
t <- [TokenT] -> XParser TokenT
nottok [TokenT
TokSectionOpen,TokenT
TokSectionClose]
         forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore  forall a. a -> String -> a
`debug` (String
"ignoring: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show TokenT
t))

--- obsolete?
--ignoresectcontents :: XParser IgnoreSectContents
--ignoresectcontents = do
--    i <- ignore
--    is <- many (do tok TokSectionOpen
--                   ic <- ignoresectcontents
--                   tok TokSectionClose
--                   ig <- ignore
--                   return (ic,ig))
--    return (IgnoreSectContents i is)
--
--ignore :: XParser Ignore
--ignore = do
--  is <- many1 (nottok [TokSectionOpen,TokSectionClose])
--  return Ignore  `debug` ("ignored all of: "++show is)
----

-- | Return either a general entity reference, or a character reference.
reference :: XParser Reference
reference :: XParser Reference
reference = do
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokAmp) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSemi) (XParser String
freetext forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Monad m => String -> m Reference
val)
  where
    val :: String -> m Reference
val (Char
'#':Char
'x':String
i) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit String
i
                    = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readHex forall a b. (a -> b) -> a -> b
$ String
i
    val (Char
'#':String
i)     | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
i
                    = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readDec forall a b. (a -> b) -> a -> b
$ String
i
    val String
name        = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Reference
RefEntity forall a b. (a -> b) -> a -> b
$ String
name

{- -- following is incorrect
reference =
    ( RefChar <$> charref) `onFail`
    ( RefEntity <$> entityref)

entityref :: XParser EntityRef
entityref = do
    bracket (tok TokAmp) (commit $ tok TokSemi) name

charref :: XParser CharRef
charref = do
    bracket (tok TokAmp) (commit $ tok TokSemi) (freetext >>= readCharVal)
  where
    readCharVal ('#':'x':i) = return . fst . head . readHex $ i
    readCharVal ('#':i)     = return . fst . head . readDec $ i
    readCharVal _           = mzero
-}

pereference :: XParser PEReference
pereference :: XParser String
pereference = do
    forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokPercent) (TokenT -> XParser TokenT
tok TokenT
TokSemi) XParser String
nmtoken

entitydecl :: XParser EntityDecl
entitydecl :: XParser EntityDecl
entitydecl =
    ( GEDecl -> EntityDecl
EntityGEDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser GEDecl
gedecl) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    ( PEDecl -> EntityDecl
EntityPEDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser PEDecl
pedecl)

gedecl :: XParser GEDecl
gedecl :: XParser GEDecl
gedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    String
n <- XParser String
name
    EntityDef
e <- Parser SymTabs (Posn, TokenT) EntityDef
entitydef forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in general entity defn "forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP (String
"expected > terminating G ENTITY decl "forall a. [a] -> [a] -> [a]
++String
n)
    forall s t. (s -> s) -> Parser s t ()
stUpdate (String -> EntityDef -> SymTabs -> SymTabs
addGE String
n EntityDef
e) forall a. a -> String -> a
`debug` (String
"added GE defn &"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";")
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EntityDef -> GEDecl
GEDecl String
n EntityDef
e)

pedecl :: XParser PEDecl
pedecl :: XParser PEDecl
pedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    TokenT -> XParser TokenT
tok TokenT
TokPercent
    String
n <- XParser String
name
    PEDef
e <- Parser SymTabs (Posn, TokenT) PEDef
pedef forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in parameter entity defn "forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP (String
"expected > terminating P ENTITY decl "forall a. [a] -> [a] -> [a]
++String
n)
    forall s t. (s -> s) -> Parser s t ()
stUpdate (String -> PEDef -> SymTabs -> SymTabs
addPE String
n PEDef
e) forall a. a -> String -> a
`debug` (String
"added PE defn %"forall a. [a] -> [a] -> [a]
++String
nforall a. [a] -> [a] -> [a]
++String
";\n"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show PEDef
e)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PEDef -> PEDecl
PEDecl String
n PEDef
e)

entitydef :: XParser EntityDef
entitydef :: Parser SymTabs (Posn, TokenT) EntityDef
entitydef =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"entityvalue", EntityValue -> EntityDef
DefEntityValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser EntityValue
entityvalue)
           , (String
"external",    do ExternalID
eid <- XParser ExternalID
externalid
                                Maybe NDataDecl
ndd <- forall a. XParser a -> XParser (Maybe a)
maybe XParser NDataDecl
ndatadecl
                                forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalID -> Maybe NDataDecl -> EntityDef
DefExternalID ExternalID
eid Maybe NDataDecl
ndd))
           ]

pedef :: XParser PEDef
pedef :: Parser SymTabs (Posn, TokenT) PEDef
pedef =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"entityvalue", EntityValue -> PEDef
PEDefEntityValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser EntityValue
entityvalue)
           , (String
"externalid",  ExternalID -> PEDef
PEDefExternalID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser ExternalID
externalid )
           ]

externalid :: XParser ExternalID
externalid :: XParser ExternalID
externalid =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"SYSTEM", do String -> XParser ()
word String
"SYSTEM"
                           SystemLiteral -> ExternalID
SYSTEM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser SystemLiteral
systemliteral)
           , (String
"PUBLIC", do String -> XParser ()
word String
"PUBLIC"
                           PubidLiteral
p <- XParser PubidLiteral
pubidliteral
                           PubidLiteral -> SystemLiteral -> ExternalID
PUBLIC PubidLiteral
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser SystemLiteral
systemliteral)
           ]
      forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for an external id,\n"forall a. [a] -> [a] -> [a]
++)

ndatadecl :: XParser NDataDecl
ndatadecl :: XParser NDataDecl
ndatadecl = do
    String -> XParser ()
word String
"NDATA"
    String -> NDataDecl
NDATA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
name

textdecl :: XParser TextDecl
textdecl :: XParser TextDecl
textdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokPIOpen
    String -> XParser ()
word String
"xml" forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"XML"
    Maybe String
v <- forall a. XParser a -> XParser (Maybe a)
maybe XParser String
versioninfo
    EncodingDecl
e <- XParser EncodingDecl
encodingdecl
    TokenT -> XParser TokenT
tok TokenT
TokPIClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failP String
"expected ?> terminating text decl"
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> EncodingDecl -> TextDecl
TextDecl Maybe String
v EncodingDecl
e)

--extparsedent :: XParser (ExtParsedEnt Posn)
--extparsedent = do
--    t <- maybe textdecl
--    c <- content
--    return (ExtParsedEnt t c)
--
--extpe :: XParser ExtPE
--extpe = do
--    t <- maybe textdecl
--    e <- many (peRef extsubsetdecl)
--    return (ExtPE t e)

encodingdecl :: XParser EncodingDecl
encodingdecl :: XParser EncodingDecl
encodingdecl = do
    String -> XParser ()
word String
"encoding" forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"ENCODING"
    TokenT -> XParser TokenT
tok TokenT
TokEqual forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"expected = in 'encoding' decl"
    String
f <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) XParser String
freetext
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EncodingDecl
EncodingDecl String
f)

notationdecl :: XParser NotationDecl
notationdecl :: XParser NotationDecl
notationdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
NOTATIONx)
    String
n <- XParser String
name
    Either ExternalID PublicID
e <- forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser ExternalID
externalid XParser PublicID
publicid
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP (String
"expected > terminating NOTATION decl "forall a. [a] -> [a] -> [a]
++String
n)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either ExternalID PublicID -> NotationDecl
NOTATION String
n Either ExternalID PublicID
e)

publicid :: XParser PublicID
publicid :: XParser PublicID
publicid = do
    String -> XParser ()
word String
"PUBLIC"
    PubidLiteral -> PublicID
PUBLICID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser PubidLiteral
pubidliteral

entityvalue :: XParser EntityValue
entityvalue :: XParser EntityValue
entityvalue = do
 -- evs <- bracket (tok TokQuote) (commit $ tok TokQuote) (many (peRef ev))
    TokenT -> XParser TokenT
tok TokenT
TokQuote
    Posn
pn <- XParser Posn
posn
    [EV]
evs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser EV
ev
    TokenT -> XParser TokenT
tok TokenT
TokQuote forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall a. String -> XParser a
failBadP String
"expected quote to terminate entityvalue"
    -- quoted text must be rescanned for possible PERefs
    SymTabs
st <- forall s t. Parser s t s
stGet
 -- Prelude.either failBad (return . EntityValue) . fst3 $
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3 forall a b. (a -> b) -> a -> b
$
                forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser EV
ev) SymTabs
st
                         ((String -> Maybe String) -> Posn -> String -> [(Posn, TokenT)]
reLexEntityValue (\String
s-> Maybe PEDef -> Maybe String
stringify (String -> SymTabs -> Maybe PEDef
lookupPE String
s SymTabs
st))
                                           Posn
pn
                                           (EntityValue -> String
flattenEV ([EV] -> EntityValue
EntityValue [EV]
evs)))
  where
    stringify :: Maybe PEDef -> Maybe String
stringify (Just (PEDefEntityValue EntityValue
ev)) = forall a. a -> Maybe a
Just (EntityValue -> String
flattenEV EntityValue
ev)
    stringify Maybe PEDef
_ = forall a. Maybe a
Nothing

ev :: XParser EV
ev :: XParser EV
ev =
    forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"string",    String -> EV
EVString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParser String
stringforall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`XParser String
freetext))
           , (String
"reference", Reference -> EV
EVRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser Reference
reference)
           ]
      forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for entity value,\n"forall a. [a] -> [a] -> [a]
++)

attvalue :: XParser AttValue
attvalue :: Parser SymTabs (Posn, TokenT) AttValue
attvalue = do
    [Either String Reference]
avs <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote)
                   (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser String
freetext XParser Reference
reference))
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [Either String Reference]
avs)

systemliteral :: XParser SystemLiteral
systemliteral :: XParser SystemLiteral
systemliteral = do
    String
s <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) XParser String
freetext
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SystemLiteral
SystemLiteral String
s)            -- note: refs &...; not permitted

pubidliteral :: XParser PubidLiteral
pubidliteral :: XParser PubidLiteral
pubidliteral = do
    String
s <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) XParser String
freetext
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PubidLiteral
PubidLiteral String
s)             -- note: freetext is too liberal here

-- | Return parsed freetext (i.e. until the next markup)
chardata :: XParser CharData
chardata :: XParser String
chardata = XParser String
freetext