{-# OPTIONS -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 (intersperse)       -- debugging only
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 =
    ( XParser a
p XParser a -> (a -> XParser (Maybe a)) -> XParser (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> XParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> XParser (Maybe a))
-> (a -> Maybe a) -> a -> XParser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) 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 =
    ( XParser a
p XParser a -> (a -> XParser (Either a b)) -> XParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> XParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> XParser (Either a b))
-> (a -> Either a b) -> a -> XParser (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) 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`
    ( XParser b
q XParser b -> (b -> XParser (Either a b)) -> XParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> XParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> XParser (Either a b))
-> (b -> Either a b) -> b -> XParser (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)

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-->",  Parser SymTabs (Posn, TokenT) String
comment Parser SymTabs (Posn, TokenT) String
-> (String -> Parser SymTabs (Posn, TokenT) Misc)
-> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser SymTabs (Posn, TokenT) Misc)
-> (String -> Misc) -> String -> Parser SymTabs (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Misc
Comment)
           , (String
"<?PI?>",          XParser ProcessingInstruction
processinginstruction XParser ProcessingInstruction
-> (ProcessingInstruction -> Parser SymTabs (Posn, TokenT) Misc)
-> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser SymTabs (Posn, TokenT) Misc)
-> (ProcessingInstruction -> Misc)
-> ProcessingInstruction
-> Parser SymTabs (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessingInstruction -> Misc
PI)
           ]

-- | 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 (case Maybe [MarkupDecl]
es of { Maybe [MarkupDecl]
Nothing -> []; Just [MarkupDecl]
e -> [MarkupDecl]
e }))

-- | 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",  XParser ElementDecl
elementdecl  XParser ElementDecl
-> (ElementDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (ElementDecl -> MarkupDecl)
-> ElementDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElementDecl -> MarkupDecl
Element)
         , (String
"ATTLIST",  XParser AttListDecl
attlistdecl  XParser AttListDecl
-> (AttListDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (AttListDecl -> MarkupDecl)
-> AttListDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttListDecl -> MarkupDecl
AttList)
         , (String
"ENTITY",   XParser EntityDecl
entitydecl   XParser EntityDecl
-> (EntityDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (EntityDecl -> MarkupDecl)
-> EntityDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDecl -> MarkupDecl
Entity)
         , (String
"NOTATION", XParser NotationDecl
notationdecl XParser NotationDecl
-> (NotationDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (NotationDecl -> MarkupDecl)
-> NotationDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotationDecl -> MarkupDecl
Notation)
         , (String
"misc",     Parser SymTabs (Posn, TokenT) Misc
misc         Parser SymTabs (Posn, TokenT) Misc
-> (Misc -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (Misc -> MarkupDecl)
-> Misc
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Misc -> MarkupDecl
MarkupMisc)
         ]
    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 =
    ( Parser SymTabs (Posn, TokenT) MarkupDecl
markupdecl Parser SymTabs (Posn, TokenT) MarkupDecl
-> (MarkupDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> (MarkupDecl -> ExtSubsetDecl)
-> MarkupDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupDecl -> ExtSubsetDecl
ExtMarkupDecl) 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`
    ( XParser ConditionalSect
conditionalsect XParser ConditionalSect
-> (ConditionalSect -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> (ConditionalSect -> ExtSubsetDecl)
-> ConditionalSect
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalSect -> ExtSubsetDecl
ExtConditionalSect)

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",   XParser (Element Posn)
element   XParser (Element Posn)
-> (Element Posn -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Element Posn -> Posn -> Content Posn)
-> Element Posn
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem)
                       , (String
"chardata",  Parser SymTabs (Posn, TokenT) String
chardata  Parser SymTabs (Posn, TokenT) String
-> (String -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (String -> Posn -> Content Posn)
-> String
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
False)
                       , (String
"reference", XParser Reference
reference XParser Reference
-> (Reference -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Reference -> Posn -> Content Posn)
-> Reference
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef)
                       , (String
"CDATA",     Parser SymTabs (Posn, TokenT) String
cdsect    Parser SymTabs (Posn, TokenT) String
-> (String -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (String -> Posn -> Content Posn)
-> String
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
True)
                       , (String
"misc",      Parser SymTabs (Posn, TokenT) Misc
misc      Parser SymTabs (Posn, TokenT) Misc
-> (Misc -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Misc -> Posn -> Content Posn)
-> Misc
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Misc -> Posn -> Content Posn
forall i. Misc -> i -> Content i
CMisc)
                       ]
                  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 :: XParser 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 -> XParser 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",  XParser Mixed -> XParser Mixed
forall a. XParser a -> XParser a
peRef XParser Mixed
mixed XParser Mixed
-> (Mixed -> XParser ContentSpec) -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentSpec -> XParser ContentSpec)
-> (Mixed -> ContentSpec) -> Mixed -> XParser ContentSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mixed -> ContentSpec
Mixed)
           , (String
"simple", XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser CP -> (CP -> XParser ContentSpec) -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentSpec -> XParser ContentSpec)
-> (CP -> ContentSpec) -> CP -> XParser ContentSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CP -> ContentSpec
ContentSpec)
           ]
 --   `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"))
            (XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser 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"))
            (XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser 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 :: XParser CP
cp = [XParser CP] -> XParser 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 -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser 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 -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser 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 -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: choice "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c))
           ] XParser CP -> (String -> String) -> XParser 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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse 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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse 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 :: XParser 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")
    XParser Mixed -> XParser Mixed
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser Mixed -> XParser Mixed) -> XParser Mixed -> XParser Mixed
forall a b. (a -> b) -> a -> b
$
      [XParser Mixed] -> XParser 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 -> XParser 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 -> XParser Mixed -> XParser Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> XParser 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 -> XParser Mixed -> XParser Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> XParser Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA)
            ]
        XParser Mixed -> (String -> String) -> XParser 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 :: XParser 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 -> XParser 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",  XParser TokenizedType
tokenizedtype XParser TokenizedType
-> (TokenizedType -> XParser AttType) -> XParser AttType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AttType -> XParser AttType
forall (m :: * -> *) a. Monad m => a -> m a
return (AttType -> XParser AttType)
-> (TokenizedType -> AttType) -> TokenizedType -> XParser AttType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenizedType -> AttType
TokenizedType)
           , (String
"enumerated", XParser EnumeratedType
enumeratedtype XParser EnumeratedType
-> (EnumeratedType -> XParser AttType) -> XParser AttType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AttType -> XParser AttType
forall (m :: * -> *) a. Monad m => a -> m a
return (AttType -> XParser AttType)
-> (EnumeratedType -> AttType) -> EnumeratedType -> XParser AttType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumeratedType -> AttType
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 :: XParser TokenizedType
tokenizedtype =
    [XParser TokenizedType] -> XParser TokenizedType
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ( String -> XParser ()
word String
"ID" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ID)
          , ( String -> XParser ()
word String
"IDREF" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREF)
          , ( String -> XParser ()
word String
"IDREFS" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREFS)
          , ( String -> XParser ()
word String
"ENTITY" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITY)
          , ( String -> XParser ()
word String
"ENTITIES" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITIES)
          , ( String -> XParser ()
word String
"NMTOKEN" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKEN)
          , ( String -> XParser ()
word String
"NMTOKENS" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKENS)
          ] XParser TokenizedType
-> XParser TokenizedType -> XParser 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 -> XParser 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 :: XParser EnumeratedType
enumeratedtype =
    [(String, XParser EnumeratedType)] -> XParser EnumeratedType
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"NOTATION",   XParser [String]
notationtype XParser [String]
-> ([String] -> XParser EnumeratedType) -> XParser EnumeratedType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumeratedType -> XParser EnumeratedType
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumeratedType -> XParser EnumeratedType)
-> ([String] -> EnumeratedType)
-> [String]
-> XParser EnumeratedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> EnumeratedType
NotationType)
           , (String
"enumerated", XParser [String]
enumeration XParser [String]
-> ([String] -> XParser EnumeratedType) -> XParser EnumeratedType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumeratedType -> XParser EnumeratedType
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumeratedType -> XParser EnumeratedType)
-> ([String] -> EnumeratedType)
-> [String]
-> XParser EnumeratedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> EnumeratedType
Enumeration)
           ]
      XParser EnumeratedType
-> (String -> String) -> XParser 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 :: XParser [String]
notationtype = do
    String -> XParser ()
word String
"NOTATION"
    XParser TokenT
-> XParser TokenT -> XParser [String] -> XParser [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 -> XParser [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 :: XParser [String]
enumeration =
    XParser TokenT
-> XParser TokenT -> XParser [String] -> XParser [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 -> XParser [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 :: XParser ConditionalSect
conditionalsect = [(String, XParser ConditionalSect)] -> XParser 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 -> XParser 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 -> XParser ConditionalSect
forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreSect -> ConditionalSect
IgnoreSect []))
    ] XParser ConditionalSect
-> (String -> String) -> XParser 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 :: XParser Reference
reference = do
    XParser TokenT
-> XParser TokenT -> XParser Reference -> XParser 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 -> XParser Reference) -> XParser Reference
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParser 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 =
    ( charref >>= return . RefChar) `onFail`
    ( entityref >>= return . RefEntity)

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 :: XParser EntityDecl
entitydecl =
    ( XParser GEDecl
gedecl XParser GEDecl
-> (GEDecl -> XParser EntityDecl) -> XParser EntityDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDecl -> XParser EntityDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDecl -> XParser EntityDecl)
-> (GEDecl -> EntityDecl) -> GEDecl -> XParser EntityDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GEDecl -> EntityDecl
EntityGEDecl) XParser EntityDecl -> XParser EntityDecl -> XParser EntityDecl
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    ( XParser PEDecl
pedecl XParser PEDecl
-> (PEDecl -> XParser EntityDecl) -> XParser EntityDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDecl -> XParser EntityDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDecl -> XParser EntityDecl)
-> (PEDecl -> EntityDecl) -> PEDecl -> XParser EntityDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PEDecl -> EntityDecl
EntityPEDecl)

gedecl :: XParser GEDecl
gedecl :: XParser GEDecl
gedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    String
n <- 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 -> XParser GEDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EntityDef -> GEDecl
GEDecl String
n EntityDef
e)

pedecl :: XParser PEDecl
pedecl :: XParser PEDecl
pedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    TokenT -> XParser TokenT
tok TokenT
TokPercent
    String
n <- 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 -> XParser 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", XParser EntityValue
entityvalue XParser EntityValue
-> (EntityValue -> XParser EntityDef) -> XParser EntityDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDef -> XParser EntityDef
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDef -> XParser EntityDef)
-> (EntityValue -> EntityDef) -> EntityValue -> XParser EntityDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityValue -> EntityDef
DefEntityValue)
           , (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", XParser EntityValue
entityvalue XParser EntityValue
-> (EntityValue -> XParser PEDef) -> XParser PEDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PEDef -> XParser PEDef
forall (m :: * -> *) a. Monad m => a -> m a
return (PEDef -> XParser PEDef)
-> (EntityValue -> PEDef) -> EntityValue -> XParser PEDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityValue -> PEDef
PEDefEntityValue)
           , (String
"externalid",  XParser ExternalID
externalid  XParser ExternalID
-> (ExternalID -> XParser PEDef) -> XParser PEDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PEDef -> XParser PEDef
forall (m :: * -> *) a. Monad m => a -> m a
return (PEDef -> XParser PEDef)
-> (ExternalID -> PEDef) -> ExternalID -> XParser PEDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExternalID -> PEDef
PEDefExternalID)
           ]

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
s <- XParser SystemLiteral
systemliteral
                           ExternalID -> XParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemLiteral -> ExternalID
SYSTEM SystemLiteral
s) )
           , (String
"PUBLIC", do String -> XParser ()
word String
"PUBLIC"
                           PubidLiteral
p <- XParser PubidLiteral
pubidliteral
                           SystemLiteral
s <- XParser SystemLiteral
systemliteral
                           ExternalID -> XParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (PubidLiteral -> SystemLiteral -> ExternalID
PUBLIC PubidLiteral
p SystemLiteral
s) )
           ]
      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
n <- Parser SymTabs (Posn, TokenT) String
name
    NDataDecl -> XParser NDataDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> NDataDecl
NDATA String
n)

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 :: XParser 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 -> XParser 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
p <- XParser PubidLiteral
pubidliteral
    PublicID -> XParser PublicID
forall (m :: * -> *) a. Monad m => a -> m a
return (PubidLiteral -> PublicID
PUBLICID PubidLiteral
p)

entityvalue :: XParser EntityValue
entityvalue :: XParser EntityValue
entityvalue = do
 -- evs <- bracket (tok TokQuote) (commit $ tok TokQuote) (many (peRef ev))
    TokenT -> XParser TokenT
tok TokenT
TokQuote
    Posn
pn <- XParser Posn
posn
    [EV]
evs <- 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 -> XParser EntityValue)
-> ([EV] -> XParser EntityValue)
-> Either String [EV]
-> XParser EntityValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> XParser EntityValue
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (EntityValue -> XParser EntityValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityValue -> XParser EntityValue)
-> ([EV] -> EntityValue) -> [EV] -> XParser EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue) (Either String [EV] -> XParser EntityValue)
-> ((Either String [EV], SymTabs, [(Posn, TokenT)])
    -> Either String [EV])
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> XParser 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)])
 -> XParser EntityValue)
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> XParser 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",    (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) Parser SymTabs (Posn, TokenT) String
-> (String -> Parser SymTabs (Posn, TokenT) EV)
-> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EV -> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a. Monad m => a -> m a
return (EV -> Parser SymTabs (Posn, TokenT) EV)
-> (String -> EV) -> String -> Parser SymTabs (Posn, TokenT) EV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EV
EVString)
           , (String
"reference", XParser Reference
reference XParser Reference
-> (Reference -> Parser SymTabs (Posn, TokenT) EV)
-> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EV -> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a. Monad m => a -> m a
return (EV -> Parser SymTabs (Posn, TokenT) EV)
-> (Reference -> EV)
-> Reference
-> Parser SymTabs (Posn, TokenT) EV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> EV
EVRef)
           ]
      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
-> XParser 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 XParser 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 :: XParser 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 -> XParser 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