-- | 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 :: Node -> Maybe Element
nodeToElement (NodeElement Element
e) = Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e
nodeToElement Node
_               = Maybe Element
forall a. Maybe a
Nothing

-- | Find all children of the given element which are XML Elements
-- themselves.
subelements :: Element -> [Element]
subelements :: Element -> [Element]
subelements = (Node -> Maybe Element) -> [Node] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Element
nodeToElement ([Node] -> [Element])
-> (Element -> [Node]) -> Element -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Node]
elementNodes

-- | The local name of an element.
localName :: Element -> Text
localName :: Element -> Text
localName = Name -> Text
nameLocalName (Name -> Text) -> (Element -> Name) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName

-- | Restrict to those with the given local name.
childElemsWithLocalName :: Text -> Element -> [Element]
childElemsWithLocalName :: Text -> Element -> [Element]
childElemsWithLocalName Text
n =
    (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter Element -> Bool
localNameMatch ([Element] -> [Element])
-> (Element -> [Element]) -> Element -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
subelements
    where localNameMatch :: Element -> Bool
localNameMatch = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool) -> (Element -> Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
localName

-- | Restrict to those with given name.
childElemsWithNSName :: GIRXMLNamespace -> Text -> Element -> [Element]
childElemsWithNSName :: GIRXMLNamespace -> Text -> Element -> [Element]
childElemsWithNSName GIRXMLNamespace
ns Text
n = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter Element -> Bool
nameMatch ([Element] -> [Element])
-> (Element -> [Element]) -> Element -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
subelements
    where nameMatch :: Element -> Bool
nameMatch = (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName
          name :: Name
name = Name {
                   nameLocalName :: Text
nameLocalName = Text
n
                 , nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just (GIRXMLNamespace -> Text
girNamespace GIRXMLNamespace
ns)
                 , namePrefix :: Maybe Text
namePrefix = Maybe Text
forall a. Maybe a
Nothing
                 }

-- | Find the first child element with the given name.
firstChildWithLocalName :: Text -> Element -> Maybe Element
firstChildWithLocalName :: Text -> Element -> Maybe Element
firstChildWithLocalName Text
n = [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe ([Element] -> Maybe Element)
-> (Element -> [Element]) -> Element -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element -> [Element]
childElemsWithLocalName Text
n

-- | Get the content of a given element, if it exists.
getElementContent :: Element -> Maybe Text
getElementContent :: Element -> Maybe Text
getElementContent = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text)
-> (Element -> [Text]) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Maybe Text) -> [Node] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Text
getContent ([Node] -> [Text]) -> (Element -> [Node]) -> Element -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Node]
elementNodes
    where getContent :: Node -> Maybe Text
          getContent :: Node -> Maybe Text
getContent (NodeContent Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
          getContent Node
_ = Maybe Text
forall a. Maybe a
Nothing

-- | Lookup an attribute for an element (with no prefix).
lookupAttr :: Name -> Element -> Maybe Text
lookupAttr :: Name -> Element -> Maybe Text
lookupAttr Name
attr Element
element = Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
attr (Element -> Map Name Text
elementAttributes Element
element)

-- | GIR namespaces we know about.
data GIRXMLNamespace = GLibGIRNS | CGIRNS | CoreGIRNS
                     deriving Int -> GIRXMLNamespace -> ShowS
[GIRXMLNamespace] -> ShowS
GIRXMLNamespace -> String
(Int -> GIRXMLNamespace -> ShowS)
-> (GIRXMLNamespace -> String)
-> ([GIRXMLNamespace] -> ShowS)
-> Show GIRXMLNamespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GIRXMLNamespace -> ShowS
showsPrec :: Int -> GIRXMLNamespace -> ShowS
$cshow :: GIRXMLNamespace -> String
show :: GIRXMLNamespace -> String
$cshowList :: [GIRXMLNamespace] -> ShowS
showList :: [GIRXMLNamespace] -> ShowS
Show

-- | Return the text representation of the known GIR namespaces.
girNamespace :: GIRXMLNamespace -> Text
girNamespace :: GIRXMLNamespace -> Text
girNamespace GIRXMLNamespace
GLibGIRNS = Text
"http://www.gtk.org/introspection/glib/1.0"
girNamespace GIRXMLNamespace
CGIRNS = Text
"http://www.gtk.org/introspection/c/1.0"
girNamespace GIRXMLNamespace
CoreGIRNS = Text
"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 :: GIRXMLNamespace -> Name -> Element -> Maybe Text
lookupAttrWithNamespace GIRXMLNamespace
ns Name
attr Element
element =
    let attr' :: Name
attr' = Name
attr {nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just (GIRXMLNamespace -> Text
girNamespace GIRXMLNamespace
ns)}
    in Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
attr' (Element -> Map Name Text
elementAttributes Element
element)


-- | Construct a `Text.XML.Name` by only giving the local name.
xmlLocalName :: Text -> Name
xmlLocalName :: Text -> Name
xmlLocalName Text
n = Name { nameLocalName :: Text
nameLocalName = Text
n
                      , nameNamespace :: Maybe Text
nameNamespace = Maybe Text
forall a. Maybe a
Nothing
                      , namePrefix :: Maybe Text
namePrefix = Maybe Text
forall a. Maybe a
Nothing }

-- | Construct a `Text.XML.Name` specifying a namespace too.
xmlNSName :: GIRXMLNamespace -> Text -> Name
xmlNSName :: GIRXMLNamespace -> Text -> Name
xmlNSName GIRXMLNamespace
ns Text
n = Name { nameLocalName :: Text
nameLocalName = Text
n
                      , nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just (GIRXMLNamespace -> Text
girNamespace GIRXMLNamespace
ns)
                      , namePrefix :: Maybe Text
namePrefix = Maybe Text
forall a. Maybe a
Nothing }