module Text.XML.HaXml.Html.Parse
( htmlParse
, htmlParse'
) where
import Prelude hiding (either,maybe,sequence)
import qualified Prelude (either)
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.Namespaces
import Text.XML.HaXml.Lex
import Text.XML.HaXml.Posn
import Text.ParserCombinators.Poly.Plain
#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 = (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)
htmlParse' String
file
htmlParse' :: String -> String -> Either String (Document Posn)
htmlParse' :: String -> String -> Either String (Document Posn)
htmlParse' file :: String
file = (String -> Either String (Document Posn))
-> (Document Posn -> Either String (Document Posn))
-> Either String (Document Posn)
-> Either String (Document Posn)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> Either String (Document Posn)
forall a b. a -> Either a b
Left (Document Posn -> Either String (Document Posn)
forall a b. b -> Either a b
Right (Document Posn -> Either String (Document Posn))
-> (Document Posn -> Document Posn)
-> Document Posn
-> Either String (Document Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document Posn -> Document Posn
forall i. Document i -> Document i
simplify) (Either String (Document Posn) -> Either String (Document Posn))
-> (String -> Either String (Document Posn))
-> String
-> Either String (Document Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String (Document Posn), [(Posn, TokenT)])
-> Either String (Document Posn)
forall a b. (a, b) -> a
fst
((Either String (Document Posn), [(Posn, TokenT)])
-> Either String (Document Posn))
-> (String -> (Either String (Document Posn), [(Posn, TokenT)]))
-> String
-> Either String (Document Posn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Posn, TokenT) (Document Posn)
-> [(Posn, TokenT)]
-> (Either String (Document Posn), [(Posn, TokenT)])
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser Parser (Posn, TokenT) (Document Posn)
document ([(Posn, TokenT)]
-> (Either String (Document Posn), [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either String (Document Posn), [(Posn, TokenT)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Posn, TokenT)]
xmlLex String
file
simplify :: Document i -> Document i
simplify :: Document i -> Document i
simplify (Document p :: Prolog
p st :: SymTab EntityDef
st (Elem n :: QName
n avs :: [Attribute]
avs cs :: [Content i]
cs) ms :: [Misc]
ms) =
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document Prolog
p SymTab EntityDef
st (QName -> [Attribute] -> [Content i] -> Element i
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
n [Attribute]
avs ((Content i -> Bool) -> [Content i] -> [Content i]
forall i. (Content i -> Bool) -> [Content i] -> [Content i]
deepfilter Content i -> Bool
forall i. Content i -> Bool
simp [Content i]
cs)) [Misc]
ms
where
simp :: Content i -> Bool
simp (CElem (Elem (N "null") [] []) _) = Bool
False
simp (CElem (Elem t :: QName
t _ []) _)
| QName -> String
localName QName
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["font","p","i","b","em","tt","big","small"]
= Bool
False
simp _ = Bool
True
deepfilter :: (Content i -> Bool) -> [Content i] -> [Content i]
deepfilter f :: Content i -> Bool
f =
(Content i -> Bool) -> [Content i] -> [Content i]
forall a. (a -> Bool) -> [a] -> [a]
filter Content i -> Bool
f ([Content i] -> [Content i])
-> ([Content i] -> [Content i]) -> [Content i] -> [Content i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content i -> Content i) -> [Content i] -> [Content i]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Content i
c-> case Content i
c of
CElem (Elem t :: QName
t avs :: [Attribute]
avs cs :: [Content i]
cs) i :: i
i
-> Element i -> i -> Content i
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content i] -> Element i
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
t [Attribute]
avs ((Content i -> Bool) -> [Content i] -> [Content i]
deepfilter Content i -> Bool
f [Content i]
cs)) i
i
_ -> Content i
c)
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 :: Name -> Name -> 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
p <- HParser Prolog
prolog HParser Prolog -> (String -> String) -> HParser 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]
++)
[(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 (String -> Parser (Posn, TokenT) (Stack, Element Posn)
element "HTML document")
[Misc]
ms <- Parser (Posn, TokenT) Misc -> Parser (Posn, TokenT) [Misc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Posn, TokenT) Misc
misc
Document Posn -> Parser (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
forall a. SymTab a
emptyST (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))
[Misc]
ms)
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 :: HParser 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 -> HParser 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 ...?>"
((String -> HParser XMLDecl)
-> (XMLDecl -> HParser XMLDecl)
-> Either String XMLDecl
-> HParser XMLDecl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either String -> HParser XMLDecl
forall a. String -> HParser a
failP XMLDecl -> HParser XMLDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String XMLDecl -> HParser XMLDecl)
-> (String -> Either String XMLDecl) -> String -> HParser XMLDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String XMLDecl, [(Posn, TokenT)]) -> Either String XMLDecl
forall a b. (a, b) -> a
fst ((Either String XMLDecl, [(Posn, TokenT)])
-> Either String XMLDecl)
-> (String -> (Either String XMLDecl, [(Posn, TokenT)]))
-> String
-> Either String XMLDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HParser XMLDecl
-> [(Posn, TokenT)] -> (Either String XMLDecl, [(Posn, TokenT)])
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser HParser XMLDecl
aux ([(Posn, TokenT)] -> (Either String XMLDecl, [(Posn, TokenT)]))
-> (String -> [(Posn, TokenT)])
-> String
-> (Either 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 :: Name -> HParser (Stack,Element Posn)
element :: String -> Parser (Posn, TokenT) (Stack, Element Posn)
element 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)]
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, 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 [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, Element Posn)
-> Parser (Posn, TokenT) (Stack, Element 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), QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N String
e) [Attribute]
avs [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 (a :: QName
a, v :: AttValue
v@(AttValue _)) = [ String -> TokenT
TokName (QName -> String
printableName QName
a), TokenT
TokEqual
, TokenT
TokQuote, String -> TokenT
TokFreeText (AttValue -> String
forall a. Show a => a -> String
show AttValue
v), TokenT
TokQuote ]
reformatTags :: [(String, [(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", String -> Parser (Posn, TokenT) (Stack, Element Posn)
element 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 (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ (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 (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ (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