{-# LANGUAGE CPP #-}
-- | A non-validating XML parser.  For the input grammar, see
--   <http://www.w3.org/TR/REC-xml>.
module Text.XML.HaXml.Parse
  (
  -- * 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, cdsect, 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)
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 Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.Posn
import Text.XML.HaXml.Lex
import Text.ParserCombinators.Poly.State

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
s = 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 :: String -> String -> Document Posn
xmlParse  String
name  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Either String (Document Posn)
xmlParse' String
name
dtdParse :: String -> String -> Maybe DocTypeDecl
dtdParse  String
name  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Either String (Maybe DocTypeDecl)
dtdParse' String
name

xmlParse' :: String -> String -> Either 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] -> (Either String 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 -> Either 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] -> (Either String 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 = (\(Either String a
v,SymTabs
_,[(Posn, TokenT)]
s)->(Either String 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] -> (Either String 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 PolyState 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
_i)) = []

-- | Return an entire XML document including prolog and trailing junk.
document :: XParser (Document Posn)
document :: XParser (Document Posn)
document = do
    Prolog
p <- 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]
++)
    Element Posn
e <- XParser (Element Posn)
element
    [Misc]
ms <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many XParser Misc
misc
    (SymTab PEDef
_,SymTab EntityDef
ge) <- forall s t. Parser s t s
stGet
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document Prolog
p SymTab EntityDef
ge Element Posn
e [Misc]
ms)

-- | 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 ...?>"
    forall {a} {b} {c}. (Either String a, b, c) -> XParser a
raise ((forall s t a. Parser s t a -> s -> [t] -> (Either String 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 :: (Either String a, b, c) -> XParser a
raise (Left String
err, b
_, c
_) = forall a. String -> XParser a
failP String
err
    raise (Right a
ok, b
_, c
_) = forall (m :: * -> *) a. Monad m => a -> m a
return a
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
    ( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
         forall (p :: * -> *) a. Commitment p => p a -> p a
commit (forall (m :: * -> *) a. Monad m => a -> m a
return (forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
as []))
        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
$ do
           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`
                 forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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"
           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) (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
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (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] -> (Either String 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