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

toEOF :: XParser a -> XParser a
toEOF :: XParser a -> XParser a
toEOF = XParser a -> XParser a
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 :: XParser a
-> [(Posn, TokenT)] -> (Either String a, [(Posn, TokenT)])
xmlParseWith XParser a
p = (\(a
v,SymTabs
_,[(Posn, TokenT)]
s)->(a -> Either String a
forall a b. b -> Either a b
Right a
v,[(Posn, TokenT)]
s)) ((a, SymTabs, [(Posn, TokenT)])
 -> (Either String a, [(Posn, TokenT)]))
-> ([(Posn, TokenT)] -> (a, SymTabs, [(Posn, TokenT)]))
-> [(Posn, TokenT)]
-> (Either String a, [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XParser a
-> SymTabs -> [(Posn, TokenT)] -> (a, SymTabs, [(Posn, TokenT)])
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 = (SymTab PEDef
forall a. SymTab a
emptyST, SymTab EntityDef
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) = (String -> PEDef -> SymTab PEDef -> SymTab PEDef
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 = String -> EntityDef -> SymTab EntityDef -> SymTab EntityDef
forall a. String -> a -> SymTab a -> SymTab a
addST String
n EntityDef
v SymTab EntityDef
ge in SymTab EntityDef
newge SymTab EntityDef -> SymTabs -> SymTabs
`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) = String -> SymTab PEDef -> Maybe PEDef
forall a. String -> SymTab a -> Maybe a
lookupST String
s SymTab PEDef
pe

flattenEV :: EntityValue -> String
flattenEV :: EntityValue -> String
flattenEV (EntityValue [EV]
evs) = (EV -> String) -> [EV] -> String
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
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
";"
    flatten (EVRef (RefChar CharRef
r))   = String
"&#"String -> String -> String
forall a. [a] -> [a] -> [a]
++CharRef -> String
forall a. Show a => a -> String
show CharRef
rString -> String -> String
forall 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 :: (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a
snd3 :: (a, b, c) -> b
snd3 (a
_,b
a,c
_) = b
a
thd3 :: (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') <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
           case TokenT
t' of TokError String
_    -> (String -> XParser TokenT)
-> String -> Posn -> TokenT -> XParser TokenT
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser TokenT
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (TokenT -> String
forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t'
                      TokenT
_ | TokenT
t'TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
==TokenT
t     -> TokenT -> XParser TokenT
forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t
                        | Bool
otherwise -> (String -> XParser TokenT)
-> String -> Posn -> TokenT -> XParser TokenT
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser TokenT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (TokenT -> String
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) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
               if TokenT
tTokenT -> [TokenT] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[TokenT]
ts then (String -> XParser TokenT)
-> String -> Posn -> TokenT -> XParser TokenT
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser TokenT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"no "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t
                            else TokenT -> XParser TokenT
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 = (String -> QName)
-> Parser SymTabs (Posn, TokenT) String -> XParser QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QName
N Parser SymTabs (Posn, TokenT) String
name

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

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

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

either :: XParser a -> XParser b -> XParser (Either a b)
either :: XParser a -> XParser b -> XParser (Either a b)
either XParser a
p XParser b
q =
    (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> XParser a -> XParser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser a
p) XParser (Either a b)
-> XParser (Either a b) -> XParser (Either a b)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> XParser b -> XParser (Either a b)
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 <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
            ; case (Posn, TokenT)
x of
                (Posn
_p,TokName String
n)     | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                (Posn
_p,TokFreeText String
n) | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                ( Posn
p,t :: TokenT
t@(TokError String
_)) -> (String -> XParser ()) -> String -> Posn -> TokenT -> XParser ()
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser ()
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> String
forall a. Show a => a -> String
show String
s) Posn
p TokenT
t
                ( Posn
p,TokenT
t) -> (String -> XParser ()) -> String -> Posn -> TokenT -> XParser ()
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String
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
_) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
          ; [(Posn, TokenT)] -> XParser ()
forall t s. [t] -> Parser s t ()
reparse [(Posn, TokenT)
x]
          ; Posn -> XParser Posn
forall (m :: * -> *) a. Monad m => a -> m a
return Posn
p
          }

nmtoken :: XParser NmToken
nmtoken :: Parser SymTabs (Posn, TokenT) String
nmtoken = Parser SymTabs (Posn, TokenT) String
string Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` Parser SymTabs (Posn, TokenT) String
freetext

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

report :: (String->XParser a) -> String -> Posn -> TokenT -> XParser a
report :: (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 "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
expectString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" but found "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t
                               String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n  in "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)

adjustErrP :: XParser a -> (String->String) -> XParser a
XParser a
p adjustErrP :: XParser a -> (String -> String) -> XParser a
`adjustErrP` String -> String
f = XParser a
p XParser a -> XParser a -> XParser a
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 XParser a -> (String -> String) -> XParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` String -> String
f) XParser a -> (String -> String) -> XParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
pn)

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

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



---- XML Parsing Functions ----

justDTD :: XParser (Maybe DocTypeDecl)
justDTD :: Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
justDTD =
  do (ExtSubset Maybe TextDecl
_ [ExtSubsetDecl]
ds) <- XParser ExtSubset
extsubset XParser ExtSubset -> String -> XParser ExtSubset
forall a. a -> String -> a
`debug` String
"Trying external subset"
     if [ExtSubsetDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtSubsetDecl]
ds then String -> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
         else Maybe DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocTypeDecl -> Maybe DocTypeDecl
forall a. a -> Maybe a
Just (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD (String -> QName
N String
"extsubset") Maybe ExternalID
forall a. Maybe a
Nothing ((ExtSubsetDecl -> [MarkupDecl]) -> [ExtSubsetDecl] -> [MarkupDecl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExtSubsetDecl -> [MarkupDecl]
extract [ExtSubsetDecl]
ds)))
  Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
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
     Maybe DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
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)) = (ExtSubsetDecl -> [MarkupDecl]) -> [ExtSubsetDecl] -> [MarkupDecl]
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 :: Parser SymTabs (Posn, TokenT) (Document Posn)
document = do
 -- p <- prolog `adjustErr` ("unrecognisable XML prolog\n"++)
 -- e <- element
 -- ms <- many misc
 -- (_,ge) <- stGet
 -- return (Document p ge e ms)
    (Prolog
 -> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> Parser
     SymTabs
     (Posn, TokenT)
     (Prolog
      -> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document Parser
  SymTabs
  (Posn, TokenT)
  (Prolog
   -> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> XParser Prolog
-> Parser
     SymTabs
     (Posn, TokenT)
     (SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (XParser Prolog
prolog XParser Prolog -> (String -> String) -> XParser Prolog
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr`
                                    (String
"unrecognisable XML prolog\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++))
                    Parser
  SymTabs
  (Posn, TokenT)
  (SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> Parser SymTabs (Posn, TokenT) (SymTab EntityDef)
-> Parser
     SymTabs (Posn, TokenT) (Element Posn -> [Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (SymTabs -> SymTab EntityDef)
-> Parser SymTabs (Posn, TokenT) SymTabs
-> Parser SymTabs (Posn, TokenT) (SymTab EntityDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymTabs -> SymTab EntityDef
forall a b. (a, b) -> b
snd Parser SymTabs (Posn, TokenT) SymTabs
forall s t. Parser s t s
stGet
                    Parser
  SymTabs (Posn, TokenT) (Element Posn -> [Misc] -> Document Posn)
-> Parser SymTabs (Posn, TokenT) (Element Posn)
-> Parser SymTabs (Posn, TokenT) ([Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser SymTabs (Posn, TokenT) (Element Posn)
element
                    Parser SymTabs (Posn, TokenT) ([Misc] -> Document Posn)
-> Parser SymTabs (Posn, TokenT) [Misc]
-> Parser SymTabs (Posn, TokenT) (Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc

-- | Return an XML comment.
comment :: XParser Comment
comment :: Parser SymTabs (Posn, TokenT) String
comment = do
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
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) Parser SymTabs (Posn, TokenT) 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
    XParser ProcessingInstruction -> XParser ProcessingInstruction
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser ProcessingInstruction -> XParser ProcessingInstruction)
-> XParser ProcessingInstruction -> XParser ProcessingInstruction
forall a b. (a -> b) -> a -> b
$ do
      String
n <- Parser SymTabs (Posn, TokenT) String
string  Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> Parser SymTabs (Posn, TokenT) String
forall a. String -> XParser a
failP String
"processing instruction has no target"
      String
f <- Parser SymTabs (Posn, TokenT) String
freetext
      TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP (String
"missing ?> in <?"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
      ProcessingInstruction -> XParser ProcessingInstruction
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, String
f)

cdsect :: XParser CDSect
cdsect :: Parser SymTabs (Posn, TokenT) String
cdsect = do
    TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
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)) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSectionClose) Parser SymTabs (Posn, TokenT) String
chardata

prolog :: XParser Prolog
prolog :: XParser Prolog
prolog = do
    Maybe XMLDecl
x   <- XParser XMLDecl -> XParser (Maybe XMLDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser XMLDecl
xmldecl
    [Misc]
m1  <- Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
    Maybe DocTypeDecl
dtd <- XParser DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser DocTypeDecl
doctypedecl
    [Misc]
m2  <- Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
    Prolog -> XParser Prolog
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" XParser () -> XParser () -> XParser ()
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 <- Parser SymTabs (Posn, TokenT) String
freetext
    TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP String
"missing ?> in <?xml ...?>"
 -- raise ((runParser aux emptySTs . xmlReLex p) s)
    XMLDecl -> XParser XMLDecl
forall (m :: * -> *) a. Monad m => a -> m a
return ((XMLDecl, SymTabs, [(Posn, TokenT)]) -> XMLDecl
forall a b c. (a, b, c) -> a
fst3 ((XParser XMLDecl
-> SymTabs
-> [(Posn, TokenT)]
-> (XMLDecl, SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser XParser XMLDecl
aux SymTabs
emptySTs ([(Posn, TokenT)] -> (XMLDecl, SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (XMLDecl, SymTabs, [(Posn, TokenT)])
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 <- Parser SymTabs (Posn, TokenT) String
versioninfo  Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> Parser SymTabs (Posn, TokenT) String
forall a. String -> XParser a
failP String
"missing XML version info"
        Maybe EncodingDecl
e <- XParser EncodingDecl -> XParser (Maybe EncodingDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser EncodingDecl
encodingdecl
        Maybe Bool
s <- XParser Bool -> XParser (Maybe Bool)
forall a. XParser a -> XParser (Maybe a)
maybe XParser Bool
sddecl
        XMLDecl -> XParser XMLDecl
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 :: Parser SymTabs (Posn, TokenT) String
versioninfo = do
    String -> XParser ()
word String
"version" XParser () -> XParser () -> XParser ()
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
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext

misc :: XParser Misc
misc :: Parser SymTabs (Posn, TokenT) Misc
misc =
    [(String, Parser SymTabs (Posn, TokenT) Misc)]
-> Parser SymTabs (Posn, TokenT) Misc
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"<!--comment-->",  String -> Misc
Comment (String -> Misc)
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) Misc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) String
comment)
           , (String
"<?PI?>",          ProcessingInstruction -> Misc
PI (ProcessingInstruction -> Misc)
-> XParser ProcessingInstruction
-> Parser SymTabs (Posn, TokenT) Misc
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)
    XParser DocTypeDecl -> XParser DocTypeDecl
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser DocTypeDecl -> XParser DocTypeDecl)
-> XParser DocTypeDecl -> XParser DocTypeDecl
forall a b. (a -> b) -> a -> b
$ do
      QName
n   <- XParser QName
qname
      Maybe ExternalID
eid <- XParser ExternalID -> XParser (Maybe ExternalID)
forall a. XParser a -> XParser (Maybe a)
maybe XParser ExternalID
externalid
      Maybe [MarkupDecl]
es  <- XParser [MarkupDecl] -> XParser (Maybe [MarkupDecl])
forall a. XParser a -> XParser (Maybe a)
maybe (XParser TokenT
-> XParser TokenT -> XParser [MarkupDecl] -> XParser [MarkupDecl]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokSqOpen) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSqClose)
                            (Parser SymTabs (Posn, TokenT) MarkupDecl -> XParser [MarkupDecl]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser SymTabs (Posn, TokenT) MarkupDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) MarkupDecl
markupdecl)))
      XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose)  XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP String
"missing > in DOCTYPE decl"
      DocTypeDecl -> XParser DocTypeDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD QName
n Maybe ExternalID
eid ([MarkupDecl] -> Maybe [MarkupDecl] -> [MarkupDecl]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [MarkupDecl]
es))

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

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

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

sddecl :: XParser SDDecl
sddecl :: XParser Bool
sddecl = do
    String -> XParser ()
word String
"standalone" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"STANDALONE"
    XParser Bool -> XParser Bool
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser Bool -> XParser Bool) -> XParser Bool -> XParser Bool
forall a b. (a -> b) -> a -> b
$ do
      TokenT -> XParser TokenT
tok TokenT
TokEqual XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP String
"missing = in 'standalone' decl"
      XParser TokenT -> XParser TokenT -> XParser Bool -> XParser Bool
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote)
              ( (String -> XParser ()
word String
"yes" XParser () -> XParser Bool -> XParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) XParser Bool -> XParser Bool -> XParser Bool
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
                (String -> XParser ()
word String
"no" XParser () -> XParser Bool -> XParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) XParser Bool -> XParser Bool -> XParser Bool
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
                String -> XParser Bool
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 :: Parser SymTabs (Posn, TokenT) (Element Posn)
element = do
    TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
    (ElemTag QName
n [Attribute]
as) <- XParser ElemTag
elemtag
    ([Content Posn] -> Element Posn)
-> Parser SymTabs (Posn, TokenT) ([Content Posn] -> Element Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
as) Parser SymTabs (Posn, TokenT) ([Content Posn] -> Element Posn)
-> Parser SymTabs (Posn, TokenT) [Content Posn]
-> Parser SymTabs (Posn, TokenT) (Element Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply`
        ( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
             [Content Posn] -> Parser SymTabs (Posn, TokenT) [Content Posn]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          Parser SymTabs (Posn, TokenT) [Content Posn]
-> Parser SymTabs (Posn, TokenT) [Content Posn]
-> Parser SymTabs (Posn, TokenT) [Content Posn]
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
          do TokenT -> XParser TokenT
tok TokenT
TokAnyClose
             Parser SymTabs (Posn, TokenT) [Content Posn]
-> Parser SymTabs (Posn, TokenT) [Content Posn]
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser SymTabs (Posn, TokenT) [Content Posn]
 -> Parser SymTabs (Posn, TokenT) [Content Posn])
-> Parser SymTabs (Posn, TokenT) [Content Posn]
-> Parser SymTabs (Posn, TokenT) [Content Posn]
forall a b. (a -> b) -> a -> b
$ Parser SymTabs (Posn, TokenT) (Content Posn)
-> XParser () -> Parser SymTabs (Posn, TokenT) [Content Posn]
forall s t a z. Parser s t a -> Parser s t z -> Parser s t [a]
manyFinally Parser SymTabs (Posn, TokenT) (Content Posn)
content
                                  (do Posn
p <- XParser Posn
posn
                                      QName
m <- XParser TokenT -> XParser TokenT -> XParser QName -> XParser QName
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokEndOpen)
                                                   (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
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)
          ) Parser SymTabs (Posn, TokenT) [Content Posn]
-> (String -> String)
-> Parser SymTabs (Posn, TokenT) [Content Posn]
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in element tag "String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
",\n")String -> String -> String
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 QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
m then () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else String -> XParser ()
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String
"tag <"String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"> terminated by </"String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
m
                String -> String -> String
forall a. [a] -> [a] -> [a]
++String
">\n  at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
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 XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"malformed element tag\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    [Attribute]
as <- Parser SymTabs (Posn, TokenT) Attribute
-> Parser SymTabs (Posn, TokenT) [Attribute]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Attribute
attribute
    ElemTag -> XParser ElemTag
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
    ElemTag -> XParser ElemTag
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 :: Parser SymTabs (Posn, TokenT) Attribute
attribute = do
    QName
n <- XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"malformed attribute name\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    TokenT -> XParser TokenT
tok TokenT
TokEqual XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP String
"missing = in attribute"
    AttValue
v <- XParser AttValue
attvalue XParser AttValue -> XParser AttValue -> XParser AttValue
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser AttValue
forall a. String -> XParser a
failBadP String
"missing attvalue"
    Attribute -> Parser SymTabs (Posn, TokenT) Attribute
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 :: Parser SymTabs (Posn, TokenT) (Content Posn)
content =
  do { Posn
p  <- XParser Posn
posn
     ; Posn -> Content Posn
c' <- XParser (Posn -> Content Posn)
content'
     ; Content Posn -> Parser SymTabs (Posn, TokenT) (Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Posn -> Content Posn
c' Posn
p)
     }
  where
     content' :: XParser (Posn -> Content Posn)
content' = [(String, XParser (Posn -> Content Posn))]
-> XParser (Posn -> Content Posn)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"element",   Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem (Element Posn -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) (Element Posn)
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) (Element Posn)
element)
                       , (String
"chardata",  Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
False (String -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) String
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) String
chardata)
                       , (String
"reference", Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef (Reference -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) Reference
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Reference
reference)
                       , (String
"CDATA",     Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
True (String -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) String
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) String
cdsect)
                       , (String
"misc",      Misc -> Posn -> Content Posn
forall i. Misc -> i -> Content i
CMisc (Misc -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) Misc
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Misc
misc)
                       ]
                  XParser (Posn -> Content Posn)
-> (String -> String) -> XParser (Posn -> Content Posn)
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (String
"when looking for a content item,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
-- (\    (element, text, reference, CDATA section, <!--comment-->, or <?PI?>")

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

contentspec :: XParser ContentSpec
contentspec :: XParser ContentSpec
contentspec =
    [(String, XParser ContentSpec)] -> XParser ContentSpec
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"EMPTY",  XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (String -> XParser ()
word String
"EMPTY") XParser () -> XParser ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
EMPTY)
           , (String
"ANY",    XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (String -> XParser ()
word String
"ANY") XParser () -> XParser ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
ANY)
           , (String
"mixed",  Mixed -> ContentSpec
Mixed (Mixed -> ContentSpec)
-> Parser SymTabs (Posn, TokenT) Mixed -> XParser ContentSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) Mixed
mixed)
           , (String
"simple", CP -> ContentSpec
ContentSpec (CP -> ContentSpec)
-> Parser SymTabs (Posn, TokenT) CP -> XParser ContentSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) CP
-> Parser SymTabs (Posn, TokenT) CP
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) 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
    XParser TokenT -> XParser TokenT -> XParser [CP] -> XParser [CP]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen XParser TokenT -> String -> XParser TokenT
forall a. a -> String -> a
`debug` String
"Trying choice")
            (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose XParser TokenT -> String -> XParser TokenT
forall a. a -> String -> a
`debug` String
"Succeeded with choice"))
            (Parser SymTabs (Posn, TokenT) CP
-> Parser SymTabs (Posn, TokenT) CP
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) CP
cp Parser SymTabs (Posn, TokenT) CP -> XParser TokenT -> XParser [CP]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokPipe))

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

cp :: XParser CP
cp :: Parser SymTabs (Posn, TokenT) CP
cp = [Parser SymTabs (Posn, TokenT) CP]
-> Parser SymTabs (Posn, TokenT) 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
                CP -> Parser SymTabs (Posn, TokenT) CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: name "String -> String -> String
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
                CP -> Parser SymTabs (Posn, TokenT) CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: sequence "String -> String -> String
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
                CP -> Parser SymTabs (Posn, TokenT) CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: choice "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           ] Parser SymTabs (Posn, TokenT) CP
-> (String -> String) -> Parser SymTabs (Posn, TokenT) CP
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\nwhen looking for a content particle")

modifier :: XParser Modifier
modifier :: XParser Modifier
modifier = [XParser Modifier] -> XParser Modifier
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ TokenT -> XParser TokenT
tok TokenT
TokStar XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Star
                 , TokenT -> XParser TokenT
tok TokenT
TokQuery XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Query
                 , TokenT -> XParser TokenT
tok TokenT
TokPlus XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Plus
                 , Modifier -> XParser Modifier
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
nString -> String -> String
forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
    Choice [CP]
cps Modifier
m -> Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" ((CP -> String) -> [CP] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CP -> String
debugShowCP [CP]
cps)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"String -> String -> String
forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
    Seq [CP]
cps Modifier
m    -> Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((CP -> String) -> [CP] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CP -> String
debugShowCP [CP]
cps)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"String -> String -> 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 :: Parser SymTabs (Posn, TokenT) Mixed
mixed = do
    TokenT -> XParser TokenT
tok TokenT
TokBraOpen
    XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokHash
              String -> XParser ()
word String
"PCDATA")
    Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser SymTabs (Posn, TokenT) Mixed
 -> Parser SymTabs (Posn, TokenT) Mixed)
-> Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall a b. (a -> b) -> a -> b
$
      [Parser SymTabs (Posn, TokenT) Mixed]
-> Parser SymTabs (Posn, TokenT) Mixed
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ do [QName]
cs <- XParser QName -> Parser SymTabs (Posn, TokenT) [QName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokPipe
                                       XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname))
                 XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar)
                 Mixed -> Parser SymTabs (Posn, TokenT) Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return ([QName] -> Mixed
PCDATAplus [QName]
cs)
            , XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar) XParser TokenT
-> Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> Parser SymTabs (Posn, TokenT) Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA
            , XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose) XParser TokenT
-> Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> Parser SymTabs (Posn, TokenT) Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA
            ]
        Parser SymTabs (Posn, TokenT) Mixed
-> (String -> String) -> Parser SymTabs (Posn, TokenT) Mixed
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\nLooking for mixed content spec (#PCDATA | ...)*\n")

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

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

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

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

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

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

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

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

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

newIgnore :: XParser Ignore
newIgnore :: Parser SymTabs (Posn, TokenT) Ignore
newIgnore =
    ( do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
         Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) [Ignore]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Ignore
newIgnore Parser SymTabs (Posn, TokenT) [Ignore]
-> String -> Parser SymTabs (Posn, TokenT) [Ignore]
forall a. a -> String -> a
`debug` String
"IGNORING conditional section"
         TokenT -> XParser TokenT
tok TokenT
TokSectionClose
         Ignore -> Parser SymTabs (Posn, TokenT) Ignore
forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore Parser SymTabs (Posn, TokenT) Ignore
-> String -> Parser SymTabs (Posn, TokenT) Ignore
forall a. a -> String -> a
`debug` String
"end of IGNORED conditional section") Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) Ignore
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]
         Ignore -> Parser SymTabs (Posn, TokenT) Ignore
forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore  Parser SymTabs (Posn, TokenT) Ignore
-> String -> Parser SymTabs (Posn, TokenT) Ignore
forall a. a -> String -> a
`debug` (String
"ignoring: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
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 :: Parser SymTabs (Posn, TokenT) Reference
reference = do
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) Reference
-> Parser SymTabs (Posn, TokenT) Reference
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokAmp) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSemi) (Parser SymTabs (Posn, TokenT) String
freetext Parser SymTabs (Posn, TokenT) String
-> (String -> Parser SymTabs (Posn, TokenT) Reference)
-> Parser SymTabs (Posn, TokenT) Reference
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser SymTabs (Posn, TokenT) Reference
forall (m :: * -> *). Monad m => String -> m Reference
val)
  where
    val :: String -> m Reference
val (Char
'#':Char
'x':String
i) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit String
i
                    = Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar (CharRef -> Reference)
-> (String -> CharRef) -> String -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharRef, String) -> CharRef
forall a b. (a, b) -> a
fst ((CharRef, String) -> CharRef)
-> (String -> (CharRef, String)) -> String -> CharRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CharRef, String)] -> (CharRef, String)
forall a. [a] -> a
head ([(CharRef, String)] -> (CharRef, String))
-> (String -> [(CharRef, String)]) -> String -> (CharRef, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(CharRef, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
i
    val (Char
'#':String
i)     | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
i
                    = Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar (CharRef -> Reference)
-> (String -> CharRef) -> String -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharRef, String) -> CharRef
forall a b. (a, b) -> a
fst ((CharRef, String) -> CharRef)
-> (String -> (CharRef, String)) -> String -> CharRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CharRef, String)] -> (CharRef, String)
forall a. [a] -> a
head ([(CharRef, String)] -> (CharRef, String))
-> (String -> [(CharRef, String)]) -> String -> (CharRef, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(CharRef, String)]
forall a. (Eq a, Num a) => ReadS a
readDec (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
i
    val String
name        = Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Reference
RefEntity (String -> m Reference) -> String -> m Reference
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 :: Parser SymTabs (Posn, TokenT) String
pereference = do
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
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) Parser SymTabs (Posn, TokenT) String
nmtoken

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

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

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

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

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

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

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

textdecl :: XParser TextDecl
textdecl :: XParser TextDecl
textdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokPIOpen
    String -> XParser ()
word String
"xml" XParser () -> XParser () -> XParser ()
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 <- Parser SymTabs (Posn, TokenT) String -> XParser (Maybe String)
forall a. XParser a -> XParser (Maybe a)
maybe Parser SymTabs (Posn, TokenT) String
versioninfo
    EncodingDecl
e <- XParser EncodingDecl
encodingdecl
    TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP String
"expected ?> terminating text decl"
    TextDecl -> XParser TextDecl
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" XParser () -> XParser () -> XParser ()
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 XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP String
"expected = in 'encoding' decl"
    String
f <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
    EncodingDecl -> XParser EncodingDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EncodingDecl
EncodingDecl String
f)

notationdecl :: XParser NotationDecl
notationdecl :: Parser SymTabs (Posn, TokenT) NotationDecl
notationdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
NOTATIONx)
    String
n <- Parser SymTabs (Posn, TokenT) String
name
    Either ExternalID PublicID
e <- XParser ExternalID
-> XParser PublicID -> XParser (Either ExternalID PublicID)
forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser ExternalID
externalid XParser PublicID
publicid
    TokenT -> XParser TokenT
tok TokenT
TokAnyClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP (String
"expected > terminating NOTATION decl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
    NotationDecl -> Parser SymTabs (Posn, TokenT) NotationDecl
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 (PubidLiteral -> PublicID)
-> XParser PubidLiteral -> XParser PublicID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser PubidLiteral
pubidliteral

entityvalue :: XParser EntityValue
entityvalue :: Parser SymTabs (Posn, TokenT) 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 <- Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) EV
ev
    TokenT -> XParser TokenT
tok TokenT
TokQuote XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP String
"expected quote to terminate entityvalue"
    -- quoted text must be rescanned for possible PERefs
    SymTabs
st <- Parser SymTabs (Posn, TokenT) SymTabs
forall s t. Parser s t s
stGet
 -- Prelude.either failBad (return . EntityValue) . fst3 $
    EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue)
-> (([EV], SymTabs, [(Posn, TokenT)]) -> EntityValue)
-> ([EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue ([EV] -> EntityValue)
-> (([EV], SymTabs, [(Posn, TokenT)]) -> [EV])
-> ([EV], SymTabs, [(Posn, TokenT)])
-> EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([EV], SymTabs, [(Posn, TokenT)]) -> [EV]
forall a b c. (a, b, c) -> a
fst3 (([EV], SymTabs, [(Posn, TokenT)])
 -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ([EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall a b. (a -> b) -> a -> b
$
                Parser SymTabs (Posn, TokenT) [EV]
-> SymTabs -> [(Posn, TokenT)] -> ([EV], SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser (Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) 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)) = String -> Maybe String
forall a. a -> Maybe a
Just (EntityValue -> String
flattenEV EntityValue
ev)
    stringify Maybe PEDef
_ = Maybe String
forall a. Maybe a
Nothing

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

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

systemliteral :: XParser SystemLiteral
systemliteral :: Parser SymTabs (Posn, TokenT) SystemLiteral
systemliteral = do
    String
s <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
    SystemLiteral -> Parser SymTabs (Posn, TokenT) SystemLiteral
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 <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
    PubidLiteral -> XParser PubidLiteral
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 :: Parser SymTabs (Posn, TokenT) String
chardata = Parser SymTabs (Posn, TokenT) String
freetext