module Text.XML.Light.Input (parseXML,parseXMLDoc) where
import Text.XML.Light.Lexer
import Text.XML.Light.Types
import Text.XML.Light.Proc
import Text.XML.Light.Output(tagEnd)
import Data.List(isPrefixOf)
parseXMLDoc :: XmlSource s => s -> Maybe Element
parseXMLDoc :: forall s. XmlSource s => s -> Maybe Element
parseXMLDoc s
xs = [Content] -> Maybe Element
strip (s -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML s
xs)
where strip :: [Content] -> Maybe Element
strip [Content]
cs = case [Content] -> [Element]
onlyElems [Content]
cs of
Element
e : [Element]
es
| String
"?xml" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` QName -> String
qName (Element -> QName
elName Element
e)
-> [Content] -> Maybe Element
strip ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
es)
| Bool
otherwise -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e
[Element]
_ -> Maybe Element
forall a. Maybe a
Nothing
parseXML :: XmlSource s => s -> [Content]
parseXML :: forall s. XmlSource s => s -> [Content]
parseXML = [Token] -> [Content]
parse ([Token] -> [Content]) -> (s -> [Token]) -> s -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [Token]
forall source. XmlSource source => source -> [Token]
tokens
parse :: [Token] -> [Content]
parse :: [Token] -> [Content]
parse [] = []
parse [Token]
ts = let ([Content]
es,[QName]
_,[Token]
ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes ([],Maybe String
forall a. Maybe a
Nothing) [] [Token]
ts
in [Content]
es [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Token] -> [Content]
parse [Token]
ts1
type NSInfo = ([(String,String)],Maybe String)
nodes :: NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes :: NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
ns [QName]
ps (TokCRef String
ref : [Token]
ts) =
let ([Content]
es,[QName]
qs,[Token]
ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
ns [QName]
ps [Token]
ts
in (String -> Content
CRef String
ref Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
es, [QName]
qs, [Token]
ts1)
nodes NSInfo
ns [QName]
ps (TokText CData
txt : [Token]
ts) =
let ([Content]
es,[QName]
qs,[Token]
ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
ns [QName]
ps [Token]
ts
(String
more,[Content]
es1) = case [Content]
es of
Text CData
cd : [Content]
es1'
| CData -> CDataKind
cdVerbatim CData
cd CDataKind -> CDataKind -> Bool
forall a. Eq a => a -> a -> Bool
== CData -> CDataKind
cdVerbatim CData
txt -> (CData -> String
cdData CData
cd,[Content]
es1')
[Content]
_ -> ([],[Content]
es)
in (CData -> Content
Text CData
txt { cdData = cdData txt ++ more } Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
es1, [QName]
qs, [Token]
ts1)
nodes NSInfo
cur_info [QName]
ps (TokStart Line
p QName
t [Attr]
as Bool
empty : [Token]
ts) = (Content
node Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
siblings, [QName]
open, [Token]
toks)
where
new_name :: QName
new_name = NSInfo -> QName -> QName
annotName NSInfo
new_info QName
t
new_info :: NSInfo
new_info = (Attr -> NSInfo -> NSInfo) -> NSInfo -> [Attr] -> NSInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Attr -> NSInfo -> NSInfo
addNS NSInfo
cur_info [Attr]
as
node :: Content
node = Element -> Content
Elem Element { elLine :: Maybe Line
elLine = Line -> Maybe Line
forall a. a -> Maybe a
Just Line
p
, elName :: QName
elName = QName
new_name
, elAttribs :: [Attr]
elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (NSInfo -> Attr -> Attr
annotAttr NSInfo
new_info) [Attr]
as
, elContent :: [Content]
elContent = [Content]
children
}
([Content]
children,([Content]
siblings,[QName]
open,[Token]
toks))
| Bool
empty = ([], NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
cur_info [QName]
ps [Token]
ts)
| Bool
otherwise = let ([Content]
es1,[QName]
qs1,[Token]
ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
new_info (QName
new_nameQName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
:[QName]
ps) [Token]
ts
in ([Content]
es1,
case [QName]
qs1 of
[] -> NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
cur_info [QName]
ps [Token]
ts1
QName
_ : [QName]
qs3 -> ([],[QName]
qs3,[Token]
ts1))
nodes NSInfo
ns [QName]
ps (TokEnd Line
p QName
t : [Token]
ts) = let t1 :: QName
t1 = NSInfo -> QName -> QName
annotName NSInfo
ns QName
t
in case (QName -> Bool) -> [QName] -> ([QName], [QName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (QName
t1 QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==) [QName]
ps of
([QName]
as,QName
_:[QName]
_) -> ([],[QName]
as,[Token]
ts)
([QName]
_,[]) ->
let ([Content]
es,[QName]
qs,[Token]
ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
nodes NSInfo
ns [QName]
ps [Token]
ts
in (CData -> Content
Text CData {
cdLine :: Maybe Line
cdLine = Line -> Maybe Line
forall a. a -> Maybe a
Just Line
p,
cdVerbatim :: CDataKind
cdVerbatim = CDataKind
CDataText,
cdData :: String
cdData = QName -> String -> String
tagEnd QName
t String
""
} Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
es,[QName]
qs, [Token]
ts1)
nodes NSInfo
_ [QName]
ps [] = ([],[QName]
ps,[])
annotName :: NSInfo -> QName -> QName
annotName :: NSInfo -> QName -> QName
annotName ([(String, String)]
namespaces,Maybe String
def_ns) QName
n =
QName
n { qURI = maybe def_ns (`lookup` namespaces) (qPrefix n) }
annotAttr :: NSInfo -> Attr -> Attr
annotAttr :: NSInfo -> Attr -> Attr
annotAttr NSInfo
ns a :: Attr
a@(Attr { attrKey :: Attr -> QName
attrKey = QName
k}) =
case (QName -> Maybe String
qPrefix QName
k, QName -> String
qName QName
k) of
(Maybe String
Nothing, String
_) -> Attr
a
(Maybe String, String)
_ -> Attr
a { attrKey = annotName ns k }
addNS :: Attr -> NSInfo -> NSInfo
addNS :: Attr -> NSInfo -> NSInfo
addNS (Attr { attrKey :: Attr -> QName
attrKey = QName
key, attrVal :: Attr -> String
attrVal = String
val }) ([(String, String)]
ns,Maybe String
def) =
case (QName -> Maybe String
qPrefix QName
key, QName -> String
qName QName
key) of
(Maybe String
Nothing,String
"xmlns") -> ([(String, String)]
ns, if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
val then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
val)
(Just String
"xmlns", String
k) -> ((String
k, String
val) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
ns, Maybe String
def)
(Maybe String, String)
_ -> ([(String, String)]
ns,Maybe String
def)