module Text.XML.HaXml.Html.ParseLazy
( htmlParse
) where
import Prelude hiding (either,maybe,sequence)
import Data.Maybe hiding (maybe)
import Data.Char (toLower, isDigit, isHexDigit)
import Numeric (readDec,readHex)
import Control.Monad
import Text.XML.HaXml.Types
import Text.XML.HaXml.Lex
import Text.XML.HaXml.Posn
import Text.ParserCombinators.Poly.Lazy
#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
debug :: Monad m => String -> m ()
debug s = trace s (return ())
#else
debug :: Monad m => String -> m ()
debug :: String -> m ()
debug _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
htmlParse :: String -> String -> Document Posn
htmlParse :: String -> String -> Document Posn
htmlParse file :: String
file = (Document Posn, [(Posn, TokenT)]) -> Document Posn
forall a b. (a, b) -> a
fst ((Document Posn, [(Posn, TokenT)]) -> Document Posn)
-> (String -> (Document Posn, [(Posn, TokenT)]))
-> String
-> Document Posn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Posn, TokenT) (Document Posn)
-> [(Posn, TokenT)] -> (Document Posn, [(Posn, TokenT)])
forall t a. Parser t a -> [t] -> (a, [t])
runParser Parser (Posn, TokenT) (Document Posn)
document ([(Posn, TokenT)] -> (Document Posn, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Document Posn, [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Posn, TokenT)]
xmlLex String
file
selfclosingtags :: [String]
selfclosingtags :: [String]
selfclosingtags = ["img","hr","br","meta","col","link","base"
,"param","area","frame","input"]
closeInnerTags :: [(String,[String])]
closeInnerTags :: [(String, [String])]
closeInnerTags =
[ ("ul", ["li"])
, ("ol", ["li"])
, ("dl", ["dt","dd"])
, ("tr", ["th","td"])
, ("div", ["p"])
, ("thead", ["th","tr","td"])
, ("tfoot", ["th","tr","td"])
, ("tbody", ["th","tr","td"])
, ("table", ["th","tr","td","thead","tfoot","tbody"])
, ("caption", ["p"])
, ("th", ["p"])
, ("td", ["p"])
, ("li", ["p"])
, ("dt", ["p"])
, ("dd", ["p"])
, ("object", ["p"])
, ("map", ["p"])
, ("body", ["p"])
]
closes :: String -> String -> Bool
"a" closes :: String -> String -> Bool
`closes` "a" = Bool
True
"li" `closes` "li" = Bool
True
"th" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["th","td"] = Bool
True
"td" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["th","td"] = Bool
True
"tr" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["th","td","tr"] = Bool
True
"dt" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["dt","dd"] = Bool
True
"dd" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["dt","dd"] = Bool
True
"form" `closes` "form" = Bool
True
"label" `closes` "label" = Bool
True
_ `closes` "option" = Bool
True
"thead" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["colgroup"] = Bool
True
"tfoot" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["thead","colgroup"] = Bool
True
"tbody" `closes` t :: String
t | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["tbody","tfoot","thead","colgroup"] = Bool
True
"colgroup" `closes` "colgroup" = Bool
True
t :: String
t `closes` "p" | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["p","h1","h2","h3","h4","h5","h6"
,"hr","div","ul","dl","ol","table"] = Bool
True
_ `closes` _ = Bool
False
type HParser a = Parser (Posn,TokenT) a
tok :: TokenT -> HParser TokenT
tok :: TokenT -> HParser TokenT
tok t :: TokenT
t = do (p :: Posn
p,t' :: TokenT
t') <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case TokenT
t' of TokError _ -> (String -> HParser TokenT)
-> String -> Posn -> TokenT -> HParser TokenT
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser 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 -> HParser TokenT
forall (m :: * -> *) a. Monad m => a -> m a
return TokenT
t
| Bool
otherwise -> (String -> HParser TokenT)
-> String -> Posn -> TokenT -> HParser TokenT
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser 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'
qname :: HParser QName
qname :: HParser QName
qname = (String -> QName) -> Parser (Posn, TokenT) String -> HParser QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QName
N Parser (Posn, TokenT) String
name
name :: HParser Name
name :: Parser (Posn, TokenT) String
name = do (p :: Posn
p,tok :: TokenT
tok) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case TokenT
tok of
TokName s :: String
s -> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
TokError _ -> (String -> Parser (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser (Posn, TokenT) String
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> Parser (Posn, TokenT) String
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad "a name" Posn
p TokenT
tok
_ -> (String -> Parser (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser (Posn, TokenT) String
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "a name" Posn
p TokenT
tok
string, freetext :: HParser String
string :: Parser (Posn, TokenT) String
string = do (p :: Posn
p,t :: TokenT
t) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case TokenT
t of TokName s :: String
s -> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
_ -> (String -> Parser (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser (Posn, TokenT) String
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "text" Posn
p TokenT
t
freetext :: Parser (Posn, TokenT) String
freetext = do (p :: Posn
p,t :: TokenT
t) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case TokenT
t of TokFreeText s :: String
s -> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
_ -> (String -> Parser (Posn, TokenT) String)
-> String -> Posn -> TokenT -> Parser (Posn, TokenT) String
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "text" Posn
p TokenT
t
maybe :: HParser a -> HParser (Maybe a)
maybe :: HParser a -> HParser (Maybe a)
maybe p :: HParser a
p =
( HParser a
p HParser a -> (a -> HParser (Maybe a)) -> HParser (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> HParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> HParser (Maybe a))
-> (a -> Maybe a) -> a -> HParser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) HParser (Maybe a) -> HParser (Maybe a) -> HParser (Maybe a)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( Maybe a -> HParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
either :: HParser a -> HParser b -> HParser (Either a b)
either :: HParser a -> HParser b -> HParser (Either a b)
either p :: HParser a
p q :: HParser b
q =
( HParser a
p HParser a -> (a -> HParser (Either a b)) -> HParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> HParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> HParser (Either a b))
-> (a -> Either a b) -> a -> HParser (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) HParser (Either a b)
-> HParser (Either a b) -> HParser (Either a b)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( HParser b
q HParser b -> (b -> HParser (Either a b)) -> HParser (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a b -> HParser (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> HParser (Either a b))
-> (b -> Either a b) -> b -> HParser (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 -> HParser ()
word :: String -> HParser ()
word s :: String
s = do { (Posn, TokenT)
x <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser 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 -> () -> HParser ()
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 -> () -> HParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
( p :: Posn
p,t :: TokenT
t@(TokError _)) -> (String -> HParser ()) -> String -> Posn -> TokenT -> HParser ()
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser ()
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 -> HParser ()) -> String -> Posn -> TokenT -> HParser ()
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser ()
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 :: HParser Posn
posn :: HParser Posn
posn = do { x :: (Posn, TokenT)
x@(p :: Posn
p,_) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
; [(Posn, TokenT)] -> HParser ()
forall t. [t] -> Parser t ()
reparse [(Posn, TokenT)
x]
; Posn -> HParser Posn
forall (m :: * -> *) a. Monad m => a -> m a
return Posn
p
} HParser Posn -> HParser Posn -> HParser Posn
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Posn -> HParser Posn
forall (m :: * -> *) a. Monad m => a -> m a
return Posn
noPos
nmtoken :: HParser NmToken
nmtoken :: Parser (Posn, TokenT) String
nmtoken = (Parser (Posn, TokenT) String
string Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Parser (Posn, TokenT) String
freetext)
failP, failBadP :: String -> HParser a
failP :: String -> HParser a
failP msg :: String
msg = do { Posn
p <- HParser Posn
posn; String -> HParser 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 -> HParser a
failBadP msg :: String
msg = do { Posn
p <- HParser Posn
posn; String -> HParser 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->HParser a) -> String -> Posn -> TokenT -> HParser a
report :: (String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report fail :: String -> HParser a
fail expect :: String
expect p :: Posn
p t :: TokenT
t = String -> HParser a
fail ("Expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show 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 at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
p)
adjustErrP :: HParser a -> (String->String) -> HParser a
p :: HParser a
p adjustErrP :: HParser a -> (String -> String) -> HParser a
`adjustErrP` f :: String -> String
f = HParser a
p HParser a -> HParser a -> HParser a
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` do Posn
pn <- HParser Posn
posn
(HParser a
p HParser a -> (String -> String) -> HParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` String -> String
f) HParser a -> (String -> String) -> HParser 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)
document :: HParser (Document Posn)
document :: Parser (Posn, TokenT) (Document Posn)
document = do
(Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> Parser
(Posn, TokenT)
(Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document
Parser
(Posn, TokenT)
(Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> Parser (Posn, TokenT) Prolog
-> Parser
(Posn, TokenT)
(SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Parser (Posn, TokenT) Prolog
prolog Parser (Posn, TokenT) Prolog
-> (String -> String) -> Parser (Posn, TokenT) 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]
++))
Parser
(Posn, TokenT)
(SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn)
-> Parser (Posn, TokenT) (SymTab EntityDef)
-> Parser (Posn, TokenT) (Element Posn -> [Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (SymTab EntityDef -> Parser (Posn, TokenT) (SymTab EntityDef)
forall (m :: * -> *) a. Monad m => a -> m a
return SymTab EntityDef
forall a. SymTab a
emptyST)
Parser (Posn, TokenT) (Element Posn -> [Misc] -> Document Posn)
-> Parser (Posn, TokenT) (Element Posn)
-> Parser (Posn, TokenT) ([Misc] -> Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (do [(Stack, Element Posn)]
ht <- Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) [(Stack, Element Posn)]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (QName -> Parser (Posn, TokenT) (Stack, Element Posn)
element (String -> QName
N "HTML document"))
Element Posn -> Parser (Posn, TokenT) (Element Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (case ((Stack, Element Posn) -> Element Posn)
-> [(Stack, Element Posn)] -> [Element Posn]
forall a b. (a -> b) -> [a] -> [b]
map (Stack, Element Posn) -> Element Posn
forall a b. (a, b) -> b
snd [(Stack, Element Posn)]
ht of
[e :: Element Posn
e] -> Element Posn
e
es :: [Element Posn]
es -> QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N "html") [] ((Element Posn -> Content Posn) -> [Element Posn] -> [Content Posn]
forall a b. (a -> b) -> [a] -> [b]
map Element Posn -> Content Posn
mkCElem [Element Posn]
es)))
Parser (Posn, TokenT) ([Misc] -> Document Posn)
-> Parser (Posn, TokenT) [Misc]
-> Parser (Posn, TokenT) (Document Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Parser (Posn, TokenT) Misc -> Parser (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Misc
misc)
where mkCElem :: Element Posn -> Content Posn
mkCElem e :: Element Posn
e = Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
e Posn
noPos
comment :: HParser Comment
= do
HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokCommentOpen) (TokenT -> HParser TokenT
tok TokenT
TokCommentClose) Parser (Posn, TokenT) String
freetext
processinginstruction :: HParser ProcessingInstruction
processinginstruction :: HParser ProcessingInstruction
processinginstruction = do
TokenT -> HParser TokenT
tok TokenT
TokPIOpen
HParser ProcessingInstruction -> HParser ProcessingInstruction
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser ProcessingInstruction -> HParser ProcessingInstruction)
-> HParser ProcessingInstruction -> HParser ProcessingInstruction
forall a b. (a -> b) -> a -> b
$ do
String
n <- Parser (Posn, TokenT) String
string Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> Parser (Posn, TokenT) String
forall a. String -> HParser a
failP "processing instruction has no target"
String
f <- Parser (Posn, TokenT) String
freetext
(TokenT -> HParser TokenT
tok TokenT
TokPIClose HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` TokenT -> HParser TokenT
tok TokenT
TokAnyClose) HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failP "missing ?> or >"
ProcessingInstruction -> HParser ProcessingInstruction
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, String
f)
cdsect :: HParser CDSect
cdsect :: Parser (Posn, TokenT) String
cdsect = do
TokenT -> HParser TokenT
tok TokenT
TokSectionOpen
HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok (Section -> TokenT
TokSection Section
CDATAx)) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokSectionClose) Parser (Posn, TokenT) String
chardata
prolog :: HParser Prolog
prolog :: Parser (Posn, TokenT) Prolog
prolog = do
Maybe XMLDecl
x <- HParser XMLDecl -> HParser (Maybe XMLDecl)
forall a. HParser a -> HParser (Maybe a)
maybe HParser XMLDecl
xmldecl
[Misc]
m1 <- Parser (Posn, TokenT) Misc -> Parser (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Misc
misc
Maybe DocTypeDecl
dtd <- HParser DocTypeDecl -> HParser (Maybe DocTypeDecl)
forall a. HParser a -> HParser (Maybe a)
maybe HParser DocTypeDecl
doctypedecl
[Misc]
m2 <- Parser (Posn, TokenT) Misc -> Parser (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Misc
misc
Prolog -> Parser (Posn, TokenT) 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 :: HParser XMLDecl
xmldecl :: HParser XMLDecl
xmldecl = do
TokenT -> HParser TokenT
tok TokenT
TokPIOpen
(String -> HParser ()
word "xml" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word "XML")
Posn
p <- HParser Posn
posn
String
s <- Parser (Posn, TokenT) String
freetext
TokenT -> HParser TokenT
tok TokenT
TokPIClose HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failBadP "missing ?> in <?xml ...?>"
(XMLDecl -> HParser XMLDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XMLDecl -> HParser XMLDecl)
-> (String -> XMLDecl) -> String -> HParser XMLDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XMLDecl, [(Posn, TokenT)]) -> XMLDecl
forall a b. (a, b) -> a
fst ((XMLDecl, [(Posn, TokenT)]) -> XMLDecl)
-> (String -> (XMLDecl, [(Posn, TokenT)])) -> String -> XMLDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HParser XMLDecl -> [(Posn, TokenT)] -> (XMLDecl, [(Posn, TokenT)])
forall t a. Parser t a -> [t] -> (a, [t])
runParser HParser XMLDecl
aux ([(Posn, TokenT)] -> (XMLDecl, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (XMLDecl, [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> String -> [(Posn, TokenT)]
xmlReLex Posn
p) String
s
where
aux :: HParser XMLDecl
aux = do
String
v <- Parser (Posn, TokenT) String
versioninfo Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> Parser (Posn, TokenT) String
forall a. String -> HParser a
failP "missing XML version info"
Maybe EncodingDecl
e <- HParser EncodingDecl -> HParser (Maybe EncodingDecl)
forall a. HParser a -> HParser (Maybe a)
maybe HParser EncodingDecl
encodingdecl
Maybe Bool
s <- HParser Bool -> HParser (Maybe Bool)
forall a. HParser a -> HParser (Maybe a)
maybe HParser Bool
sddecl
XMLDecl -> HParser 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)
versioninfo :: HParser VersionInfo
versioninfo :: Parser (Posn, TokenT) String
versioninfo = do
(String -> HParser ()
word "version" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word "VERSION")
TokenT -> HParser TokenT
tok TokenT
TokEqual
HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote) Parser (Posn, TokenT) String
freetext
misc :: HParser Misc
misc :: Parser (Posn, TokenT) Misc
misc =
[(String, Parser (Posn, TokenT) Misc)]
-> Parser (Posn, TokenT) Misc
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ ("<!--comment-->", Parser (Posn, TokenT) String
comment Parser (Posn, TokenT) String
-> (String -> Parser (Posn, TokenT) Misc)
-> Parser (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser (Posn, TokenT) Misc)
-> (String -> Misc) -> String -> Parser (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Misc
Comment)
, ("<?PI?>", HParser ProcessingInstruction
processinginstruction HParser ProcessingInstruction
-> (ProcessingInstruction -> Parser (Posn, TokenT) Misc)
-> Parser (Posn, TokenT) Misc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Misc -> Parser (Posn, TokenT) Misc
forall (m :: * -> *) a. Monad m => a -> m a
return (Misc -> Parser (Posn, TokenT) Misc)
-> (ProcessingInstruction -> Misc)
-> ProcessingInstruction
-> Parser (Posn, TokenT) Misc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessingInstruction -> Misc
PI)
]
doctypedecl :: HParser DocTypeDecl
doctypedecl :: HParser DocTypeDecl
doctypedecl = do
TokenT -> HParser TokenT
tok TokenT
TokSpecialOpen
TokenT -> HParser TokenT
tok (Special -> TokenT
TokSpecial Special
DOCTYPEx)
HParser DocTypeDecl -> HParser DocTypeDecl
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser DocTypeDecl -> HParser DocTypeDecl)
-> HParser DocTypeDecl -> HParser DocTypeDecl
forall a b. (a -> b) -> a -> b
$ do
QName
n <- HParser QName
qname
Maybe ExternalID
eid <- HParser ExternalID -> HParser (Maybe ExternalID)
forall a. HParser a -> HParser (Maybe a)
maybe HParser ExternalID
externalid
TokenT -> HParser TokenT
tok TokenT
TokAnyClose HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failP "missing > in DOCTYPE decl"
DocTypeDecl -> HParser DocTypeDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> Maybe ExternalID -> [MarkupDecl] -> DocTypeDecl
DTD QName
n Maybe ExternalID
eid [])
sddecl :: HParser SDDecl
sddecl :: HParser Bool
sddecl = do
(String -> HParser ()
word "standalone" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word "STANDALONE")
HParser Bool -> HParser Bool
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser Bool -> HParser Bool) -> HParser Bool -> HParser Bool
forall a b. (a -> b) -> a -> b
$ do
TokenT -> HParser TokenT
tok TokenT
TokEqual HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failP "missing = in 'standalone' decl"
HParser TokenT -> HParser TokenT -> HParser Bool -> HParser Bool
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote)
( (String -> HParser ()
word "yes" HParser () -> HParser Bool -> HParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> HParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) HParser Bool -> HParser Bool -> HParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
(String -> HParser ()
word "no" HParser () -> HParser Bool -> HParser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> HParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) HParser Bool -> HParser Bool -> HParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
String -> HParser Bool
forall a. String -> HParser a
failP "'standalone' decl requires 'yes' or 'no' value" )
type Stack = [(Name,[Attribute])]
element :: QName -> HParser (Stack,Element Posn)
element :: QName -> Parser (Posn, TokenT) (Stack, Element Posn)
element (N ctx :: String
ctx) =
do
TokenT -> HParser TokenT
tok TokenT
TokAnyOpen
(ElemTag (N e :: String
e) avs :: [Attribute]
avs) <- HParser ElemTag
elemtag
( if String
e String -> String -> Bool
`closes` String
ctx then
( do String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug ("/")
[TokenT] -> HParser ()
unparse ([TokenT
TokEndOpen, String -> TokenT
TokName String
ctx, TokenT
TokAnyClose,
TokenT
TokAnyOpen, String -> TokenT
TokName String
e] [TokenT] -> [TokenT] -> [TokenT]
forall a. [a] -> [a] -> [a]
++ [Attribute] -> [TokenT]
reformatAttrs [Attribute]
avs)
(Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, 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 (String -> QName
N "null") [] []))
else if String
e String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
selfclosingtags then
( do TokenT -> HParser TokenT
tok TokenT
TokEndClose
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug (String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++"[+]")
(Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, 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 (String -> QName
N String
e) [Attribute]
avs [])) Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( do TokenT -> HParser TokenT
tok TokenT
TokAnyClose
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug (String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++"[+]")
(Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, 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 (String -> QName
N String
e) [Attribute]
avs []))
else
(( do TokenT -> HParser TokenT
tok TokenT
TokEndClose
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug (String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++"[]")
(Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, 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 (String -> QName
N String
e) [Attribute]
avs [])) Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( do TokenT -> HParser TokenT
tok TokenT
TokAnyClose HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failP "missing > or /> in element tag"
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug (String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++"[")
((Stack, [Content Posn]) -> (Stack, Element Posn))
-> Parser
(Posn, TokenT) ((Stack, [Content Posn]) -> (Stack, Element Posn))
forall (m :: * -> *) a. Monad m => a -> m a
return (\ interior :: (Stack, [Content Posn])
interior-> let (stack :: Stack
stack,contained :: [Content Posn]
contained) = (Stack, [Content Posn])
interior
in (Stack
stack, QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N String
e) [Attribute]
avs [Content Posn]
contained))
Parser
(Posn, TokenT) ((Stack, [Content Posn]) -> (Stack, Element Posn))
-> Parser (Posn, TokenT) (Stack, [Content Posn])
-> Parser (Posn, TokenT) (Stack, Element Posn)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply`
(do [(Stack, Content Posn)]
zz <- Parser (Posn, TokenT) (Stack, Content Posn)
-> HParser TokenT -> Parser (Posn, TokenT) [(Stack, Content Posn)]
forall (p :: * -> *) a z. PolyParse p => p a -> p z -> p [a]
manyFinally (String -> Parser (Posn, TokenT) (Stack, Content Posn)
content String
e)
(TokenT -> HParser TokenT
tok TokenT
TokEndOpen)
(N n :: String
n) <- HParser QName
qname
HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (TokenT -> HParser TokenT
tok TokenT
TokAnyClose)
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug "]"
let (ss :: [Stack]
ss,cs :: [Content Posn]
cs) = [(Stack, Content Posn)] -> ([Stack], [Content Posn])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Stack, Content Posn)]
zz
let s :: Stack
s = if [Stack] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stack]
ss then [] else [Stack] -> Stack
forall a. [a] -> a
last [Stack]
ss
( if String
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n :: Name) then
do [TokenT] -> HParser ()
unparse (Stack -> [TokenT]
reformatTags (String -> Stack -> Stack
closeInner String
e Stack
s))
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug "^"
(Stack, [Content Posn])
-> Parser (Posn, TokenT) (Stack, [Content Posn])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Content Posn]
cs)
else
do [TokenT] -> HParser ()
unparse [TokenT
TokEndOpen, String -> TokenT
TokName String
n, TokenT
TokAnyClose]
String -> HParser ()
forall (m :: * -> *). Monad m => String -> m ()
debug "-"
(Stack, [Content Posn])
-> Parser (Posn, TokenT) (Stack, [Content Posn])
forall (m :: * -> *) a. Monad m => a -> m a
return (((String
e,[Attribute]
avs)(String, [Attribute]) -> Stack -> Stack
forall a. a -> [a] -> [a]
:Stack
s), [Content Posn]
cs)))
) Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element Posn)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> Parser (Posn, TokenT) (Stack, Element Posn)
forall a. String -> HParser a
failP ("failed to repair non-matching tags in context: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ctx)))
closeInner :: Name -> [(Name,[Attribute])] -> [(Name,[Attribute])]
closeInner :: String -> Stack -> Stack
closeInner c :: String
c ts :: Stack
ts =
case String -> [(String, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
c [(String, [String])]
closeInnerTags of
(Just these :: [String]
these) -> ((String, [Attribute]) -> Bool) -> Stack -> Stack
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
these)(String -> Bool)
-> ((String, [Attribute]) -> String)
-> (String, [Attribute])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, [Attribute]) -> String
forall a b. (a, b) -> a
fst) Stack
ts
Nothing -> Stack
ts
unparse :: [TokenT] -> Parser (Posn, TokenT) ()
unparse :: [TokenT] -> HParser ()
unparse ts :: [TokenT]
ts = do Posn
p <- HParser Posn
posn
[(Posn, TokenT)] -> HParser ()
forall t. [t] -> Parser t ()
reparse ([Posn] -> [TokenT] -> [(Posn, TokenT)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Posn -> [Posn]
forall a. a -> [a]
repeat Posn
p) [TokenT]
ts)
reformatAttrs :: [(QName, AttValue)] -> [TokenT]
reformatAttrs :: [Attribute] -> [TokenT]
reformatAttrs avs :: [Attribute]
avs = (Attribute -> [TokenT]) -> [Attribute] -> [TokenT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attribute -> [TokenT]
f0 [Attribute]
avs
where f0 :: Attribute -> [TokenT]
f0 (N a :: String
a, v :: AttValue
v@(AttValue _)) = [String -> TokenT
TokName String
a, TokenT
TokEqual, TokenT
TokQuote,
String -> TokenT
TokFreeText (AttValue -> String
forall a. Show a => a -> String
show AttValue
v), TokenT
TokQuote]
reformatTags :: [(Name, [(QName, AttValue)])] -> [TokenT]
reformatTags :: Stack -> [TokenT]
reformatTags ts :: Stack
ts = ((String, [Attribute]) -> [TokenT]) -> Stack -> [TokenT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Attribute]) -> [TokenT]
f0 Stack
ts
where f0 :: (String, [Attribute]) -> [TokenT]
f0 (t :: String
t,avs :: [Attribute]
avs) = [TokenT
TokAnyOpen, String -> TokenT
TokName String
t][TokenT] -> [TokenT] -> [TokenT]
forall a. [a] -> [a] -> [a]
++[Attribute] -> [TokenT]
reformatAttrs [Attribute]
avs
[TokenT] -> [TokenT] -> [TokenT]
forall a. [a] -> [a] -> [a]
++[TokenT
TokAnyClose]
content :: Name -> HParser (Stack,Content Posn)
content :: String -> Parser (Posn, TokenT) (Stack, Content Posn)
content ctx :: String
ctx = do { Posn
p <- HParser Posn
posn ; Posn -> Parser (Posn, TokenT) (Stack, Content Posn)
content' Posn
p }
where content' :: Posn -> Parser (Posn, TokenT) (Stack, Content Posn)
content' p :: Posn
p = [(String, Parser (Posn, TokenT) (Stack, Content Posn))]
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf'
[ ( "element", QName -> Parser (Posn, TokenT) (Stack, Element Posn)
element (String -> QName
N String
ctx) Parser (Posn, TokenT) (Stack, Element Posn)
-> ((Stack, Element Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(s :: Stack
s,e :: Element Posn
e)-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack
s, Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
e Posn
p))
, ( "chardata", Parser (Posn, TokenT) String
chardata Parser (Posn, TokenT) String
-> (String -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: String
s-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
False String
s Posn
p))
, ( "reference", HParser Reference
reference HParser Reference
-> (Reference -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: Reference
r-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef Reference
r Posn
p))
, ( "cdsect", Parser (Posn, TokenT) String
cdsect Parser (Posn, TokenT) String
-> (String -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: String
c-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Bool -> String -> Posn -> Content Posn
forall i. Bool -> String -> i -> Content i
CString Bool
True String
c Posn
p))
, ( "misc", Parser (Posn, TokenT) Misc
misc Parser (Posn, TokenT) Misc
-> (Misc -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \m :: Misc
m-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Misc -> Posn -> Content Posn
forall i. Misc -> i -> Content i
CMisc Misc
m Posn
p))
] Parser (Posn, TokenT) (Stack, Content Posn)
-> (String -> String)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. HParser a -> (String -> String) -> HParser a
`adjustErrP` ("when looking for a content item,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
elemtag :: HParser ElemTag
elemtag :: HParser ElemTag
elemtag = do
(N n :: String
n) <- HParser QName
qname HParser QName -> (String -> String) -> HParser 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 (Posn, TokenT) Attribute
-> Parser (Posn, TokenT) [Attribute]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Attribute
attribute
ElemTag -> HParser ElemTag
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> [Attribute] -> ElemTag
ElemTag (String -> QName
N ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n)) [Attribute]
as)
attribute :: HParser Attribute
attribute :: Parser (Posn, TokenT) Attribute
attribute = do
(N n :: String
n) <- HParser QName
qname
AttValue
v <- (do TokenT -> HParser TokenT
tok TokenT
TokEqual
HParser AttValue
attvalue) HParser AttValue -> HParser AttValue -> HParser AttValue
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
(AttValue -> HParser AttValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [String -> Either String Reference
forall a b. a -> Either a b
Left "TRUE"]))
Attribute -> Parser (Posn, TokenT) Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> QName
N ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n), AttValue
v)
reference :: HParser Reference
reference :: HParser Reference
reference = do
HParser TokenT
-> HParser TokenT -> HParser Reference -> HParser Reference
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokAmp) (TokenT -> HParser TokenT
tok TokenT
TokSemi) (Parser (Posn, TokenT) String
freetext Parser (Posn, TokenT) String
-> (String -> HParser Reference) -> HParser Reference
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> HParser 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 ent :: String
ent = 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
ent
externalid :: HParser ExternalID
externalid :: HParser ExternalID
externalid =
( do String -> HParser ()
word "SYSTEM"
SystemLiteral
s <- HParser SystemLiteral
systemliteral
ExternalID -> HParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemLiteral -> ExternalID
SYSTEM SystemLiteral
s)) HParser ExternalID -> HParser ExternalID -> HParser ExternalID
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( do String -> HParser ()
word "PUBLIC"
PubidLiteral
p <- HParser PubidLiteral
pubidliteral
SystemLiteral
s <- (HParser SystemLiteral
systemliteral HParser SystemLiteral
-> HParser SystemLiteral -> HParser SystemLiteral
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` SystemLiteral -> HParser SystemLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SystemLiteral
SystemLiteral ""))
ExternalID -> HParser ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (PubidLiteral -> SystemLiteral -> ExternalID
PUBLIC PubidLiteral
p SystemLiteral
s))
encodingdecl :: HParser EncodingDecl
encodingdecl :: HParser EncodingDecl
encodingdecl = do
(String -> HParser ()
word "encoding" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word "ENCODING")
TokenT -> HParser TokenT
tok TokenT
TokEqual HParser TokenT -> HParser TokenT -> HParser TokenT
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser TokenT
forall a. String -> HParser a
failBadP "expected = in 'encoding' decl"
String
f <- HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote) Parser (Posn, TokenT) String
freetext
EncodingDecl -> HParser EncodingDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> EncodingDecl
EncodingDecl String
f)
attvalue :: HParser AttValue
attvalue :: HParser AttValue
attvalue =
( do [Either String Reference]
avs <- HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) [Either String Reference]
-> Parser (Posn, TokenT) [Either String Reference]
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote)
(Parser (Posn, TokenT) (Either String Reference)
-> Parser (Posn, TokenT) [Either String Reference]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (Posn, TokenT) String
-> HParser Reference
-> Parser (Posn, TokenT) (Either String Reference)
forall a b. HParser a -> HParser b -> HParser (Either a b)
either Parser (Posn, TokenT) String
freetext HParser Reference
reference))
AttValue -> HParser AttValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [Either String Reference]
avs) ) HParser AttValue -> HParser AttValue -> HParser AttValue
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( do String
v <- Parser (Posn, TokenT) String
nmtoken
String
s <- (TokenT -> HParser TokenT
tok TokenT
TokPercent HParser TokenT
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return "%") Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
AttValue -> HParser AttValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [String -> Either String Reference
forall a b. a -> Either a b
Left (String
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)]) ) HParser AttValue -> HParser AttValue -> HParser AttValue
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
( do String
s <- [Parser (Posn, TokenT) String] -> Parser (Posn, TokenT) String
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ TokenT -> HParser TokenT
tok TokenT
TokPlus HParser TokenT
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return "+"
, TokenT -> HParser TokenT
tok TokenT
TokHash HParser TokenT
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser (Posn, TokenT) String
forall (m :: * -> *) a. Monad m => a -> m a
return "#"
]
String
v <- Parser (Posn, TokenT) String
nmtoken
AttValue -> HParser AttValue
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either String Reference] -> AttValue
AttValue [String -> Either String Reference
forall a b. a -> Either a b
Left (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
v)]) ) HParser AttValue -> HParser AttValue -> HParser AttValue
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
String -> HParser AttValue
forall a. String -> HParser a
failP "Badly formatted attribute value"
systemliteral :: HParser SystemLiteral
systemliteral :: HParser SystemLiteral
systemliteral = do
String
s <- HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote) Parser (Posn, TokenT) String
freetext
SystemLiteral -> HParser SystemLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SystemLiteral
SystemLiteral String
s)
pubidliteral :: HParser PubidLiteral
pubidliteral :: HParser PubidLiteral
pubidliteral = do
String
s <- HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) String
-> Parser (Posn, TokenT) String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (TokenT -> HParser TokenT
tok TokenT
TokQuote) (HParser TokenT -> HParser TokenT
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (HParser TokenT -> HParser TokenT)
-> HParser TokenT -> HParser TokenT
forall a b. (a -> b) -> a -> b
$ TokenT -> HParser TokenT
tok TokenT
TokQuote) Parser (Posn, TokenT) String
freetext
PubidLiteral -> HParser PubidLiteral
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PubidLiteral
PubidLiteral String
s)
chardata :: HParser CharData
chardata :: Parser (Posn, TokenT) String
chardata = Parser (Posn, TokenT) String
freetext