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 :: forall (m :: * -> *). Monad m => String -> m ()
debug String
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
htmlParse :: String -> String -> Document Posn
htmlParse :: String -> String -> Document Posn
htmlParse 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 = [String
"img",String
"hr",String
"br",String
"meta",String
"col",String
"link",String
"base"
,String
"param",String
"area",String
"frame",String
"input"]
closeInnerTags :: [(String,[String])]
closeInnerTags :: [(String, [String])]
closeInnerTags =
[ (String
"ul", [String
"li"])
, (String
"ol", [String
"li"])
, (String
"dl", [String
"dt",String
"dd"])
, (String
"tr", [String
"th",String
"td"])
, (String
"div", [String
"p"])
, (String
"thead", [String
"th",String
"tr",String
"td"])
, (String
"tfoot", [String
"th",String
"tr",String
"td"])
, (String
"tbody", [String
"th",String
"tr",String
"td"])
, (String
"table", [String
"th",String
"tr",String
"td",String
"thead",String
"tfoot",String
"tbody"])
, (String
"caption", [String
"p"])
, (String
"th", [String
"p"])
, (String
"td", [String
"p"])
, (String
"li", [String
"p"])
, (String
"dt", [String
"p"])
, (String
"dd", [String
"p"])
, (String
"object", [String
"p"])
, (String
"map", [String
"p"])
, (String
"body", [String
"p"])
]
closes :: String -> String -> Bool
String
"a" closes :: String -> String -> Bool
`closes` String
"a" = Bool
True
String
"li" `closes` String
"li" = Bool
True
String
"th" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"th",String
"td"] = Bool
True
String
"td" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"th",String
"td"] = Bool
True
String
"tr" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"th",String
"td",String
"tr"] = Bool
True
String
"dt" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"dt",String
"dd"] = Bool
True
String
"dd" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"dt",String
"dd"] = Bool
True
String
"form" `closes` String
"form" = Bool
True
String
"label" `closes` String
"label" = Bool
True
String
_ `closes` String
"option" = Bool
True
String
"thead" `closes` String
t | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"colgroup" = Bool
True
String
"tfoot" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"thead",String
"colgroup"] = Bool
True
String
"tbody" `closes` String
t | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"tbody",String
"tfoot",String
"thead",String
"colgroup"] = Bool
True
String
"colgroup" `closes` String
"colgroup" = Bool
True
String
t `closes` String
"p" | String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"p",String
"h1",String
"h2",String
"h3",String
"h4",String
"h5",String
"h6"
,String
"hr",String
"div",String
"ul",String
"dl",String
"ol",String
"table"] = Bool
True
String
_ `closes` String
_ = Bool
False
type HParser a = Parser (Posn,TokenT) a
tok :: TokenT -> HParser TokenT
tok :: TokenT -> HParser TokenT
tok TokenT
t = do (p,t') <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case t' of TokError String
_ -> (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
_ | TokenT
t'TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
==TokenT
t -> TokenT -> HParser TokenT
forall a. a -> Parser (Posn, TokenT) a
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 a. String -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (TokenT -> String
forall a. Show a => a -> String
show TokenT
t) Posn
p TokenT
t'
qname :: HParser QName
qname :: HParser QName
qname = (String -> QName) -> Parser (Posn, TokenT) String -> HParser QName
forall a b.
(a -> b) -> Parser (Posn, TokenT) a -> Parser (Posn, TokenT) b
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,tok) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case tok of
TokName String
s -> String -> Parser (Posn, TokenT) String
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
TokError String
_ -> (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 String
"a name" Posn
p TokenT
tok
TokenT
_ -> (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 a. String -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"a name" Posn
p TokenT
tok
string, freetext :: HParser String
string :: Parser (Posn, TokenT) String
string = do (p,t) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case t of TokName String
s -> String -> Parser (Posn, TokenT) String
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
TokenT
_ -> (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 a. String -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text" Posn
p TokenT
t
freetext :: Parser (Posn, TokenT) String
freetext = do (p,t) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
case t of TokFreeText String
s -> String -> Parser (Posn, TokenT) String
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
TokenT
_ -> (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 a. String -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text" Posn
p TokenT
t
maybe :: HParser a -> HParser (Maybe a)
maybe :: forall a. HParser a -> HParser (Maybe a)
maybe HParser a
p =
(a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> HParser a -> Parser (Posn, TokenT) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HParser a
p) Parser (Posn, TokenT) (Maybe a)
-> Parser (Posn, TokenT) (Maybe a)
-> Parser (Posn, TokenT) (Maybe a)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
Maybe a -> Parser (Posn, TokenT) (Maybe a)
forall a. a -> Parser (Posn, TokenT) 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 :: forall a b. HParser a -> HParser b -> HParser (Either a b)
either HParser a
p HParser b
q =
(a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b)
-> HParser a -> Parser (Posn, TokenT) (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HParser a
p) Parser (Posn, TokenT) (Either a b)
-> Parser (Posn, TokenT) (Either a b)
-> Parser (Posn, TokenT) (Either a b)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
(b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b)
-> HParser b -> Parser (Posn, TokenT) (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HParser b
q)
word :: String -> HParser ()
word :: String -> HParser ()
word String
s = do { x <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
; case x of
(Posn
_p,TokName String
n) | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> HParser ()
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Posn
_p,TokFreeText String
n) | String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
n -> () -> HParser ()
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
( Posn
p,t :: TokenT
t@(TokError String
_)) -> (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
( Posn
p,TokenT
t) -> (String -> HParser ()) -> String -> Posn -> TokenT -> HParser ()
forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser ()
forall a. String -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String
forall a. Show a => a -> String
show String
s) Posn
p TokenT
t
}
posn :: HParser Posn
posn :: HParser Posn
posn = do { x@(p,_) <- Parser (Posn, TokenT) (Posn, TokenT)
forall t. Parser t t
next
; reparse [x]
; return p
} HParser Posn -> HParser Posn -> HParser Posn
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Posn -> HParser Posn
forall a. a -> Parser (Posn, TokenT) a
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 :: forall a. String -> Parser (Posn, TokenT) a
failP String
msg = do { p <- HParser Posn
posn; fail (msg++"\n at "++show p) }
failBadP :: forall a. String -> Parser (Posn, TokenT) a
failBadP String
msg = do { p <- HParser Posn
posn; failBad (msg++"\n at "++show p) }
report :: (String->HParser a) -> String -> Posn -> TokenT -> HParser a
report :: forall a.
(String -> HParser a) -> String -> Posn -> TokenT -> HParser a
report String -> HParser a
fail String
expect Posn
p TokenT
t = String -> HParser a
fail (String
"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]
++String
" but found "String -> String -> String
forall a. [a] -> [a] -> [a]
++TokenT -> String
forall a. Show a => a -> String
show TokenT
t
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n 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
HParser a
p adjustErrP :: forall a. HParser a -> (String -> String) -> HParser a
`adjustErrP` 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 pn <- HParser Posn
posn
(p `adjustErr` f) `adjustErr` (++show 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 a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return Prolog
-> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document
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 a. HParser a -> (String -> String) -> HParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"unrecognisable XML prolog\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++))
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 a. a -> Parser (Posn, TokenT) a
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 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 String
"HTML document"))
return (case map snd ht of
[Element Posn
e] -> Element Posn
e
[Element Posn]
es -> QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N String
"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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Misc
misc
where mkCElem :: Element Posn -> Content Posn
mkCElem 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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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
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 -> Parser (Posn, TokenT) a
failP String
"processing instruction has no target"
f <- freetext
(tok TokPIClose `onFail` tok TokAnyClose) `onFail` failP "missing ?> or >"
return (n, 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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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
x <- HParser XMLDecl -> HParser (Maybe XMLDecl)
forall a. HParser a -> HParser (Maybe a)
maybe HParser XMLDecl
xmldecl
m1 <- many misc
dtd <- maybe doctypedecl
m2 <- many misc
return (Prolog x m1 dtd m2)
xmldecl :: HParser XMLDecl
xmldecl :: HParser XMLDecl
xmldecl = do
TokenT -> HParser TokenT
tok TokenT
TokPIOpen
String -> HParser ()
word String
"xml" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word String
"XML"
p <- HParser Posn
posn
s <- freetext
tok TokPIClose `onFail` failBadP "missing ?> in <?xml ...?>"
(return . fst . runParser aux . xmlReLex p) s
where
aux :: HParser XMLDecl
aux = do
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 -> Parser (Posn, TokenT) a
failP String
"missing XML version info"
e <- maybe encodingdecl
s <- maybe sddecl
return (XMLDecl v e s)
versioninfo :: HParser VersionInfo
versioninfo :: Parser (Posn, TokenT) String
versioninfo = do
String -> HParser ()
word String
"version" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word String
"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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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 a.
[(String, Parser (Posn, TokenT) a)] -> Parser (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"<!--comment-->", String -> Misc
Comment (String -> Misc)
-> Parser (Posn, TokenT) String -> Parser (Posn, TokenT) Misc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Posn, TokenT) String
comment)
, (String
"<?PI?>", ProcessingInstruction -> Misc
PI (ProcessingInstruction -> Misc)
-> HParser ProcessingInstruction -> Parser (Posn, TokenT) Misc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HParser ProcessingInstruction
processinginstruction)
]
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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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
n <- HParser QName
qname
eid <- maybe externalid
tok TokAnyClose `onFail` failP "missing > in DOCTYPE decl"
return (DTD n eid [])
sddecl :: HParser SDDecl
sddecl :: HParser Bool
sddecl = do
String -> HParser ()
word String
"standalone" HParser () -> HParser () -> HParser ()
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> HParser ()
word String
"STANDALONE"
HParser Bool -> HParser Bool
forall a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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 -> Parser (Posn, TokenT) a
failP String
"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 a. Parser (Posn, TokenT) a -> Parser (Posn, TokenT) a
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 String
"yes" HParser () -> HParser Bool -> HParser Bool
forall a b.
Parser (Posn, TokenT) a
-> Parser (Posn, TokenT) b -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> HParser Bool
forall a. a -> Parser (Posn, TokenT) a
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 String
"no" HParser () -> HParser Bool -> HParser Bool
forall a b.
Parser (Posn, TokenT) a
-> Parser (Posn, TokenT) b -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> HParser Bool
forall a. a -> Parser (Posn, TokenT) a
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 -> Parser (Posn, TokenT) a
failP String
"'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 String
ctx) =
do
TokenT -> HParser TokenT
tok TokenT
TokAnyOpen
(ElemTag (N e) avs) <- HParser ElemTag
elemtag
( if e `closes` ctx then
( do debug "/"
unparse ([TokEndOpen, TokName ctx, TokAnyClose,
TokAnyOpen, TokName e] ++ reformatAttrs avs)
return ([], Elem (N "null") [] []))
else if e `elem` selfclosingtags then
( do tok TokEndClose
debug (e++"[+]")
return ([], Elem (N e) avs [])) `onFail`
( do tok TokAnyClose
debug (e++"[+]")
return ([], Elem (N e) avs []))
else
( do tok TokEndClose
debug (e++"[]")
return ([], Elem (N e) avs [])) `onFail`
( do tok TokAnyClose `onFail` failP "missing > or /> in element tag"
debug (e++"[")
return (\ (Stack, [Content Posn])
interior-> let (Stack
stack,[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))
`apply`
(do zz <- manyFinally (content e)
(tok TokEndOpen)
(N n) <- qname
commit (tok TokAnyClose)
debug "]"
let (ss,cs) = unzip zz
let s = if [Stack] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stack]
ss then [] else [Stack] -> Stack
forall a. HasCallStack => [a] -> a
last [Stack]
ss
( if e == (map toLower n :: Name) then
do unparse (reformatTags (closeInner e s))
debug "^"
return ([], cs)
else
do unparse [TokEndOpen, TokName n, TokAnyClose]
debug "-"
return ((e,avs):s, cs)))
) `onFail` failP ("failed to repair non-matching tags in context: "++ctx))
closeInner :: Name -> [(Name,[Attribute])] -> [(Name,[Attribute])]
closeInner :: String -> Stack -> Stack
closeInner String
c 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 [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
Maybe [String]
Nothing -> Stack
ts
unparse :: [TokenT] -> Parser (Posn, TokenT) ()
unparse :: [TokenT] -> HParser ()
unparse [TokenT]
ts = do p <- HParser Posn
posn
reparse (zip (repeat p) ts)
reformatAttrs :: [(QName, AttValue)] -> [TokenT]
reformatAttrs :: [Attribute] -> [TokenT]
reformatAttrs = (Attribute -> [TokenT]) -> [Attribute] -> [TokenT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Attribute -> [TokenT]
f0
where f0 :: Attribute -> [TokenT]
f0 (N String
a, v :: AttValue
v@(AttValue [Either String Reference]
_)) = [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 = ((String, [Attribute]) -> [TokenT]) -> Stack -> [TokenT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Attribute]) -> [TokenT]
f0
where f0 :: (String, [Attribute]) -> [TokenT]
f0 (String
t,[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 String
ctx = do { p <- HParser Posn
posn ; content' p }
where content' :: Posn -> Parser (Posn, TokenT) (Stack, Content Posn)
content' Posn
p = [(String, Parser (Posn, TokenT) (Stack, Content Posn))]
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a.
[(String, Parser (Posn, TokenT) a)] -> Parser (Posn, TokenT) a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf'
[ ( String
"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 a b.
Parser (Posn, TokenT) a
-> (a -> Parser (Posn, TokenT) b) -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Stack
s,Element Posn
e)-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. a -> Parser (Posn, TokenT) a
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))
, ( String
"chardata", Parser (Posn, TokenT) String
chardata Parser (Posn, TokenT) String
-> (String -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a b.
Parser (Posn, TokenT) a
-> (a -> Parser (Posn, TokenT) b) -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. a -> Parser (Posn, TokenT) a
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))
, ( String
"reference", HParser Reference
reference HParser Reference
-> (Reference -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a b.
Parser (Posn, TokenT) a
-> (a -> Parser (Posn, TokenT) b) -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Reference
r-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Reference -> Posn -> Content Posn
forall i. Reference -> i -> Content i
CRef Reference
r Posn
p))
, ( String
"cdsect", Parser (Posn, TokenT) String
cdsect Parser (Posn, TokenT) String
-> (String -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a b.
Parser (Posn, TokenT) a
-> (a -> Parser (Posn, TokenT) b) -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
c-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. a -> Parser (Posn, TokenT) a
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))
, ( String
"misc", Parser (Posn, TokenT) Misc
misc Parser (Posn, TokenT) Misc
-> (Misc -> Parser (Posn, TokenT) (Stack, Content Posn))
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a b.
Parser (Posn, TokenT) a
-> (a -> Parser (Posn, TokenT) b) -> Parser (Posn, TokenT) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Misc
m-> (Stack, Content Posn)
-> Parser (Posn, TokenT) (Stack, Content Posn)
forall a. a -> Parser (Posn, TokenT) a
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` (String
"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) <- HParser QName
qname HParser QName -> (String -> String) -> HParser QName
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"malformed element tag\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
as <- many attribute
return (ElemTag (N (map toLower n)) as)
attribute :: HParser Attribute
attribute :: Parser (Posn, TokenT) Attribute
attribute = do
(N n) <- HParser QName
qname
v <- (do tok TokEqual
attvalue) `onFail`
return (AttValue [Left "TRUE"])
return (N (map toLower n), v)
s
String
"cdsect"map
Print.HughesPJ.html#text">text String
"where" Dotext Text.XML.HaXml.TypeMapping, Text.XML.HaXml.XmlContent.Parser, Text.XML.HaXml.XmlContent.Haskell, Text.XML.HaXml.XmlContent| Primitive | Text.XML.HaXml.Schema.XSDTypeModel |
| PrimitiveType | Text.XML.HaXml.Schema.8SDTypeModel |
| printableName | Text.XML.HaXml.Namespaces |
| ProcessContents | Just[ts
head ([(Ch\CA tml#TokenT">TokenTc-internal->HParser Reference
N (n -> () -> HParser ()
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> hs-var">TokQuote)Stack
Primitive | ng -> m Reference
\(TokenT
TokEqual,: HParser ExtParsedEnt
String
"SYSTEM"
<+> Doc -> (Name, [StructType]) -> Doc
(return (s-t3.0-inplace/src/GHC.Internal.List.html#head">headPosn
p = [(String, Parser (Posn, Titspan>Ponottext">HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) [Either String Reference]
-> Parser (Posn, TokenT) [Either String Referess="hs-special">(tribute] -> [Cspan>s-t3.0-inplace/src/GHC.Internal.List.html#head">TokEqual,"SYSTEM"
nnottext">[(String, Parser (Posn, Titspan>Ponottext">HParser TokenT
-> HParser TokenT
-> Parser (Posn, TokenT) [Either String Reference]
-> Parser (Posn, TokenT) [Either String Referest.html#head">headPosnhs-glyph">:: tribute] -> [Cspan>s-t3.0-inplace/src/GHC.Internal.List.htmarstkd">TokEqual,"SYSTEM"headPosnhs-glyph">:: tribute] -> [Cspan>s-t3.0-inplace/src/GHC:Internal.List.htmarstkd">TokEqual,"SYSTEM"headPosnhs-glyph">:: return ((. [(CharRef, String)] -> (CharRef, String)
forall a. HasCallStack => [a] -> a
headheadPosn
,= [(String, Parser (Posn, Titspan>c-> |
| PrimitiveType | nnottext">[(String, Parser (Posn, Titspan>Ponottext">HParser TokenT
-> HParser TokenT
-> Parse1 ss="annot">String -> TokenT
Ponottext">HParser TokenT
-> HParser TokenT
-al.Base.html#%3E%3E%3D">>>=,p>>= String -> HParser Reference
forall {m :: * -> *}. Monad m => String -> m Reference
CString Bool
(return (span class="hs;SYSTEM"
nnottext">[ =(return (span class="hs;SYSTEM"
nnottext">[ =(return (span class="hs;SYSTEM"
nnottext">[<(DefExternalID eid ndd))
ring
"where"
,= [(String, Parser (Posn,an>
attribute :: Parser (Posn, TokenT) Attribute
attrnnot">[(CharRef, String)] -> (CharRef/span>(TokName`adjustErrP`Parser (Posn, TokenT) String
freetexnnot">String
"STANDALONE"fier hs-var">freetexnnot">String
"STANDALONE"fier hs-var">freetexnnot">String
"STANDALONE"fier hs-var">freetexnnot">String
`adjustErrP`Parser (Posn, TokenT) String
|>| (CFilter i -> CFilter i
forall i. CFilter i -Ř—osn)
forall a. a -> Parser (Posn, TokenT) a
forall (m :: * -> *) a-Text.t;cdsect", <="hs-comment">-- ( word "EMPTY" >> return EMPTY) `onFai621679219434">sts
, ( String
"chardata",-var">`adjustErrP` (String
"when looking for a content item,\n" nnottext">[<(DefExternalID eid ndd))
<1pan id="line-624">ring
"whcre" --pe 8pe">i) -> content' CFilter i -> replace :: t -> t ->special">(isHexDigit = do
(N n)attvalue) `onFail`
(((
,= [(String, Parser (Posn,an>
attribute :: Parser (Posn, TokenT) Attribute
bracket (TokenT -> HParser TokenT
freetexnnot">String
(AttValue [(return (s-t3.0-inp/span>
freetexnnot">String
= , ((CharRef, Stringonad m =&l#v:elem_comment" title="Text.XML.HaXml.Schema.HaskellTypeModel">Text.Xxt.XML.HaXml.Html.Parsepan>
eral :: HParserg
freetexnnot">String
<"3ss="hs-operator hs-var"><+> [Char] -> ByteString
textoneOf'
[ ( |