{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.Docx.Util (
NameSpaces
, elemName
, isElem
, elemToNameSpaces
, findChildByName
, findChildrenByName
, findElementByName
, findAttrByName
) where
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.XML.Light
import qualified Data.Map as M
type NameSpaces = M.Map Text Text
elemToNameSpaces :: Element -> NameSpaces
elemToNameSpaces :: Element -> Map Text Text
elemToNameSpaces = (Attr -> Map Text Text -> Map Text Text)
-> Map Text Text -> [Attr] -> Map Text Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Attr QName
qn Text
val) ->
case QName
qn of
QName Text
s Maybe Text
_ (Just Text
"xmlns") -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
s Text
val
QName
_ -> Map Text Text -> Map Text Text
forall a. a -> a
id) Map Text Text
forall a. Monoid a => a
mempty ([Attr] -> Map Text Text)
-> (Element -> [Attr]) -> Element -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Attr]
elAttribs
elemName :: NameSpaces -> Text -> Text -> QName
elemName :: Map Text Text -> Text -> Text -> QName
elemName Map Text Text
ns Text
prefix Text
name =
Text -> Maybe Text -> Maybe Text -> QName
QName Text
name (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
prefix Map Text Text
ns)
(if Text -> Bool
T.null Text
prefix then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix)
isElem :: NameSpaces -> Text -> Text -> Element -> Bool
isElem :: Map Text Text -> Text -> Text -> Element -> Bool
isElem Map Text Text
ns Text
prefix Text
name Element
element =
let ns' :: Map Text Text
ns' = Map Text Text
ns Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Element -> Map Text Text
elemToNameSpaces Element
element
in QName -> Text
qName (Element -> QName
elName Element
element) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name Bool -> Bool -> Bool
&&
QName -> Maybe Text
qURI (Element -> QName
elName Element
element) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
prefix Map Text Text
ns'
findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName :: Map Text Text -> Text -> Text -> Element -> Maybe Element
findChildByName Map Text Text
ns Text
pref Text
name Element
el =
let ns' :: Map Text Text
ns' = Map Text Text
ns Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Element -> Map Text Text
elemToNameSpaces Element
el
in QName -> Element -> Maybe Element
findChild (Map Text Text -> Text -> Text -> QName
elemName Map Text Text
ns' Text
pref Text
name) Element
el
findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName :: Map Text Text -> Text -> Text -> Element -> [Element]
findChildrenByName Map Text Text
ns Text
pref Text
name Element
el =
let ns' :: Map Text Text
ns' = Map Text Text
ns Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Element -> Map Text Text
elemToNameSpaces Element
el
in QName -> Element -> [Element]
findChildren (Map Text Text -> Text -> Text -> QName
elemName Map Text Text
ns' Text
pref Text
name) Element
el
findElementByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
findElementByName :: Map Text Text -> Text -> Text -> Element -> Maybe Element
findElementByName Map Text Text
ns Text
pref Text
name Element
el =
let ns' :: Map Text Text
ns' = Map Text Text
ns Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Element -> Map Text Text
elemToNameSpaces Element
el
in QName -> Element -> Maybe Element
findElement (Map Text Text -> Text -> Text -> QName
elemName Map Text Text
ns' Text
pref Text
name) Element
el
findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName :: Map Text Text -> Text -> Text -> Element -> Maybe Text
findAttrByName Map Text Text
ns Text
pref Text
name Element
el =
let ns' :: Map Text Text
ns' = Map Text Text
ns Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Element -> Map Text Text
elemToNameSpaces Element
el
in QName -> Element -> Maybe Text
findAttr (Map Text Text -> Text -> Text -> QName
elemName Map Text Text
ns' Text
pref Text
name) Element
el