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

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

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

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

import System.FilePath (combine, dropFileName)


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

--  #define DEBUG

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


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

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

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

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

xmlParse :: String -> String -> Document Posn
xmlParse  String
name  = (String -> Document Posn)
-> (Document Posn -> Document Posn)
-> Either String (Document Posn)
-> Document Posn
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> Document Posn
forall a. HasCallStack => String -> a
error Document Posn -> Document Posn
forall a. a -> a
id (Either String (Document Posn) -> Document Posn)
-> (String -> Either String (Document Posn))
-> String
-> Document Posn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Either String (Document Posn)
xmlParse' String
name
dtdParse :: String -> String -> Maybe DocTypeDecl
dtdParse  String
name  = (String -> Maybe DocTypeDecl)
-> (Maybe DocTypeDecl -> Maybe DocTypeDecl)
-> Either String (Maybe DocTypeDecl)
-> Maybe DocTypeDecl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> Maybe DocTypeDecl
forall a. HasCallStack => String -> a
error Maybe DocTypeDecl -> Maybe DocTypeDecl
forall a. a -> a
id (Either String (Maybe DocTypeDecl) -> Maybe DocTypeDecl)
-> (String -> Either String (Maybe DocTypeDecl))
-> String
-> Maybe DocTypeDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Either String (Maybe DocTypeDecl)
dtdParse' String
name

xmlParse' :: String -> String -> Either String (Document Posn)
xmlParse' String
name  = (Either String (Document Posn), SymTabs, [(Posn, TokenT)])
-> Either String (Document Posn)
forall a b c. (a, b, c) -> a
fst3 ((Either String (Document Posn), SymTabs, [(Posn, TokenT)])
 -> Either String (Document Posn))
-> (String
    -> (Either String (Document Posn), SymTabs, [(Posn, TokenT)]))
-> String
-> Either String (Document Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser SymTabs (Posn, TokenT) (Document Posn)
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String (Document Posn), SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String 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)]
 -> (Either String (Document Posn), SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either 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 -> Either String (Maybe DocTypeDecl)
dtdParse' String
name  = (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
-> Either String (Maybe DocTypeDecl)
forall a b c. (a, b, c) -> a
fst3 ((Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
 -> Either String (Maybe DocTypeDecl))
-> (String
    -> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)]))
-> String
-> Either String (Maybe DocTypeDecl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
justDTD  SymTabs
emptySTs ([(Posn, TokenT)]
 -> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either 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 = (\(Either String a
v,SymTabs
_,[(Posn, TokenT)]
s)->(Either String a
v,[(Posn, TokenT)]
s)) ((Either String a, SymTabs, [(Posn, TokenT)])
 -> (Either String a, [(Posn, TokenT)]))
-> ([(Posn, TokenT)]
    -> (Either String 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)]
-> (Either String a, SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser XParser a
p SymTabs
emptySTs


---- Symbol table stuff ----

type SymTabs = (SymTab PEDef, SymTab EntityDef)

-- | Some empty symbol tables for GE and PE references.
emptySTs :: SymTabs
emptySTs :: SymTabs
emptySTs = (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 PolyState parser.
type XParser a = Parser SymTabs (Posn,TokenT) a

-- | Return the next token from the input only if it matches the given token.
tok :: TokenT -> XParser TokenT
tok :: TokenT -> XParser TokenT
tok TokenT
t = do (Posn
p,TokenT
t') <- 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
_i)) = []

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

-- | 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 ...?>"
    (Either String XMLDecl, SymTabs, [(Posn, TokenT)])
-> XParser XMLDecl
forall a b c. (Either String a, b, c) -> XParser a
raise ((XParser XMLDecl
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String XMLDecl, SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser XParser XMLDecl
aux SymTabs
emptySTs ([(Posn, TokenT)]
 -> (Either String XMLDecl, SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either 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 :: (Either String a, b, c) -> XParser a
raise (Left String
err, b
_, c
_) = String -> XParser a
forall a. String -> XParser a
failP String
err
    raise (Right a
ok, b
_, c
_) = a -> XParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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 :: XParser (Element Posn)
element = do
    TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
    (ElemTag QName
n [Attribute]
as) <- XParser ElemTag
elemtag
    ( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
         XParser (Element Posn) -> XParser (Element Posn)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Element Posn -> XParser (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 []))
        XParser (Element Posn)
-> XParser (Element Posn) -> XParser (Element 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
         XParser (Element Posn) -> XParser (Element Posn)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser (Element Posn) -> XParser (Element Posn))
-> XParser (Element Posn) -> XParser (Element Posn)
forall a b. (a -> b) -> a -> b
$ do
           ([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]
-> XParser (Element Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply`
                 Parser SymTabs (Posn, TokenT) (Content Posn)
-> XParser () -> Parser SymTabs (Posn, TokenT) [Content Posn]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [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)
      ) XParser (Element Posn)
-> (String -> String) -> XParser (Element 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)
-> XParser (Element Posn) -> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser (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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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 z. PolyParse p => p a -> p z -> 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"
           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) (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
    (String -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ([EV] -> Parser SymTabs (Posn, TokenT) EntityValue)
-> Either String [EV]
-> Parser SymTabs (Posn, TokenT) EntityValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> Parser SymTabs (Posn, TokenT) EntityValue
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ([EV] -> EntityValue)
-> [EV]
-> Parser SymTabs (Posn, TokenT) EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue) (Either String [EV] -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ((Either String [EV], SymTabs, [(Posn, TokenT)])
    -> Either String [EV])
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Either String [EV]
forall a b c. (a, b, c) -> a
fst3 ((Either String [EV], SymTabs, [(Posn, TokenT)])
 -> Parser SymTabs (Posn, TokenT) EntityValue)
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall a b. (a -> b) -> a -> b
$
                Parser SymTabs (Posn, TokenT) [EV]
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String 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