1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
-- | Some helpers for making traversals of GIR documents easier.
module Data.GI.GIR.XMLUtils
( nodeToElement
, subelements
, localName
, lookupAttr
, GIRXMLNamespace(..)
, lookupAttrWithNamespace
, childElemsWithLocalName
, childElemsWithNSName
, firstChildWithLocalName
, getElementContent
, xmlLocalName
, xmlNSName
) where
import Text.XML (Element(elementNodes, elementName, elementAttributes),
Node(NodeContent, NodeElement), nameLocalName, Name(..))
import Data.Maybe (mapMaybe, listToMaybe)
import qualified Data.Map as M
import Data.Text (Text)
-- | Turn a node into an element (if it is indeed an element node).
nodeToElement :: Node -> Maybe Element
nodeToElement (NodeElement e) = Just e
nodeToElement _ = Nothing
-- | Find all children of the given element which are XML Elements
-- themselves.
subelements :: Element -> [Element]
subelements = mapMaybe nodeToElement . elementNodes
-- | The local name of an element.
localName :: Element -> Text
localName = nameLocalName . elementName
-- | Restrict to those with the given local name.
childElemsWithLocalName :: Text -> Element -> [Element]
childElemsWithLocalName n =
filter localNameMatch . subelements
where localNameMatch = (== n) . localName
-- | Restrict to those with given name.
childElemsWithNSName :: GIRXMLNamespace -> Text -> Element -> [Element]
childElemsWithNSName ns n = filter nameMatch . subelements
where nameMatch = (== name) . elementName
name = Name {
nameLocalName = n
, nameNamespace = Just (girNamespace ns)
, namePrefix = Nothing
}
-- | Find the first child element with the given name.
firstChildWithLocalName :: Text -> Element -> Maybe Element
firstChildWithLocalName n = listToMaybe . childElemsWithLocalName n
-- | Get the content of a given element, if it exists.
getElementContent :: Element -> Maybe Text
getElementContent = listToMaybe . mapMaybe getContent . elementNodes
where getContent :: Node -> Maybe Text
getContent (NodeContent t) = Just t
getContent _ = Nothing
-- | Lookup an attribute for an element (with no prefix).
lookupAttr :: Name -> Element -> Maybe Text
lookupAttr attr element = M.lookup attr (elementAttributes element)
-- | GIR namespaces we know about.
data GIRXMLNamespace = GLibGIRNS | CGIRNS | CoreGIRNS
deriving Show
-- | Return the text representation of the known GIR namespaces.
girNamespace :: GIRXMLNamespace -> Text
girNamespace GLibGIRNS = "http://www.gtk.org/introspection/glib/1.0"
girNamespace CGIRNS = "http://www.gtk.org/introspection/c/1.0"
girNamespace CoreGIRNS = "http://www.gtk.org/introspection/core/1.0"
-- | Lookup an attribute for an element, given the namespace where it lives.
lookupAttrWithNamespace :: GIRXMLNamespace -> Name -> Element -> Maybe Text
lookupAttrWithNamespace ns attr element =
let attr' = attr {nameNamespace = Just (girNamespace ns)}
in M.lookup attr' (elementAttributes element)
-- | Construct a `Text.XML.Name` by only giving the local name.
xmlLocalName :: Text -> Name
xmlLocalName n = Name { nameLocalName = n
, nameNamespace = Nothing
, namePrefix = Nothing }
-- | Construct a `Text.XML.Name` specifying a namespace too.
xmlNSName :: GIRXMLNamespace -> Text -> Name
xmlNSName ns n = Name { nameLocalName = n
, nameNamespace = Just (girNamespace ns)
, namePrefix = Nothing }
|
