{-# OPTIONS -cpp #-}
module Text.XML.HaXml.Parse
(
xmlParse, xmlParse'
, dtdParse, dtdParse'
, xmlParseWith
, document, element, content
, comment, cdsect, chardata
, reference, doctypedecl
, processinginstruction
, elemtag, qname, name, tok
, elemOpenTag, elemCloseTag
, emptySTs, XParser
, fst3, snd3, thd3
) where
import Prelude hiding (either,maybe,sequence)
import qualified Prelude (either)
import Data.Maybe hiding (maybe)
import Data.List (intersperse)
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
#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
v :: a
v debug :: a -> String -> a
`debug` s :: String
s = a
v
#endif
debug :: a -> String -> a
xmlParse :: String -> String -> Document Posn
xmlParse' :: String -> String -> Either String (Document Posn)
dtdParse :: String -> String -> Maybe DocTypeDecl
dtdParse' :: String -> String -> Either String (Maybe DocTypeDecl)
xmlParse :: String -> String -> Document Posn
xmlParse name :: 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 name :: 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' name :: 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' name :: String
name = (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
-> Either String (Maybe DocTypeDecl)
forall a b c. (a, b, c) -> a
fst3 ((Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
-> Either String (Maybe DocTypeDecl))
-> (String
-> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)]))
-> String
-> Either String (Maybe DocTypeDecl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
justDTD SymTabs
emptySTs ([(Posn, TokenT)]
-> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either String (Maybe DocTypeDecl), SymTabs, [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Posn, TokenT)]
xmlLex String
name
toEOF :: XParser a -> XParser a
toEOF :: XParser a -> XParser a
toEOF = XParser a -> XParser a
forall a. a -> a
id
xmlParseWith :: XParser a -> [(Posn,TokenT)]
-> (Either String a, [(Posn,TokenT)])
xmlParseWith :: XParser a
-> [(Posn, TokenT)] -> (Either String a, [(Posn, TokenT)])
xmlParseWith p :: XParser a
p = (\(v :: Either String a
v,_,s :: [(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
type SymTabs = (SymTab PEDef, SymTab EntityDef)
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 n :: String
n v :: PEDef
v (pe :: SymTab PEDef
pe,ge :: 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 n :: String
n v :: EntityDef
v (pe :: SymTab PEDef
pe,ge :: 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 s :: String
s (pe :: SymTab PEDef
pe,_ge :: 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 evs :: [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 s :: String
s) = String
s
flatten (EVRef (RefEntity r :: String
r)) = "&" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
rString -> String -> String
forall a. [a] -> [a] -> [a]
++";"
flatten (EVRef (RefChar r :: CharRef
r)) = "&#"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]
++";"
fst3 :: (a,b,c) -> a
snd3 :: (a,b,c) -> b
thd3 :: (a,b,c) -> c
fst3 :: (a, b, c) -> a
fst3 (a :: a
a,_,_) = a
a
snd3 :: (a, b, c) -> b
snd3 (_,a :: b
a,_) = b
a
thd3 :: (a, b, c) -> c
thd3 (_,_,a :: c
a) = c
a
type XParser a = Parser SymTabs (Posn,TokenT) a
tok :: TokenT -> XParser TokenT
tok :: TokenT -> XParser TokenT
tok t :: TokenT
t = do (p :: Posn
p,t' :: TokenT
t') <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
case TokenT
t' of TokError _ -> (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
t'TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
==TokenT
t -> TokenT -> XParser TokenT
forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t
| Bool
otherwise -> (String -> XParser TokenT)
-> String -> Posn -> TokenT -> XParser TokenT
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser TokenT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (TokenT -> String
forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t'
nottok :: [TokenT] -> XParser TokenT
nottok :: [TokenT] -> XParser TokenT
nottok ts :: [TokenT]
ts = do (p :: Posn
p,t :: TokenT
t) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
if TokenT
tTokenT -> [TokenT] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[TokenT]
ts then (String -> XParser TokenT)
-> String -> Posn -> TokenT -> XParser TokenT
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser TokenT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("no "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t
else TokenT -> XParser TokenT
forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t
qname :: XParser QName
qname :: XParser QName
qname = (String -> QName)
-> Parser SymTabs (Posn, TokenT) String -> XParser QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QName
N Parser SymTabs (Posn, TokenT) String
name
name :: XParser Name
name :: Parser SymTabs (Posn, TokenT) String
name = do (p :: Posn
p,tok :: TokenT
tok) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
case TokenT
tok of
TokName s :: String
s -> String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
TokError _ -> (String -> Parser SymTabs (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser SymTabs (Posn, TokenT) String
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad "a name" Posn
p TokenT
tok
_ -> (String -> Parser SymTabs (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser SymTabs (Posn, TokenT) String
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "a name" Posn
p TokenT
tok
string, freetext :: XParser String
string :: Parser SymTabs (Posn, TokenT) String
string = do (p :: Posn
p,t :: TokenT
t) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
case TokenT
t of TokName s :: String
s -> String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
_ -> (String -> Parser SymTabs (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser SymTabs (Posn, TokenT) String
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "text" Posn
p TokenT
t
freetext :: Parser SymTabs (Posn, TokenT) String
freetext = do (p :: Posn
p,t :: TokenT
t) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
case TokenT
t of TokFreeText s :: String
s -> String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
_ -> (String -> Parser SymTabs (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser SymTabs (Posn, TokenT) String
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> Parser SymTabs (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "text" Posn
p TokenT
t
maybe :: XParser a -> XParser (Maybe a)
maybe :: XParser a -> XParser (Maybe a)
maybe p :: XParser a
p =
( XParser a
p XParser a -> (a -> XParser (Maybe a)) -> XParser (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> XParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> XParser (Maybe a))
-> (a -> Maybe a) -> a -> XParser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) XParser (Maybe a) -> XParser (Maybe a) -> XParser (Maybe a)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
( Maybe a -> XParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
either :: XParser a -> XParser b -> XParser (Either a b)
either :: XParser a -> XParser b -> XParser (Either a b)
either p :: XParser a
p q :: XParser b
q =
( XParser a
p XParser a -> (a -> XParser (Either a b)) -> XParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> XParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> XParser (Either a b))
-> (a -> Either a b) -> a -> XParser (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) XParser (Either a b)
-> XParser (Either a b) -> XParser (Either a b)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
( XParser b
q XParser b -> (b -> XParser (Either a b)) -> XParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> XParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> XParser (Either a b))
-> (b -> Either a b) -> b -> XParser (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)
word :: String -> XParser ()
word :: String -> XParser ()
word s :: 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
(_p :: Posn
_p,TokName n :: String
n) | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(_p :: Posn
_p,TokFreeText n :: String
n) | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
( p :: Posn
p,t :: TokenT
t@(TokError _)) -> (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
( p :: Posn
p,t :: TokenT
t) -> (String -> XParser ()) -> String -> Posn -> TokenT -> XParser ()
forall a.
(String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report String -> XParser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String
forall a. Show a => a -> String
show String
s) Posn
p TokenT
t
}
posn :: XParser Posn
posn :: XParser Posn
posn = do { x :: (Posn, TokenT)
x@(p :: Posn
p,_) <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
; [(Posn, TokenT)] -> XParser ()
forall t s. [t] -> Parser s t ()
reparse [(Posn, TokenT)
x]
; Posn -> XParser Posn
forall (m :: * -> *) a. Monad m => a -> m a
return Posn
p
}
nmtoken :: XParser NmToken
nmtoken :: Parser SymTabs (Posn, TokenT) String
nmtoken = (Parser SymTabs (Posn, TokenT) String
string Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` Parser SymTabs (Posn, TokenT) String
freetext)
failP, failBadP :: String -> XParser a
failP :: String -> XParser a
failP msg :: String
msg = do { Posn
p <- XParser Posn
posn; String -> XParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
msgString -> String -> String
forall a. [a] -> [a] -> [a]
++"\n at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p) }
failBadP :: String -> XParser a
failBadP msg :: 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]
++"\n at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p) }
report :: (String->XParser a) -> String -> Posn -> TokenT -> XParser a
report :: (String -> XParser a) -> String -> Posn -> TokenT -> XParser a
report fail :: String -> XParser a
fail expect :: String
expect p :: Posn
p t :: TokenT
t = String -> XParser a
fail ("Expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
expectString -> String -> String
forall a. [a] -> [a] -> [a]
++" 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]
++"\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
p :: XParser a
p adjustErrP :: XParser a -> (String -> String) -> XParser a
`adjustErrP` f :: String -> String
f = XParser a
p XParser a -> XParser a -> XParser a
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` do Posn
pn <- XParser Posn
posn
(XParser a
p XParser a -> (String -> String) -> XParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` String -> String
f) XParser a -> (String -> String) -> XParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
pn)
peRef :: XParser a -> XParser a
peRef :: XParser a -> XParser a
peRef p :: XParser a
p =
XParser a
p XParser a -> XParser a -> XParser a
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
do Posn
pn <- XParser Posn
posn
String
n <- Parser SymTabs (Posn, TokenT) String
pereference
Maybe PEDef
tr <- (SymTabs -> Maybe PEDef)
-> Parser SymTabs (Posn, TokenT) (Maybe PEDef)
forall s a t. (s -> a) -> Parser s t a
stQuery (String -> SymTabs -> Maybe PEDef
lookupPE String
n) Parser SymTabs (Posn, TokenT) (Maybe PEDef)
-> String -> Parser SymTabs (Posn, TokenT) (Maybe PEDef)
forall a. a -> String -> a
`debug` ("Looking up %"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
case Maybe PEDef
tr of
Just (PEDefEntityValue ev :: EntityValue
ev) ->
do [(Posn, TokenT)] -> XParser ()
forall t s. [t] -> Parser s t ()
reparse (Posn -> String -> [(Posn, TokenT)]
xmlReLex (String -> Maybe Posn -> Posn
posInNewCxt ("macro %"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";")
(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` (" 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 _ (SystemLiteral f :: 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` (" 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 f :: 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` (" 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
Nothing -> String -> XParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("PEReference use before definition: "String -> String -> String
forall a. [a] -> [a] -> [a]
++"%"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";"
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\n at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
pn)
blank :: XParser a -> XParser a
blank :: XParser a -> XParser a
blank p :: XParser a
p =
XParser a
p XParser a -> XParser a -> XParser a
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
do String
n <- Parser SymTabs (Posn, TokenT) String
pereference
Maybe PEDef
tr <- (SymTabs -> Maybe PEDef)
-> Parser SymTabs (Posn, TokenT) (Maybe PEDef)
forall s a t. (s -> a) -> Parser s t a
stQuery (String -> SymTabs -> Maybe PEDef
lookupPE String
n) Parser SymTabs (Posn, TokenT) (Maybe PEDef)
-> String -> Parser SymTabs (Posn, TokenT) (Maybe PEDef)
forall a. a -> String -> a
`debug` ("Looking up %"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++" (is blank?)")
case Maybe PEDef
tr of
Just (PEDefEntityValue ev :: 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` "Empty macro definition"
Just _ -> String -> XParser a
forall a. String -> XParser a
failP ("expected a blank PERef macro: "String -> String -> String
forall a. [a] -> [a] -> [a]
++"%"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";")
Nothing -> String -> XParser a
forall a. String -> XParser a
failP ("PEReference use before definition: "String -> String -> String
forall a. [a] -> [a] -> [a]
++"%"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";")
justDTD :: XParser (Maybe DocTypeDecl)
justDTD :: Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
justDTD =
do (ExtSubset _ ds :: [ExtSubsetDecl]
ds) <- XParser ExtSubset
extsubset XParser ExtSubset -> String -> XParser ExtSubset
forall a. a -> String -> a
`debug` "Trying external subset"
if [ExtSubsetDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtSubsetDecl]
ds then String -> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "empty"
else Maybe DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocTypeDecl -> Maybe DocTypeDecl
forall a. a -> Maybe a
Just (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD (String -> QName
N "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 _ _ dtd :: Maybe DocTypeDecl
dtd _) <- XParser Prolog
prolog
Maybe DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DocTypeDecl
dtd
where extract :: ExtSubsetDecl -> [MarkupDecl]
extract (ExtMarkupDecl m :: MarkupDecl
m) = [MarkupDecl
m]
extract (ExtConditionalSect (IncludeSect i :: [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 _i :: IgnoreSect
_i)) = []
document :: XParser (Document Posn)
document :: Parser SymTabs (Posn, TokenT) (Document Posn)
document = do
Prolog
p <- XParser Prolog
prolog XParser Prolog -> (String -> String) -> XParser Prolog
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("unrecognisable XML prolog\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
Element Posn
e <- XParser (Element Posn)
element
[Misc]
ms <- Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
(_,ge :: SymTab EntityDef
ge) <- Parser SymTabs (Posn, TokenT) SymTabs
forall s t. Parser s t s
stGet
Document Posn -> Parser SymTabs (Posn, TokenT) (Document Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document Prolog
p SymTab EntityDef
ge Element Posn
e [Misc]
ms)
comment :: XParser Comment
= do
XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokCommentOpen) (TokenT -> XParser TokenT
tok TokenT
TokCommentClose) Parser SymTabs (Posn, TokenT) String
freetext
processinginstruction :: XParser ProcessingInstruction
processinginstruction :: XParser ProcessingInstruction
processinginstruction = do
TokenT -> XParser TokenT
tok TokenT
TokPIOpen
XParser ProcessingInstruction -> XParser ProcessingInstruction
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser ProcessingInstruction -> XParser ProcessingInstruction)
-> XParser ProcessingInstruction -> XParser ProcessingInstruction
forall a b. (a -> b) -> a -> b
$ do
String
n <- Parser SymTabs (Posn, TokenT) String
string Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> Parser SymTabs (Posn, TokenT) String
forall a. String -> XParser a
failP "processing instruction has no target"
String
f <- Parser SymTabs (Posn, TokenT) String
freetext
TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP ("missing ?> in <?"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
ProcessingInstruction -> XParser ProcessingInstruction
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, String
f)
cdsect :: XParser CDSect
cdsect :: Parser SymTabs (Posn, TokenT) String
cdsect = do
TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
CDATAx)) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSectionClose) Parser SymTabs (Posn, TokenT) String
chardata
prolog :: XParser Prolog
prolog :: XParser Prolog
prolog = do
Maybe XMLDecl
x <- XParser XMLDecl -> XParser (Maybe XMLDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser XMLDecl
xmldecl
[Misc]
m1 <- Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
Maybe DocTypeDecl
dtd <- XParser DocTypeDecl
-> Parser SymTabs (Posn, TokenT) (Maybe DocTypeDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser DocTypeDecl
doctypedecl
[Misc]
m2 <- Parser SymTabs (Posn, TokenT) Misc
-> Parser SymTabs (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Misc
misc
Prolog -> XParser Prolog
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
Prolog Maybe XMLDecl
x [Misc]
m1 Maybe DocTypeDecl
dtd [Misc]
m2)
xmldecl :: XParser XMLDecl
xmldecl :: XParser XMLDecl
xmldecl = do
TokenT -> XParser TokenT
tok TokenT
TokPIOpen
(String -> XParser ()
word "xml" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word "XML")
Posn
p <- XParser Posn
posn
String
s <- Parser SymTabs (Posn, TokenT) String
freetext
TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "missing ?> in <?xml ...?>"
(Either String XMLDecl, SymTabs, [(Posn, TokenT)])
-> XParser XMLDecl
forall a b c. (Either String a, b, c) -> XParser a
raise ((XParser XMLDecl
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String XMLDecl, SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser XParser XMLDecl
aux SymTabs
emptySTs ([(Posn, TokenT)]
-> (Either String XMLDecl, SymTabs, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either String XMLDecl, SymTabs, [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> String -> [(Posn, TokenT)]
xmlReLex Posn
p) String
s)
where
aux :: XParser XMLDecl
aux = do
String
v <- Parser SymTabs (Posn, TokenT) String
versioninfo Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> Parser SymTabs (Posn, TokenT) String
forall a. String -> XParser a
failP "missing XML version info"
Maybe EncodingDecl
e <- XParser EncodingDecl -> XParser (Maybe EncodingDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser EncodingDecl
encodingdecl
Maybe Bool
s <- XParser Bool -> XParser (Maybe Bool)
forall a. XParser a -> XParser (Maybe a)
maybe XParser Bool
sddecl
XMLDecl -> XParser XMLDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
XMLDecl String
v Maybe EncodingDecl
e Maybe Bool
s)
raise :: (Either String a, b, c) -> XParser a
raise (Left err :: String
err, _, _) = String -> XParser a
forall a. String -> XParser a
failP String
err
raise (Right ok :: a
ok, _, _) = a -> XParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ok
versioninfo :: XParser VersionInfo
versioninfo :: Parser SymTabs (Posn, TokenT) String
versioninfo = do
(String -> XParser ()
word "version" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word "VERSION")
TokenT -> XParser TokenT
tok TokenT
TokEqual
XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
misc :: XParser Misc
misc :: Parser SymTabs (Posn, TokenT) Misc
misc =
[(String, Parser SymTabs (Posn, TokenT) Misc)]
-> Parser SymTabs (Posn, TokenT) Misc
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("<!--comment-->", Parser SymTabs (Posn, TokenT) String
comment Parser SymTabs (Posn, TokenT) String
-> (String -> Parser SymTabs (Posn, TokenT) Misc)
-> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser SymTabs (Posn, TokenT) Misc)
-> (String -> Misc) -> String -> Parser SymTabs (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Misc
Comment)
, ("<?PI?>", XParser ProcessingInstruction
processinginstruction XParser ProcessingInstruction
-> (ProcessingInstruction -> Parser SymTabs (Posn, TokenT) Misc)
-> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser SymTabs (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser SymTabs (Posn, TokenT) Misc)
-> (ProcessingInstruction -> Misc)
-> ProcessingInstruction
-> Parser SymTabs (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessingInstruction -> Misc
PI)
]
doctypedecl :: XParser DocTypeDecl
doctypedecl :: XParser DocTypeDecl
doctypedecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
DOCTYPEx)
XParser DocTypeDecl -> XParser DocTypeDecl
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser DocTypeDecl -> XParser DocTypeDecl)
-> XParser DocTypeDecl -> XParser DocTypeDecl
forall a b. (a -> b) -> a -> b
$ do
QName
n <- XParser QName
qname
Maybe ExternalID
eid <- XParser ExternalID -> XParser (Maybe ExternalID)
forall a. XParser a -> XParser (Maybe a)
maybe XParser ExternalID
externalid
Maybe [MarkupDecl]
es <- XParser [MarkupDecl] -> XParser (Maybe [MarkupDecl])
forall a. XParser a -> XParser (Maybe a)
maybe (XParser TokenT
-> XParser TokenT -> XParser [MarkupDecl] -> XParser [MarkupDecl]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokSqOpen) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokSqClose)
(Parser SymTabs (Posn, TokenT) MarkupDecl -> XParser [MarkupDecl]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser SymTabs (Posn, TokenT) MarkupDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) MarkupDecl
markupdecl)))
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP "missing > in DOCTYPE decl"
DocTypeDecl -> XParser DocTypeDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD QName
n Maybe ExternalID
eid (case Maybe [MarkupDecl]
es of { Nothing -> []; Just e :: [MarkupDecl]
e -> [MarkupDecl]
e }))
markupdecl :: XParser MarkupDecl
markupdecl :: Parser SymTabs (Posn, TokenT) MarkupDecl
markupdecl =
[(String, Parser SymTabs (Posn, TokenT) MarkupDecl)]
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("ELEMENT", XParser ElementDecl
elementdecl XParser ElementDecl
-> (ElementDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (ElementDecl -> MarkupDecl)
-> ElementDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElementDecl -> MarkupDecl
Element)
, ("ATTLIST", XParser AttListDecl
attlistdecl XParser AttListDecl
-> (AttListDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (AttListDecl -> MarkupDecl)
-> AttListDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttListDecl -> MarkupDecl
AttList)
, ("ENTITY", XParser EntityDecl
entitydecl XParser EntityDecl
-> (EntityDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (EntityDecl -> MarkupDecl)
-> EntityDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDecl -> MarkupDecl
Entity)
, ("NOTATION", XParser NotationDecl
notationdecl XParser NotationDecl
-> (NotationDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (NotationDecl -> MarkupDecl)
-> NotationDecl
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotationDecl -> MarkupDecl
Notation)
, ("misc", Parser SymTabs (Posn, TokenT) Misc
misc Parser SymTabs (Posn, TokenT) Misc
-> (Misc -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (MarkupDecl -> Parser SymTabs (Posn, TokenT) MarkupDecl)
-> (Misc -> MarkupDecl)
-> Misc
-> Parser SymTabs (Posn, TokenT) MarkupDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Misc -> MarkupDecl
MarkupMisc)
]
Parser SymTabs (Posn, TokenT) MarkupDecl
-> (String -> String) -> Parser SymTabs (Posn, TokenT) MarkupDecl
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP`
("when looking for a markup decl,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
extsubset :: XParser ExtSubset
extsubset :: XParser ExtSubset
extsubset = do
Maybe TextDecl
td <- XParser TextDecl -> XParser (Maybe TextDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser TextDecl
textdecl
[ExtSubsetDecl]
ds <- Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) [ExtSubsetDecl]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) ExtSubsetDecl
extsubsetdecl)
ExtSubset -> XParser ExtSubset
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextDecl -> [ExtSubsetDecl] -> ExtSubset
ExtSubset Maybe TextDecl
td [ExtSubsetDecl]
ds)
extsubsetdecl :: XParser ExtSubsetDecl
extsubsetdecl :: Parser SymTabs (Posn, TokenT) ExtSubsetDecl
extsubsetdecl =
( Parser SymTabs (Posn, TokenT) MarkupDecl
markupdecl Parser SymTabs (Posn, TokenT) MarkupDecl
-> (MarkupDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> (MarkupDecl -> ExtSubsetDecl)
-> MarkupDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupDecl -> ExtSubsetDecl
ExtMarkupDecl) Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
( XParser ConditionalSect
conditionalsect XParser ConditionalSect
-> (ConditionalSect -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtSubsetDecl -> Parser SymTabs (Posn, TokenT) ExtSubsetDecl)
-> (ConditionalSect -> ExtSubsetDecl)
-> ConditionalSect
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalSect -> ExtSubsetDecl
ExtConditionalSect)
sddecl :: XParser SDDecl
sddecl :: XParser Bool
sddecl = do
(String -> XParser ()
word "standalone" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word "STANDALONE")
XParser Bool -> XParser Bool
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser Bool -> XParser Bool) -> XParser Bool -> XParser Bool
forall a b. (a -> b) -> a -> b
$ do
TokenT -> XParser TokenT
tok TokenT
TokEqual XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP "missing = in 'standalone' decl"
XParser TokenT -> XParser TokenT -> XParser Bool -> XParser Bool
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote)
( (String -> XParser ()
word "yes" XParser () -> XParser Bool -> XParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) XParser Bool -> XParser Bool -> XParser Bool
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
(String -> XParser ()
word "no" XParser () -> XParser Bool -> XParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) XParser Bool -> XParser Bool -> XParser Bool
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
String -> XParser Bool
forall a. String -> XParser a
failP "'standalone' decl requires 'yes' or 'no' value" )
element :: XParser (Element Posn)
element :: XParser (Element Posn)
element = do
TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
(ElemTag n :: QName
n as :: [Attribute]
as) <- XParser ElemTag
elemtag
( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
XParser (Element Posn) -> XParser (Element Posn)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Element Posn -> XParser (Element Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
as []))
XParser (Element Posn)
-> XParser (Element Posn) -> XParser (Element Posn)
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
do TokenT -> XParser TokenT
tok TokenT
TokAnyClose
XParser (Element Posn) -> XParser (Element Posn)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser (Element Posn) -> XParser (Element Posn))
-> XParser (Element Posn) -> XParser (Element Posn)
forall a b. (a -> b) -> a -> b
$ do
([Content Posn] -> Element Posn)
-> Parser SymTabs (Posn, TokenT) ([Content Posn] -> Element Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
as) Parser SymTabs (Posn, TokenT) ([Content Posn] -> Element Posn)
-> Parser SymTabs (Posn, TokenT) [Content Posn]
-> XParser (Element Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply`
Parser SymTabs (Posn, TokenT) (Content Posn)
-> XParser () -> Parser SymTabs (Posn, TokenT) [Content Posn]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
manyFinally Parser SymTabs (Posn, TokenT) (Content Posn)
content
(do Posn
p <- XParser Posn
posn
QName
m <- XParser TokenT -> XParser TokenT -> XParser QName -> XParser QName
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokEndOpen)
(XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser QName
qname
Posn -> QName -> QName -> XParser ()
checkmatch Posn
p QName
n QName
m)
) XParser (Element Posn)
-> (String -> String) -> XParser (Element Posn)
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (("in element tag "String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
checkmatch :: Posn -> QName -> QName -> XParser ()
checkmatch :: Posn -> QName -> QName -> XParser ()
checkmatch p :: Posn
p n :: QName
n m :: QName
m =
if QName
n QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
m then () -> XParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> XParser ()
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad ("tag <"String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++"> terminated by </"String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
m
String -> String -> String
forall a. [a] -> [a] -> [a]
++">\n at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
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` ("malformed element tag\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
[Attribute]
as <- Parser SymTabs (Posn, TokenT) Attribute
-> Parser SymTabs (Posn, TokenT) [Attribute]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Attribute
attribute
ElemTag -> XParser ElemTag
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> ElemTag
ElemTag QName
n [Attribute]
as)
elemOpenTag :: XParser ElemTag
elemOpenTag :: XParser ElemTag
elemOpenTag = do
TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
ElemTag
e <- XParser ElemTag
elemtag
TokenT -> XParser TokenT
tok TokenT
TokAnyClose
ElemTag -> XParser ElemTag
forall (m :: * -> *) a. Monad m => a -> m a
return ElemTag
e
elemCloseTag :: QName -> XParser ()
elemCloseTag :: QName -> XParser ()
elemCloseTag n :: QName
n = do
TokenT -> XParser TokenT
tok TokenT
TokEndOpen
Posn
p <- XParser Posn
posn
QName
m <- XParser QName
qname
TokenT -> XParser TokenT
tok TokenT
TokAnyClose
Posn -> QName -> QName -> XParser ()
checkmatch Posn
p QName
n QName
m
attribute :: XParser Attribute
attribute :: Parser SymTabs (Posn, TokenT) Attribute
attribute = do
QName
n <- XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("malformed attribute name\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
TokenT -> XParser TokenT
tok TokenT
TokEqual XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "missing = in attribute"
AttValue
v <- XParser AttValue
attvalue XParser AttValue -> XParser AttValue -> XParser AttValue
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser AttValue
forall a. String -> XParser a
failBadP "missing attvalue"
Attribute -> Parser SymTabs (Posn, TokenT) Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (QName
n,AttValue
v)
content :: XParser (Content Posn)
content :: Parser SymTabs (Posn, TokenT) (Content Posn)
content =
do { Posn
p <- XParser Posn
posn
; Posn -> Content Posn
c' <- XParser (Posn -> Content Posn)
content'
; Content Posn -> Parser SymTabs (Posn, TokenT) (Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Posn -> Content Posn
c' Posn
p)
}
where
content' :: XParser (Posn -> Content Posn)
content' = [(String, XParser (Posn -> Content Posn))]
-> XParser (Posn -> Content Posn)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("element", XParser (Element Posn)
element XParser (Element Posn)
-> (Element Posn -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Element Posn -> Posn -> Content Posn)
-> Element Posn
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem)
, ("chardata", Parser SymTabs (Posn, TokenT) String
chardata Parser SymTabs (Posn, TokenT) String
-> (String -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (String -> Posn -> Content Posn)
-> String
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
False)
, ("reference", XParser Reference
reference XParser Reference
-> (Reference -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Reference -> Posn -> Content Posn)
-> Reference
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef)
, ("CDATA", Parser SymTabs (Posn, TokenT) String
cdsect Parser SymTabs (Posn, TokenT) String
-> (String -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (String -> Posn -> Content Posn)
-> String
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
True)
, ("misc", Parser SymTabs (Posn, TokenT) Misc
misc Parser SymTabs (Posn, TokenT) Misc
-> (Misc -> XParser (Posn -> Content Posn))
-> XParser (Posn -> Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Posn -> Content Posn) -> XParser (Posn -> Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Posn -> Content Posn) -> XParser (Posn -> Content Posn))
-> (Misc -> Posn -> Content Posn)
-> Misc
-> XParser (Posn -> Content Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Misc -> Posn -> Content Posn
forall i. Misc -> i -> Content i
CMisc)
]
XParser (Posn -> Content Posn)
-> (String -> String) -> XParser (Posn -> Content Posn)
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` ("when looking for a content item,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
elementdecl :: XParser ElementDecl
elementdecl :: XParser ElementDecl
elementdecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ELEMENTx)
QName
n <- XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ("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` (("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]
++"\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP
("expected > terminating ELEMENT decl"
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\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]
++"\n contentspec was "String -> String -> String
forall a. [a] -> [a] -> [a]
++(\ (ContentSpec p :: CP
p)-> CP -> String
debugShowCP CP
p) ContentSpec
c)
ElementDecl -> XParser ElementDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> ContentSpec -> ElementDecl
ElementDecl QName
n ContentSpec
c)
contentspec :: XParser ContentSpec
contentspec :: XParser ContentSpec
contentspec =
[(String, XParser ContentSpec)] -> XParser ContentSpec
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("EMPTY", XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (String -> XParser ()
word "EMPTY") XParser () -> XParser ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
EMPTY)
, ("ANY", XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (String -> XParser ()
word "ANY") XParser () -> XParser ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return ContentSpec
ANY)
, ("mixed", XParser Mixed -> XParser Mixed
forall a. XParser a -> XParser a
peRef XParser Mixed
mixed XParser Mixed
-> (Mixed -> XParser ContentSpec) -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentSpec -> XParser ContentSpec)
-> (Mixed -> ContentSpec) -> Mixed -> XParser ContentSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mixed -> ContentSpec
Mixed)
, ("simple", XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser CP -> (CP -> XParser ContentSpec) -> XParser ContentSpec
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContentSpec -> XParser ContentSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentSpec -> XParser ContentSpec)
-> (CP -> ContentSpec) -> CP -> XParser ContentSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CP -> ContentSpec
ContentSpec)
]
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` "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` "Succeeded with choice"))
(XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser CP -> XParser TokenT -> XParser [CP]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokPipe))
sequence :: XParser [CP]
sequence :: XParser [CP]
sequence = do
XParser TokenT -> XParser TokenT -> XParser [CP] -> XParser [CP]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen XParser TokenT -> String -> XParser TokenT
forall a. a -> String -> a
`debug` "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` "Succeeded with sequence"))
(XParser CP -> XParser CP
forall a. XParser a -> XParser a
peRef XParser CP
cp XParser CP -> XParser TokenT -> XParser [CP]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokComma))
cp :: XParser CP
cp :: XParser CP
cp = [XParser CP] -> XParser CP
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ( do QName
n <- XParser QName
qname
Modifier
m <- XParser Modifier
modifier
let c :: CP
c = QName -> Modifier -> CP
TagName QName
n Modifier
m
CP -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser CP
forall a. a -> String -> a
`debug` ("ContentSpec: name "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c))
, ( do [CP]
ss <- XParser [CP]
sequence
Modifier
m <- XParser Modifier
modifier
let c :: CP
c = [CP] -> Modifier -> CP
Seq [CP]
ss Modifier
m
CP -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser CP
forall a. a -> String -> a
`debug` ("ContentSpec: sequence "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c))
, ( do [CP]
cs <- XParser [CP]
choice
Modifier
m <- XParser Modifier
modifier
let c :: CP
c = [CP] -> Modifier -> CP
Choice [CP]
cs Modifier
m
CP -> XParser CP
forall (m :: * -> *) a. Monad m => a -> m a
return CP
c XParser CP -> String -> XParser CP
forall a. a -> String -> a
`debug` ("ContentSpec: choice "String -> String -> String
forall a. [a] -> [a] -> [a]
++CP -> String
debugShowCP CP
c))
] XParser CP -> (String -> String) -> XParser CP
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++"\nwhen looking for a content particle")
modifier :: XParser Modifier
modifier :: XParser Modifier
modifier = [XParser Modifier] -> XParser Modifier
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ( TokenT -> XParser TokenT
tok TokenT
TokStar XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Star )
, ( TokenT -> XParser TokenT
tok TokenT
TokQuery XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Query )
, ( TokenT -> XParser TokenT
tok TokenT
TokPlus XParser TokenT -> XParser Modifier -> XParser Modifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Plus )
, ( Modifier -> XParser Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
None )
]
debugShowCP :: CP -> String
debugShowCP :: CP -> String
debugShowCP cp :: CP
cp = case CP
cp of
TagName n :: QName
n m :: Modifier
m -> QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
Choice cps :: [CP]
cps m :: Modifier
m -> '('Char -> String -> String
forall a. a -> [a] -> [a]
: [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "|" ((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
forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
Seq cps :: [CP]
cps m :: Modifier
m -> '('Char -> String -> String
forall a. a -> [a] -> [a]
: [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "," ((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
forall a. [a] -> [a] -> [a]
++Modifier -> String
debugShowModifier Modifier
m
debugShowModifier :: Modifier -> String
debugShowModifier :: Modifier -> String
debugShowModifier modifier :: Modifier
modifier = case Modifier
modifier of
None -> ""
Query -> "?"
Star -> "*"
Plus -> "+"
mixed :: XParser Mixed
mixed :: XParser Mixed
mixed = do
TokenT -> XParser TokenT
tok TokenT
TokBraOpen
XParser () -> XParser ()
forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokHash
String -> XParser ()
word "PCDATA")
XParser Mixed -> XParser Mixed
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser Mixed -> XParser Mixed) -> XParser Mixed -> XParser Mixed
forall a b. (a -> b) -> a -> b
$
[XParser Mixed] -> XParser Mixed
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ( do [QName]
cs <- XParser QName -> Parser SymTabs (Posn, TokenT) [QName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef (do TokenT -> XParser TokenT
tok TokenT
TokPipe
XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname))
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar)
Mixed -> XParser Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return ([QName] -> Mixed
PCDATAplus [QName]
cs))
, ( XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenT -> XParser TokenT
tok TokenT
TokStar) XParser TokenT -> XParser Mixed -> XParser Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> XParser Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA)
, ( XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokBraClose) XParser TokenT -> XParser Mixed -> XParser Mixed
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mixed -> XParser Mixed
forall (m :: * -> *) a. Monad m => a -> m a
return Mixed
PCDATA)
]
XParser Mixed -> (String -> String) -> XParser Mixed
forall a. XParser a -> (String -> String) -> XParser a
`adjustErrP` (String -> String -> String
forall a. [a] -> [a] -> [a]
++"\nLooking for mixed content spec (#PCDATA | ...)*\n")
attlistdecl :: XParser AttListDecl
attlistdecl :: XParser AttListDecl
attlistdecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ATTLISTx)
QName
n <- XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ("expecting identifier in ATTLIST\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
[AttDef]
ds <- XParser [AttDef] -> XParser [AttDef]
forall a. XParser a -> XParser a
peRef (Parser SymTabs (Posn, TokenT) AttDef -> XParser [AttDef]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (Parser SymTabs (Posn, TokenT) AttDef
-> Parser SymTabs (Posn, TokenT) AttDef
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) AttDef
attdef))
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (TokenT -> XParser TokenT
tok TokenT
TokAnyClose) XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "missing > terminating ATTLIST"
AttListDecl -> XParser AttListDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [AttDef] -> AttListDecl
AttListDecl QName
n [AttDef]
ds)
attdef :: XParser AttDef
attdef :: Parser SymTabs (Posn, TokenT) AttDef
attdef =
do QName
n <- XParser QName -> XParser QName
forall a. XParser a -> XParser a
peRef XParser QName
qname XParser QName -> (String -> String) -> XParser QName
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("expecting attribute name\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
AttType
t <- XParser AttType -> XParser AttType
forall a. XParser a -> XParser a
peRef XParser AttType
atttype XParser AttType -> (String -> String) -> XParser AttType
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (("within attlist defn: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
DefaultDecl
d <- XParser DefaultDecl -> XParser DefaultDecl
forall a. XParser a -> XParser a
peRef XParser DefaultDecl
defaultdecl XParser DefaultDecl -> (String -> String) -> XParser DefaultDecl
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (("in attlist defn: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++QName -> String
printableName QName
nString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
AttDef -> Parser SymTabs (Posn, TokenT) AttDef
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> AttType -> DefaultDecl -> AttDef
AttDef QName
n AttType
t DefaultDecl
d)
atttype :: XParser AttType
atttype :: XParser AttType
atttype =
[(String, XParser AttType)] -> XParser AttType
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("CDATA", String -> XParser ()
word "CDATA" XParser () -> XParser AttType -> XParser AttType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AttType -> XParser AttType
forall (m :: * -> *) a. Monad m => a -> m a
return AttType
StringType)
, ("tokenized", XParser TokenizedType
tokenizedtype XParser TokenizedType
-> (TokenizedType -> XParser AttType) -> XParser AttType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AttType -> XParser AttType
forall (m :: * -> *) a. Monad m => a -> m a
return (AttType -> XParser AttType)
-> (TokenizedType -> AttType) -> TokenizedType -> XParser AttType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenizedType -> AttType
TokenizedType)
, ("enumerated", XParser EnumeratedType
enumeratedtype XParser EnumeratedType
-> (EnumeratedType -> XParser AttType) -> XParser AttType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AttType -> XParser AttType
forall (m :: * -> *) a. Monad m => a -> m a
return (AttType -> XParser AttType)
-> (EnumeratedType -> AttType) -> EnumeratedType -> XParser AttType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumeratedType -> AttType
EnumeratedType)
]
XParser AttType -> (String -> String) -> XParser AttType
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("looking for ATTTYPE,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
tokenizedtype :: XParser TokenizedType
tokenizedtype :: XParser TokenizedType
tokenizedtype =
[XParser TokenizedType] -> XParser TokenizedType
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ( String -> XParser ()
word "ID" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ID)
, ( String -> XParser ()
word "IDREF" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREF)
, ( String -> XParser ()
word "IDREFS" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
IDREFS)
, ( String -> XParser ()
word "ENTITY" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITY)
, ( String -> XParser ()
word "ENTITIES" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
ENTITIES)
, ( String -> XParser ()
word "NMTOKEN" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKEN)
, ( String -> XParser ()
word "NMTOKENS" XParser () -> XParser TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TokenizedType -> XParser TokenizedType
forall (m :: * -> *) a. Monad m => a -> m a
return TokenizedType
NMTOKENS)
] XParser TokenizedType
-> XParser TokenizedType -> XParser TokenizedType
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
do { (Posn, TokenT)
t <- Parser SymTabs (Posn, TokenT) (Posn, TokenT)
forall s t. Parser s t t
next
; String -> XParser TokenizedType
forall a. String -> XParser a
failP ("Expected one of"
String -> String -> String
forall a. [a] -> [a] -> [a]
++" (ID, IDREF, IDREFS, ENTITY, ENTITIES, NMTOKEN, NMTOKENS)"
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\nbut got "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Posn, TokenT) -> String
forall a. Show a => a -> String
show (Posn, TokenT)
t)
}
enumeratedtype :: XParser EnumeratedType
enumeratedtype :: XParser EnumeratedType
enumeratedtype =
[(String, XParser EnumeratedType)] -> XParser EnumeratedType
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("NOTATION", XParser [String]
notationtype XParser [String]
-> ([String] -> XParser EnumeratedType) -> XParser EnumeratedType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumeratedType -> XParser EnumeratedType
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumeratedType -> XParser EnumeratedType)
-> ([String] -> EnumeratedType)
-> [String]
-> XParser EnumeratedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> EnumeratedType
NotationType)
, ("enumerated", XParser [String]
enumeration XParser [String]
-> ([String] -> XParser EnumeratedType) -> XParser EnumeratedType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumeratedType -> XParser EnumeratedType
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumeratedType -> XParser EnumeratedType)
-> ([String] -> EnumeratedType)
-> [String]
-> XParser EnumeratedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> EnumeratedType
Enumeration)
]
XParser EnumeratedType
-> (String -> String) -> XParser EnumeratedType
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("looking for an enumerated or NOTATION type,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
notationtype :: XParser NotationType
notationtype :: XParser [String]
notationtype = do
String -> XParser ()
word "NOTATION"
XParser TokenT
-> XParser TokenT -> XParser [String] -> XParser [String]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokBraClose)
(Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) String
name Parser SymTabs (Posn, TokenT) String
-> XParser TokenT -> XParser [String]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe))
enumeration :: XParser Enumeration
enumeration :: XParser [String]
enumeration =
XParser TokenT
-> XParser TokenT -> XParser [String] -> XParser [String]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokBraOpen) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokBraClose)
(Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) String
nmtoken Parser SymTabs (Posn, TokenT) String
-> XParser TokenT -> XParser [String]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
`sepBy1` XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
blank (XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok TokenT
TokPipe)))
defaultdecl :: XParser DefaultDecl
defaultdecl :: XParser DefaultDecl
defaultdecl =
[(String, XParser DefaultDecl)] -> XParser DefaultDecl
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("REQUIRED", TokenT -> XParser TokenT
tok TokenT
TokHash XParser TokenT -> XParser () -> XParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word "REQUIRED" XParser () -> XParser DefaultDecl -> XParser DefaultDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultDecl -> XParser DefaultDecl
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultDecl
REQUIRED)
, ("IMPLIED", TokenT -> XParser TokenT
tok TokenT
TokHash XParser TokenT -> XParser () -> XParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word "IMPLIED" XParser () -> XParser DefaultDecl -> XParser DefaultDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultDecl -> XParser DefaultDecl
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultDecl
IMPLIED)
, ("FIXED", do Maybe FIXED
f <- XParser FIXED -> XParser (Maybe FIXED)
forall a. XParser a -> XParser (Maybe a)
maybe (TokenT -> XParser TokenT
tok TokenT
TokHash XParser TokenT -> XParser () -> XParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> XParser ()
word "FIXED"
XParser () -> XParser FIXED -> XParser FIXED
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FIXED -> XParser FIXED
forall (m :: * -> *) a. Monad m => a -> m a
return FIXED
FIXED)
AttValue
a <- XParser AttValue -> XParser AttValue
forall a. XParser a -> XParser a
peRef XParser AttValue
attvalue
DefaultDecl -> XParser DefaultDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (AttValue -> Maybe FIXED -> DefaultDecl
DefaultTo AttValue
a Maybe FIXED
f) )
]
XParser DefaultDecl -> (String -> String) -> XParser DefaultDecl
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("looking for an attribute default decl,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
conditionalsect :: XParser ConditionalSect
conditionalsect :: XParser ConditionalSect
conditionalsect = [(String, XParser ConditionalSect)] -> XParser ConditionalSect
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf'
[ ( "INCLUDE"
, do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
INCLUDEx))
Posn
p <- XParser Posn
posn
TokenT -> XParser TokenT
tok TokenT
TokSqOpen XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "missing [ after INCLUDE"
[ExtSubsetDecl]
i <- Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) [ExtSubsetDecl]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser SymTabs (Posn, TokenT) ExtSubsetDecl
-> Parser SymTabs (Posn, TokenT) ExtSubsetDecl
forall a. XParser a -> XParser a
peRef Parser SymTabs (Posn, TokenT) ExtSubsetDecl
extsubsetdecl)
TokenT -> XParser TokenT
tok TokenT
TokSectionClose
XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP ("missing ]]> for INCLUDE section"
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\n begun at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
ConditionalSect -> XParser ConditionalSect
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtSubsetDecl] -> ConditionalSect
IncludeSect [ExtSubsetDecl]
i))
, ( "IGNORE"
, do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
XParser TokenT -> XParser TokenT
forall a. XParser a -> XParser a
peRef (TokenT -> XParser TokenT
tok (Section -> TokenT
TokSection Section
IGNOREx))
Posn
p <- XParser Posn
posn
TokenT -> XParser TokenT
tok TokenT
TokSqOpen XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "missing [ after IGNORE"
Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) [Ignore]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Ignore
newIgnore
TokenT -> XParser TokenT
tok TokenT
TokSectionClose
XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP ("missing ]]> for IGNORE section"
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\n begun at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
ConditionalSect -> XParser ConditionalSect
forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreSect -> ConditionalSect
IgnoreSect []))
] XParser ConditionalSect
-> (String -> String) -> XParser ConditionalSect
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("in a conditional section,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
newIgnore :: XParser Ignore
newIgnore :: Parser SymTabs (Posn, TokenT) Ignore
newIgnore =
( do TokenT -> XParser TokenT
tok TokenT
TokSectionOpen
Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) [Ignore]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) Ignore
newIgnore Parser SymTabs (Posn, TokenT) [Ignore]
-> String -> Parser SymTabs (Posn, TokenT) [Ignore]
forall a. a -> String -> a
`debug` "IGNORING conditional section"
TokenT -> XParser TokenT
tok TokenT
TokSectionClose
Ignore -> Parser SymTabs (Posn, TokenT) Ignore
forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore Parser SymTabs (Posn, TokenT) Ignore
-> String -> Parser SymTabs (Posn, TokenT) Ignore
forall a. a -> String -> a
`debug` "end of IGNORED conditional section") Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) Ignore
-> Parser SymTabs (Posn, TokenT) Ignore
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
( do TokenT
t <- [TokenT] -> XParser TokenT
nottok [TokenT
TokSectionOpen,TokenT
TokSectionClose]
Ignore -> Parser SymTabs (Posn, TokenT) Ignore
forall (m :: * -> *) a. Monad m => a -> m a
return Ignore
Ignore Parser SymTabs (Posn, TokenT) Ignore
-> String -> Parser SymTabs (Posn, TokenT) Ignore
forall a. a -> String -> a
`debug` ("ignoring: "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t))
reference :: XParser Reference
reference :: XParser Reference
reference = do
XParser TokenT
-> XParser TokenT -> XParser Reference -> XParser Reference
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokAmp) (TokenT -> XParser TokenT
tok TokenT
TokSemi) (Parser SymTabs (Posn, TokenT) String
freetext Parser SymTabs (Posn, TokenT) String
-> (String -> XParser Reference) -> XParser Reference
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParser Reference
forall (m :: * -> *). Monad m => String -> m Reference
val)
where
val :: String -> m Reference
val ('#':'x':i :: String
i) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit String
i
= Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar (CharRef -> Reference)
-> (String -> CharRef) -> String -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharRef, String) -> CharRef
forall a b. (a, b) -> a
fst ((CharRef, String) -> CharRef)
-> (String -> (CharRef, String)) -> String -> CharRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CharRef, String)] -> (CharRef, String)
forall a. [a] -> a
head ([(CharRef, String)] -> (CharRef, String))
-> (String -> [(CharRef, String)]) -> String -> (CharRef, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(CharRef, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
i
val ('#':i :: String
i) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
i
= Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharRef -> Reference
RefChar (CharRef -> Reference)
-> (String -> CharRef) -> String -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharRef, String) -> CharRef
forall a b. (a, b) -> a
fst ((CharRef, String) -> CharRef)
-> (String -> (CharRef, String)) -> String -> CharRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CharRef, String)] -> (CharRef, String)
forall a. [a] -> a
head ([(CharRef, String)] -> (CharRef, String))
-> (String -> [(CharRef, String)]) -> String -> (CharRef, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(CharRef, String)]
forall a. (Eq a, Num a) => ReadS a
readDec (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
i
val name :: String
name = Reference -> m Reference
forall (m :: * -> *) a. Monad m => a -> m a
return (Reference -> m Reference)
-> (String -> Reference) -> String -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Reference
RefEntity (String -> m Reference) -> String -> m Reference
forall a b. (a -> b) -> a -> b
$ String
name
pereference :: XParser PEReference
pereference :: Parser SymTabs (Posn, TokenT) String
pereference = do
XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokPercent) (TokenT -> XParser TokenT
tok TokenT
TokSemi) Parser SymTabs (Posn, TokenT) String
nmtoken
entitydecl :: XParser EntityDecl
entitydecl :: XParser EntityDecl
entitydecl =
( XParser GEDecl
gedecl XParser GEDecl
-> (GEDecl -> XParser EntityDecl) -> XParser EntityDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDecl -> XParser EntityDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDecl -> XParser EntityDecl)
-> (GEDecl -> EntityDecl) -> GEDecl -> XParser EntityDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GEDecl -> EntityDecl
EntityGEDecl) XParser EntityDecl -> XParser EntityDecl -> XParser EntityDecl
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
( XParser PEDecl
pedecl XParser PEDecl
-> (PEDecl -> XParser EntityDecl) -> XParser EntityDecl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDecl -> XParser EntityDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDecl -> XParser EntityDecl)
-> (PEDecl -> EntityDecl) -> PEDecl -> XParser EntityDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PEDecl -> EntityDecl
EntityPEDecl)
gedecl :: XParser GEDecl
gedecl :: XParser GEDecl
gedecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
String
n <- Parser SymTabs (Posn, TokenT) String
name
EntityDef
e <- XParser EntityDef
entitydef XParser EntityDef -> (String -> String) -> XParser EntityDef
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (("in general entity defn "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
TokenT -> XParser TokenT
tok TokenT
TokAnyClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP ("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` ("added GE defn &"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";")
GEDecl -> XParser GEDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EntityDef -> GEDecl
GEDecl String
n EntityDef
e)
pedecl :: XParser PEDecl
pedecl :: XParser PEDecl
pedecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
ENTITYx)
TokenT -> XParser TokenT
tok TokenT
TokPercent
String
n <- Parser SymTabs (Posn, TokenT) String
name
PEDef
e <- XParser PEDef
pedef XParser PEDef -> (String -> String) -> XParser PEDef
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (("in parameter entity defn "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
TokenT -> XParser TokenT
tok TokenT
TokAnyClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP ("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` ("added PE defn %"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++";\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++PEDef -> String
forall a. Show a => a -> String
show PEDef
e)
PEDecl -> XParser PEDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PEDef -> PEDecl
PEDecl String
n PEDef
e)
entitydef :: XParser EntityDef
entitydef :: XParser EntityDef
entitydef =
[(String, XParser EntityDef)] -> XParser EntityDef
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("entityvalue", XParser EntityValue
entityvalue XParser EntityValue
-> (EntityValue -> XParser EntityDef) -> XParser EntityDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EntityDef -> XParser EntityDef
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityDef -> XParser EntityDef)
-> (EntityValue -> EntityDef) -> EntityValue -> XParser EntityDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityValue -> EntityDef
DefEntityValue)
, ("external", do ExternalID
eid <- XParser ExternalID
externalid
Maybe NDataDecl
ndd <- XParser NDataDecl -> XParser (Maybe NDataDecl)
forall a. XParser a -> XParser (Maybe a)
maybe XParser NDataDecl
ndatadecl
EntityDef -> XParser EntityDef
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalID -> Maybe NDataDecl -> EntityDef
DefExternalID ExternalID
eid Maybe NDataDecl
ndd))
]
pedef :: XParser PEDef
pedef :: XParser PEDef
pedef =
[(String, XParser PEDef)] -> XParser PEDef
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("entityvalue", XParser EntityValue
entityvalue XParser EntityValue
-> (EntityValue -> XParser PEDef) -> XParser PEDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PEDef -> XParser PEDef
forall (m :: * -> *) a. Monad m => a -> m a
return (PEDef -> XParser PEDef)
-> (EntityValue -> PEDef) -> EntityValue -> XParser PEDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityValue -> PEDef
PEDefEntityValue)
, ("externalid", XParser ExternalID
externalid XParser ExternalID
-> (ExternalID -> XParser PEDef) -> XParser PEDef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PEDef -> XParser PEDef
forall (m :: * -> *) a. Monad m => a -> m a
return (PEDef -> XParser PEDef)
-> (ExternalID -> PEDef) -> ExternalID -> XParser PEDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExternalID -> PEDef
PEDefExternalID)
]
externalid :: XParser ExternalID
externalid :: XParser ExternalID
externalid =
[(String, XParser ExternalID)] -> XParser ExternalID
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("SYSTEM", do String -> XParser ()
word "SYSTEM"
SystemLiteral
s <- XParser SystemLiteral
systemliteral
ExternalID -> XParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemLiteral -> ExternalID
SYSTEM SystemLiteral
s) )
, ("PUBLIC", do String -> XParser ()
word "PUBLIC"
PubidLiteral
p <- XParser PubidLiteral
pubidliteral
SystemLiteral
s <- XParser SystemLiteral
systemliteral
ExternalID -> XParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (PubidLiteral -> SystemLiteral -> ExternalID
PUBLIC PubidLiteral
p SystemLiteral
s) )
]
XParser ExternalID -> (String -> String) -> XParser ExternalID
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("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 "NDATA"
String
n <- Parser SymTabs (Posn, TokenT) String
name
NDataDecl -> XParser NDataDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> NDataDecl
NDATA String
n)
textdecl :: XParser TextDecl
textdecl :: XParser TextDecl
textdecl = do
TokenT -> XParser TokenT
tok TokenT
TokPIOpen
(String -> XParser ()
word "xml" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word "XML")
Maybe String
v <- Parser SymTabs (Posn, TokenT) String -> XParser (Maybe String)
forall a. XParser a -> XParser (Maybe a)
maybe Parser SymTabs (Posn, TokenT) String
versioninfo
EncodingDecl
e <- XParser EncodingDecl
encodingdecl
TokenT -> XParser TokenT
tok TokenT
TokPIClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failP "expected ?> terminating text decl"
TextDecl -> XParser TextDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> EncodingDecl -> TextDecl
TextDecl Maybe String
v EncodingDecl
e)
encodingdecl :: XParser EncodingDecl
encodingdecl :: XParser EncodingDecl
encodingdecl = do
(String -> XParser ()
word "encoding" XParser () -> XParser () -> XParser ()
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser ()
word "ENCODING")
TokenT -> XParser TokenT
tok TokenT
TokEqual XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "expected = in 'encoding' decl"
String
f <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
EncodingDecl -> XParser EncodingDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EncodingDecl
EncodingDecl String
f)
notationdecl :: XParser NotationDecl
notationdecl :: XParser NotationDecl
notationdecl = do
TokenT -> XParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> XParser TokenT
tok (Special -> TokenT
TokSpecial Special
NOTATIONx)
String
n <- Parser SymTabs (Posn, TokenT) String
name
Either ExternalID PublicID
e <- XParser ExternalID
-> XParser PublicID -> XParser (Either ExternalID PublicID)
forall a b. XParser a -> XParser b -> XParser (Either a b)
either XParser ExternalID
externalid XParser PublicID
publicid
TokenT -> XParser TokenT
tok TokenT
TokAnyClose XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP ("expected > terminating NOTATION decl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n)
NotationDecl -> XParser NotationDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either ExternalID PublicID -> NotationDecl
NOTATION String
n Either ExternalID PublicID
e)
publicid :: XParser PublicID
publicid :: XParser PublicID
publicid = do
String -> XParser ()
word "PUBLIC"
PubidLiteral
p <- XParser PubidLiteral
pubidliteral
PublicID -> XParser PublicID
forall (m :: * -> *) a. Monad m => a -> m a
return (PubidLiteral -> PublicID
PUBLICID PubidLiteral
p)
entityvalue :: XParser EntityValue
entityvalue :: XParser EntityValue
entityvalue = do
TokenT -> XParser TokenT
tok TokenT
TokQuote
Posn
pn <- XParser Posn
posn
[EV]
evs <- Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) EV
ev
TokenT -> XParser TokenT
tok TokenT
TokQuote XParser TokenT -> XParser TokenT -> XParser TokenT
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` String -> XParser TokenT
forall a. String -> XParser a
failBadP "expected quote to terminate entityvalue"
SymTabs
st <- Parser SymTabs (Posn, TokenT) SymTabs
forall s t. Parser s t s
stGet
(String -> XParser EntityValue)
-> ([EV] -> XParser EntityValue)
-> Either String [EV]
-> XParser EntityValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> XParser EntityValue
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (EntityValue -> XParser EntityValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityValue -> XParser EntityValue)
-> ([EV] -> EntityValue) -> [EV] -> XParser EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EV] -> EntityValue
EntityValue) (Either String [EV] -> XParser EntityValue)
-> ((Either String [EV], SymTabs, [(Posn, TokenT)])
-> Either String [EV])
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> XParser EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String [EV], SymTabs, [(Posn, TokenT)])
-> Either String [EV]
forall a b c. (a, b, c) -> a
fst3 ((Either String [EV], SymTabs, [(Posn, TokenT)])
-> XParser EntityValue)
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
-> XParser EntityValue
forall a b. (a -> b) -> a -> b
$
(Parser SymTabs (Posn, TokenT) [EV]
-> SymTabs
-> [(Posn, TokenT)]
-> (Either String [EV], SymTabs, [(Posn, TokenT)])
forall s t a. Parser s t a -> s -> [t] -> (Either String a, s, [t])
runParser (Parser SymTabs (Posn, TokenT) EV
-> Parser SymTabs (Posn, TokenT) [EV]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser SymTabs (Posn, TokenT) EV
ev) SymTabs
st
((String -> Maybe String) -> Posn -> String -> [(Posn, TokenT)]
reLexEntityValue (\s :: 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 ev :: EntityValue
ev)) = String -> Maybe String
forall a. a -> Maybe a
Just (EntityValue -> String
flattenEV EntityValue
ev)
stringify _ = Maybe String
forall a. Maybe a
Nothing
ev :: XParser EV
ev :: Parser SymTabs (Posn, TokenT) EV
ev =
[(String, Parser SymTabs (Posn, TokenT) EV)]
-> Parser SymTabs (Posn, TokenT) EV
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("string", (Parser SymTabs (Posn, TokenT) String
stringParser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`Parser SymTabs (Posn, TokenT) String
freetext) Parser SymTabs (Posn, TokenT) String
-> (String -> Parser SymTabs (Posn, TokenT) EV)
-> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EV -> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a. Monad m => a -> m a
return (EV -> Parser SymTabs (Posn, TokenT) EV)
-> (String -> EV) -> String -> Parser SymTabs (Posn, TokenT) EV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EV
EVString)
, ("reference", XParser Reference
reference XParser Reference
-> (Reference -> Parser SymTabs (Posn, TokenT) EV)
-> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EV -> Parser SymTabs (Posn, TokenT) EV
forall (m :: * -> *) a. Monad m => a -> m a
return (EV -> Parser SymTabs (Posn, TokenT) EV)
-> (Reference -> EV)
-> Reference
-> Parser SymTabs (Posn, TokenT) EV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> EV
EVRef)
]
Parser SymTabs (Posn, TokenT) EV
-> (String -> String) -> Parser SymTabs (Posn, TokenT) EV
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("looking for entity value,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
attvalue :: XParser AttValue
attvalue :: XParser AttValue
attvalue = do
[Either String Reference]
avs <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) [Either String Reference]
-> Parser SymTabs (Posn, TokenT) [Either String Reference]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote)
(Parser SymTabs (Posn, TokenT) (Either String Reference)
-> Parser SymTabs (Posn, TokenT) [Either String Reference]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser SymTabs (Posn, TokenT) String
-> XParser Reference
-> Parser SymTabs (Posn, TokenT) (Either String Reference)
forall a b. XParser a -> XParser b -> XParser (Either a b)
either Parser SymTabs (Posn, TokenT) String
freetext XParser Reference
reference))
AttValue -> XParser AttValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [Either String Reference]
avs)
systemliteral :: XParser SystemLiteral
systemliteral :: XParser SystemLiteral
systemliteral = do
String
s <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
SystemLiteral -> XParser SystemLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SystemLiteral
SystemLiteral String
s)
pubidliteral :: XParser PubidLiteral
pubidliteral :: XParser PubidLiteral
pubidliteral = do
String
s <- XParser TokenT
-> XParser TokenT
-> Parser SymTabs (Posn, TokenT) String
-> Parser SymTabs (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> XParser TokenT
tok TokenT
TokQuote) (XParser TokenT -> XParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (XParser TokenT -> XParser TokenT)
-> XParser TokenT -> XParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> XParser TokenT
tok TokenT
TokQuote) Parser SymTabs (Posn, TokenT) String
freetext
PubidLiteral -> XParser PubidLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PubidLiteral
PubidLiteral String
s)
chardata :: XParser CharData
chardata :: Parser SymTabs (Posn, TokenT) String
chardata = Parser SymTabs (Posn, TokenT) String
freetext