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

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

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

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

import System.FilePath (combine, dropFileName)


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

--  #define DEBUG

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


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

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

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

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

xmlParse :: String -> String -> Document Posn
xmlParse  String
name  = (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 :: forall a. 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 :: forall a.
XParser a
-> [(Posn, TokenT)] -> (Either String a, [(Posn, TokenT)])
xmlParseWith XParser a
p = (\(Either String a
v,SymTabs
_,[(Posn, TokenT)]
s)->(Either String a
v,[(Posn, TokenT)]
s)) ((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
forall a b. a -> b -> b
`seq` (SymTab PEDef
pe, SymTab EntityDef
newge)

lookupPE :: String -> SymTabs -> Maybe PEDef
lookupPE :: String -> SymTabs -> Maybe PEDef
lookupPE String
s (SymTab PEDef
pe,SymTab EntityDef
_ge) = 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 :: forall a b c. (a, b, c) -> a
fst3 (a
a,b
_,c
_) = a
a
snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
a,c
_) = b
a
thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
a) = c
a


---- Auxiliary Parsing Functions ----

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

-- | Return the next token from the input only if it matches the given token.
tok :: TokenT -> XParser TokenT
tok :: TokenT -> XParser TokenT
tok TokenT
t = do (Posn
p,TokenT
t') <- 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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. String -> Parser SymTabs (Posn, TokenT) a
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 a. Eq a => a -> [a] -> 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 a. String -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 = 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  -> case Char -> String -> [String]
split Char
':' String
s of
            [String
one] -> QName -> XParser QName
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> XParser QName) -> QName -> XParser QName
forall a b. (a -> b) -> a -> b
$ String -> QName
N String
s
            [String
ns,String
elem_name] -> QName -> XParser QName
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> XParser QName) -> QName -> XParser QName
forall a b. (a -> b) -> a -> b
$ Namespace -> String -> QName
QN (String -> String -> Namespace
Namespace String
ns String
"") String
elem_name
            [String]
_ -> (String -> XParser QName)
-> String -> Posn -> TokenT -> XParser QName
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser QName
forall a. String -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"a name" Posn
p TokenT
tok
        TokError String
_ -> (String -> XParser QName)
-> String -> Posn -> TokenT -> XParser QName
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser QName
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad String
"a name" Posn
p TokenT
tok
        TokenT
_          -> (String -> XParser QName)
-> String -> Posn -> TokenT -> XParser QName
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser QName
forall a. String -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"a name" Posn
p TokenT
tok
    where
    split :: Char -> String -> [String]
    split :: Char -> String -> [String]
split Char
c String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) String
xs of
        (String
ls, String
"") -> [String
ls]
        (String
ls, Char
x:String
rs) -> String
ls String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Char -> String -> [String]
split Char
c String
rs

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

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

maybe :: XParser a -> XParser (Maybe a)
maybe :: forall a. XParser a -> XParser (Maybe a)
maybe XParser a
p =
    ( a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> XParser a -> Parser SymTabs (Posn, TokenT) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser a
p) Parser SymTabs (Posn, TokenT) (Maybe a)
-> Parser SymTabs (Posn, TokenT) (Maybe a)
-> Parser SymTabs (Posn, TokenT) (Maybe a)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    Maybe a -> Parser SymTabs (Posn, TokenT) (Maybe a)
forall a. a -> Parser SymTabs (Posn, TokenT) 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 :: forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser a
p XParser b
q =
    ( a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b)
-> XParser a -> Parser SymTabs (Posn, TokenT) (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser a
p) Parser SymTabs (Posn, TokenT) (Either a b)
-> Parser SymTabs (Posn, TokenT) (Either a b)
-> Parser SymTabs (Posn, TokenT) (Either a b)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
    ( b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b)
-> XParser b -> Parser SymTabs (Posn, TokenT) (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser b
q)

word :: String -> XParser ()
word :: String -> XParser ()
word String
s = do { (Posn, TokenT)
x <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
            ; case (Posn, TokenT)
x of
                (Posn
_p,TokName String
n)     | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> XParser ()
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. String -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Posn
p
          }

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

failP, failBadP :: String -> XParser a
failP :: forall a. String -> Parser SymTabs (Posn, TokenT) a
failP String
msg = do { Posn
p <- XParser Posn
posn; String -> XParser a
forall a. String -> Parser SymTabs (Posn, TokenT) 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 :: forall a. String -> Parser SymTabs (Posn, TokenT) 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 :: forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser a
fail String
expect Posn
p TokenT
t = String -> XParser a
fail (String
"Expected "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 :: forall a. 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 a. 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 a. 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 :: forall a. 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 <- XParser 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 a. String -> Parser SymTabs (Posn, TokenT) 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 :: forall a. 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 <- XParser 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 -> Parser SymTabs (Posn, TokenT) 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 -> Parser SymTabs (Posn, TokenT) 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtSubsetDecl]
ds then String -> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall a. String -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
         else Maybe DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. XParser a -> (String -> String) -> XParser a
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 :: XParser String
comment = do
    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
TokCommentOpen) (TokenT -> XParser TokenT
tok TokenT
TokCommentClose) XParser String
freetext
--  tok TokCommentOpen
--  commit $ do
--    c <- freetext
--    tok TokCommentClose
--    return c

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

cdsect :: XParser CDSect
cdsect :: XParser String
cdsect = do
    TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
    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 (Section -> TokenT
TokSection Section
CDATAx)) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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) XParser 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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
    Prolog -> XParser Prolog
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 <- XParser 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 -> Parser SymTabs (Posn, TokenT) 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 <- XParser String
versioninfo  XParser String -> XParser String -> XParser String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser String
forall a. String -> Parser SymTabs (Posn, TokenT) 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 a. a -> Parser SymTabs (Posn, TokenT) a
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 -> Parser SymTabs (Posn, TokenT) a
failP String
err
    raise (Right a
ok, b
_, c
_) = a -> XParser a
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ok

versioninfo :: XParser VersionInfo
versioninfo :: XParser 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 -> 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
TokQuote) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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) XParser String
freetext

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

-- | Return a DOCTYPE decl, indicating a DTD.
doctypedecl :: XParser DocTypeDecl
doctypedecl :: XParser DocTypeDecl
doctypedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
DOCTYPEx)
    XParser DocTypeDecl -> XParser DocTypeDecl
forall a. XParser a -> XParser a
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 a. XParser a -> XParser a
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 -> Parser SymTabs (Posn, TokenT) a
failP String
"missing > in DOCTYPE decl"
      DocTypeDecl -> XParser DocTypeDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD QName
n Maybe ExternalID
eid ([MarkupDecl] -> Maybe [MarkupDecl] -> [MarkupDecl]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [MarkupDecl]
es))

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

extsubset :: XParser ExtSubset
extsubset :: XParser ExtSubset
extsubset = do
    Maybe TextDecl
td <- XParser TextDecl -> XParser (Maybe TextDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser TextDecl
textdecl
    [ExtSubsetDecl]
ds <- Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) [ExtSubsetDecl]
forall a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextDecl -> [ExtSubsetDecl] -> ExtSubset
ExtSubset Maybe TextDecl
td [ExtSubsetDecl]
ds)

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

sddecl :: XParser SDDecl
sddecl :: XParser Bool
sddecl = do
    String -> XParser ()
word String
"standalone" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word String
"STANDALONE"
    XParser Bool -> XParser Bool
forall a. XParser a -> XParser a
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 -> Parser SymTabs (Posn, TokenT) 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 a. XParser a -> XParser a
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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 -> Parser SymTabs (Posn, TokenT) 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 a. XParser a -> XParser a
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Element Posn -> XParser (Element Posn)
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. XParser a -> XParser a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. XParser a -> XParser a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Attribute
attribute
    ElemTag -> XParser ElemTag
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. XParser a -> (String -> String) -> XParser a
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 -> Parser SymTabs (Posn, TokenT) 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 -> Parser SymTabs (Posn, TokenT) a
failBadP String
"missing attvalue"
    Attribute -> Parser SymTabs (Posn, TokenT) Attribute
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"element",   Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem (Element Posn -> Posn -> Content Posn)
-> XParser (Element Posn) -> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser (Element Posn)
element )
                       , (String
"chardata",  Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
False (String -> Posn -> Content Posn)
-> XParser String -> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
chardata )
                       , (String
"reference", Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef (Reference -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) Reference
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Reference
reference)
                       , (String
"CDATA",     Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
True (String -> Posn -> Content Posn)
-> XParser String -> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
cdsect )
                       , (String
"misc",      Misc -> Posn -> Content Posn
forall i. Misc -> i -> Content i
CMisc (Misc -> Posn -> Content Posn)
-> Parser SymTabs (Posn, TokenT) Misc
-> XParser (Posn -> Content Posn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Misc
misc )
                       ]
                  XParser (Posn -> Content Posn)
-> (String -> String) -> XParser (Posn -> Content Posn)
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (String
"when looking for a content item,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
-- (\    (element, text, reference, CDATA section, <!--comment-->, or <?PI?>")

elementdecl :: XParser ElementDecl
elementdecl :: Parser SymTabs (Posn, TokenT) ElementDecl
elementdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ELEMENTx)
    QName
n <- XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"expecting identifier in ELEMENT decl\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    ContentSpec
c <- XParser ContentSpec -> XParser ContentSpec
forall a. XParser a -> XParser a
peRef XParser ContentSpec
contentspec
             XParser ContentSpec -> (String -> String) -> XParser ContentSpec
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"in content spec of ELEMENT decl: "
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> Parser SymTabs (Posn, TokenT) a
failBadP
       (String
"expected > terminating ELEMENT decl"
       String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n    element name was "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show (QName -> String
printableName QName
n)
       String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n    contentspec was "String -> String -> String
forall a. [a] -> [a] -> [a]
++(\ (ContentSpec CP
p)-> CP -> String
debugShowCP CP
p) ContentSpec
c)
    ElementDecl -> Parser SymTabs (Posn, TokenT) ElementDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
ANY)
           , (String
"mixed",  Mixed -> ContentSpec
Mixed (Mixed -> ContentSpec)
-> Parser SymTabs (Posn, TokenT) Mixed -> XParser ContentSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Mixed
-> Parser SymTabs (Posn, TokenT) Mixed
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) Mixed
mixed)
           , (String
"simple", CP -> ContentSpec
ContentSpec (CP -> ContentSpec)
-> Parser SymTabs (Posn, TokenT) CP -> XParser ContentSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) CP
-> Parser SymTabs (Posn, TokenT) CP
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) CP
cp)
           ]
 --   `adjustErr` ("when looking for content spec,\n"++)
 --   `adjustErr` (++"\nLooking for content spec (EMPTY, ANY, mixed, etc)")

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

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

cp :: XParser CP
cp :: Parser SymTabs (Posn, TokenT) CP
cp = [Parser SymTabs (Posn, TokenT) CP]
-> Parser SymTabs (Posn, TokenT) CP
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ do QName
n <- XParser QName
qname
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = QName -> Modifier -> CP
TagName QName
n Modifier
m
                CP -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: name "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           , do [CP]
ss <- XParser [CP]
sequence
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = [CP] -> Modifier -> CP
Seq [CP]
ss Modifier
m
                CP -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: sequence "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           , do [CP]
cs <- XParser [CP]
choice
                Modifier
m <- XParser Modifier
modifier
                let c :: CP
c = [CP] -> Modifier -> CP
Choice [CP]
cs Modifier
m
                CP -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c Parser SymTabs (Posn, TokenT) CP
-> String -> Parser SymTabs (Posn, TokenT) CP
forall a. a -> String -> a
`debug` (String
"ContentSpec: choice "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c)
           ] Parser SymTabs (Posn, TokenT) CP
-> (String -> String) -> Parser SymTabs (Posn, TokenT) CP
forall a. 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]
++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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Star
                 , TokenT -> XParser TokenT
tok TokenT
TokQuery XParser TokenT -> XParser Modifier -> XParser Modifier
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Query
                 , TokenT -> XParser TokenT
tok TokenT
TokPlus XParser TokenT -> XParser Modifier -> XParser Modifier
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Plus
                 , Modifier -> XParser Modifier
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
None
                 ]

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

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

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

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

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

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

notationtype :: XParser NotationType
notationtype :: Parser SymTabs (Posn, TokenT) [String]
notationtype = do
    String -> XParser ()
word String
"NOTATION"
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) [String]
-> Parser SymTabs (Posn, TokenT) [String]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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)
            (XParser String -> XParser String
forall a. XParser a -> XParser a
peRef XParser String
name XParser String
-> XParser TokenT -> Parser SymTabs (Posn, TokenT) [String]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe))

enumeration :: XParser Enumeration
enumeration :: Parser SymTabs (Posn, TokenT) [String]
enumeration =
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) [String]
-> Parser SymTabs (Posn, TokenT) [String]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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)
            (XParser String -> XParser String
forall a. XParser a -> XParser a
peRef XParser String
nmtoken XParser String
-> XParser TokenT -> Parser SymTabs (Posn, TokenT) [String]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe)))

defaultdecl :: XParser DefaultDecl
defaultdecl :: XParser DefaultDecl
defaultdecl =
    [(String, XParser DefaultDecl)] -> XParser DefaultDecl
forall a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"REQUIRED",  TokenT -> XParser TokenT
tok TokenT
TokHash XParser TokenT -> XParser () -> XParser ()
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"REQUIRED" XParser () -> XParser DefaultDecl -> XParser DefaultDecl
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultDecl -> XParser DefaultDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultDecl
REQUIRED)
           , (String
"IMPLIED",   TokenT -> XParser TokenT
tok TokenT
TokHash XParser TokenT -> XParser () -> XParser ()
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"IMPLIED" XParser () -> XParser DefaultDecl -> XParser DefaultDecl
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultDecl -> XParser DefaultDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word String
"FIXED"
                                                      XParser () -> XParser FIXED -> XParser FIXED
forall a b.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) b
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FIXED -> XParser FIXED
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. XParser a -> (String -> String) -> XParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"looking for an attribute default decl,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)

conditionalsect :: XParser ConditionalSect
conditionalsect :: Parser SymTabs (Posn, TokenT) ConditionalSect
conditionalsect = [(String, Parser SymTabs (Posn, TokenT) ConditionalSect)]
-> Parser SymTabs (Posn, TokenT) ConditionalSect
forall a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
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 -> Parser SymTabs (Posn, TokenT) a
failBadP String
"missing [ after INCLUDE"
           [ExtSubsetDecl]
i <- Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) [ExtSubsetDecl]
forall a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 -> Parser SymTabs (Posn, TokenT) a
failBadP (String
"missing ]]> for INCLUDE section"
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n    begun at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
           ConditionalSect -> Parser SymTabs (Posn, TokenT) ConditionalSect
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 -> Parser SymTabs (Posn, TokenT) a
failBadP String
"missing [ after IGNORE"
           Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) [Ignore]
forall a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 -> Parser SymTabs (Posn, TokenT) a
failBadP (String
"missing ]]> for IGNORE section"
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n    begun at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
           ConditionalSect -> Parser SymTabs (Posn, TokenT) ConditionalSect
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreSect -> ConditionalSect
IgnoreSect []))
    ] Parser SymTabs (Posn, TokenT) ConditionalSect
-> (String -> String)
-> Parser SymTabs (Posn, TokenT) ConditionalSect
forall a. XParser a -> (String -> String) -> XParser a
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 a. a -> Parser SymTabs (Posn, TokenT) a
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 a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore  Parser SymTabs (Posn, TokenT) Ignore
-> String -> Parser SymTabs (Posn, TokenT) Ignore
forall a. a -> String -> a
`debug` (String
"ignoring: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t))

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

-- | Return either a general entity reference, or a character reference.
reference :: XParser Reference
reference :: Parser SymTabs (Posn, TokenT) Reference
reference = do
    XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) Reference
-> Parser SymTabs (Posn, TokenT) Reference
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokAmp) (TokenT -> XParser TokenT
tok TokenT
TokSemi) (XParser String
freetext XParser String
-> (String -> Parser SymTabs (Posn, TokenT) Reference)
-> Parser SymTabs (Posn, TokenT) Reference
forall a b.
Parser SymTabs (Posn, TokenT) a
-> (a -> Parser SymTabs (Posn, TokenT) b)
-> Parser SymTabs (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser SymTabs (Posn, TokenT) Reference
forall {m :: * -> *}. Monad m => String -> m Reference
val)
  where
    val :: String -> m Reference
val (Char
'#':Char
'x':String
i) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit String
i
                    = Reference -> m Reference
forall a. a -> m a
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. HasCallStack => [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 a. a -> m a
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. HasCallStack => [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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Reference
RefEntity (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
name

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

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

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

pereference :: XParser PEReference
pereference :: XParser String
pereference = do
    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
TokPercent) (TokenT -> XParser TokenT
tok TokenT
TokSemi) XParser String
nmtoken

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

gedecl :: XParser GEDecl
gedecl :: Parser SymTabs (Posn, TokenT) GEDecl
gedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    String
n <- XParser 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 -> Parser SymTabs (Posn, TokenT) a
failBadP (String
"expected > terminating G ENTITY decl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
    (SymTabs -> SymTabs) -> XParser ()
forall s t. (s -> s) -> Parser s t ()
stUpdate (String -> EntityDef -> SymTabs -> SymTabs
addGE String
n EntityDef
e) XParser () -> String -> XParser ()
forall a. a -> String -> a
`debug` (String
"added GE defn &"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
";")
    GEDecl -> Parser SymTabs (Posn, TokenT) GEDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EntityDef -> GEDecl
GEDecl String
n EntityDef
e)

pedecl :: XParser PEDecl
pedecl :: Parser SymTabs (Posn, TokenT) PEDecl
pedecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
    TokenT -> XParser TokenT
tok TokenT
TokPercent
    String
n <- XParser 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 -> Parser SymTabs (Posn, TokenT) a
failBadP (String
"expected > terminating P ENTITY decl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
    (SymTabs -> SymTabs) -> XParser ()
forall s t. (s -> s) -> Parser s t ()
stUpdate (String -> PEDef -> SymTabs -> SymTabs
addPE String
n PEDef
e) XParser () -> String -> XParser ()
forall a. a -> String -> a
`debug` (String
"added PE defn %"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
";\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++PEDef -> String
forall a. Show a => a -> String
show PEDef
e)
    PEDecl -> Parser SymTabs (Posn, TokenT) PEDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"entityvalue", EntityValue -> EntityDef
DefEntityValue (EntityValue -> EntityDef)
-> Parser SymTabs (Posn, TokenT) EntityValue -> XParser EntityDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) EntityValue
entityvalue)
           , (String
"external",    do ExternalID
eid <- XParser ExternalID
externalid
                                Maybe NDataDecl
ndd <- XParser NDataDecl -> XParser (Maybe NDataDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser NDataDecl
ndatadecl
                                EntityDef -> XParser EntityDef
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"entityvalue", EntityValue -> PEDef
PEDefEntityValue (EntityValue -> PEDef)
-> Parser SymTabs (Posn, TokenT) EntityValue -> XParser PEDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) EntityValue
entityvalue)
           , (String
"externalid",  ExternalID -> PEDef
PEDefExternalID (ExternalID -> PEDef) -> XParser ExternalID -> XParser PEDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser ExternalID
externalid )
           ]

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

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

textdecl :: XParser TextDecl
textdecl :: XParser TextDecl
textdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokPIOpen
    String -> XParser ()
word String
"xml" 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 <- XParser String -> XParser (Maybe String)
forall a. XParser a -> XParser (Maybe a)
maybe XParser 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 -> Parser SymTabs (Posn, TokenT) a
failP String
"expected ?> terminating text decl"
    TextDecl -> XParser TextDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 -> Parser SymTabs (Posn, TokenT) a
failBadP String
"expected = in 'encoding' decl"
    String
f <- 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
TokQuote) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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) XParser String
freetext
    EncodingDecl -> XParser EncodingDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EncodingDecl
EncodingDecl String
f)

notationdecl :: XParser NotationDecl
notationdecl :: Parser SymTabs (Posn, TokenT) NotationDecl
notationdecl = do
    TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
    TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
NOTATIONx)
    String
n <- XParser 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 -> Parser SymTabs (Posn, TokenT) a
failBadP (String
"expected > terminating NOTATION decl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
    NotationDecl -> Parser SymTabs (Posn, TokenT) NotationDecl
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either ExternalID PublicID -> NotationDecl
NOTATION String
n Either ExternalID PublicID
e)

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

entityvalue :: XParser EntityValue
entityvalue :: Parser SymTabs (Posn, TokenT) EntityValue
entityvalue = do
 -- evs <- bracket (tok TokQuote) (commit $ tok TokQuote) (many (peRef ev))
    TokenT -> XParser TokenT
tok TokenT
TokQuote
    Posn
pn <- XParser Posn
posn
    [EV]
evs <- Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 -> Parser SymTabs (Posn, TokenT) a
failBadP String
"expected quote to terminate entityvalue"
    -- quoted text must be rescanned for possible PERefs
    SymTabs
st <- Parser SymTabs (Posn, TokenT) SymTabs
forall s t. Parser s t s
stGet
    (String -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ([EV] -> Parser SymTabs (Posn, TokenT) EntityValue)
-> Either String [EV]
-> Parser SymTabs (Posn, TokenT) EntityValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> Parser SymTabs (Posn, TokenT) EntityValue
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityValue -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ([EV] -> EntityValue)
-> [EV]
-> Parser SymTabs (Posn, TokenT) EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue) (Either String [EV] -> Parser SymTabs (Posn, TokenT) EntityValue)
-> ((Either String [EV], SymTabs, [(Posn, TokenT)])
    -> Either String [EV])
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Either String [EV]
forall a b c. (a, b, c) -> a
fst3 ((Either String [EV], SymTabs, [(Posn, TokenT)])
 -> Parser SymTabs (Posn, TokenT) EntityValue)
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Parser SymTabs (Posn, TokenT) EntityValue
forall a b. (a -> b) -> a -> b
$
                Parser SymTabs (Posn, TokenT) [EV]
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser (Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
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 a.
[(String, Parser SymTabs (Posn, TokenT) a)]
-> Parser SymTabs (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"string",    String -> EV
EVString (String -> EV)
-> XParser String -> Parser SymTabs (Posn, TokenT) EV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParser String
stringXParser String -> XParser String -> XParser String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`XParser String
freetext))
           , (String
"reference", Reference -> EV
EVRef (Reference -> EV)
-> Parser SymTabs (Posn, TokenT) Reference
-> Parser SymTabs (Posn, TokenT) EV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SymTabs (Posn, TokenT) Reference
reference)
           ]
      Parser SymTabs (Posn, TokenT) EV
-> (String -> String) -> Parser SymTabs (Posn, TokenT) EV
forall a. XParser a -> (String -> String) -> XParser a
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 a. XParser a -> XParser a
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 a.
Parser SymTabs (Posn, TokenT) a
-> Parser SymTabs (Posn, TokenT) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (XParser String
-> Parser SymTabs (Posn, TokenT) Reference
-> Parser SymTabs (Posn, TokenT) (Either String Reference)
forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser String
freetext Parser SymTabs (Posn, TokenT) Reference
reference))
    AttValue -> XParser AttValue
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [Either String Reference]
avs)

systemliteral :: XParser SystemLiteral
systemliteral :: Parser SymTabs (Posn, TokenT) SystemLiteral
systemliteral = do
    String
s <- XParser TokenT
-> XParser TokenT -> 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
TokQuote) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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) XParser String
freetext
    SystemLiteral -> Parser SymTabs (Posn, TokenT) SystemLiteral
forall a. a -> Parser SymTabs (Posn, TokenT) a
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 -> 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
TokQuote) (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
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) XParser String
freetext
    PubidLiteral -> XParser PubidLiteral
forall a. a -> Parser SymTabs (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PubidLiteral
PubidLiteral String
s)             -- note: freetext is too liberal here

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