{- |
   Module      : Text.Pandoc.Readers.Docx.StyleMaps
   Copyright   : © 2014-2020 Jesse Rosenthal <jrosenthal@jhu.edu>,
                   2014-2020 John MacFarlane <jgm@berkeley.edu>,
                   2015 Nikolay Yakimov <root@livid.pp.ru>
   License     : GNU GPL, version 2 or above

   Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
   Stability   : alpha
   Portability : portable

Docx reader utility functions.
-}
module Text.Pandoc.Readers.Docx.Util (
                                        NameSpaces
                                      , elemName
                                      , isElem
                                      , elemToNameSpaces
                                      , findChildByName
                                      , findChildrenByName
                                      , findAttrText
                                      , findAttrByName
                                      , findAttrTextByName
                                      ) where

import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Text.XML.Light

type NameSpaces = [(String, String)]

elemToNameSpaces :: Element -> NameSpaces
elemToNameSpaces :: Element -> NameSpaces
elemToNameSpaces = (Attr -> Maybe (String, String)) -> [Attr] -> NameSpaces
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attr -> Maybe (String, String)
attrToNSPair ([Attr] -> NameSpaces)
-> (Element -> [Attr]) -> Element -> NameSpaces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Attr]
elAttribs

attrToNSPair :: Attr -> Maybe (String, String)
attrToNSPair :: Attr -> Maybe (String, String)
attrToNSPair (Attr (QName String
s Maybe String
_ (Just String
"xmlns")) String
val) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
s, String
val)
attrToNSPair Attr
_                                     = Maybe (String, String)
forall a. Maybe a
Nothing

elemName :: NameSpaces -> String -> String -> QName
elemName :: NameSpaces -> String -> String -> QName
elemName NameSpaces
ns String
prefix String
name =
  String -> Maybe String -> Maybe String -> QName
QName String
name (String -> NameSpaces -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
prefix NameSpaces
ns) (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
prefix then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
prefix)

isElem :: NameSpaces -> String -> String -> Element -> Bool
isElem :: NameSpaces -> String -> String -> Element -> Bool
isElem NameSpaces
ns String
prefix String
name Element
element =
  let ns' :: NameSpaces
ns' = NameSpaces
ns NameSpaces -> NameSpaces -> NameSpaces
forall a. [a] -> [a] -> [a]
++ Element -> NameSpaces
elemToNameSpaces Element
element
  in QName -> String
qName (Element -> QName
elName Element
element) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
&&
     QName -> Maybe String
qURI (Element -> QName
elName Element
element) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> NameSpaces -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
prefix NameSpaces
ns'

findChildByName :: NameSpaces -> String -> String -> Element -> Maybe Element
findChildByName :: NameSpaces -> String -> String -> Element -> Maybe Element
findChildByName NameSpaces
ns String
pref String
name Element
el =
  let ns' :: NameSpaces
ns' = NameSpaces
ns NameSpaces -> NameSpaces -> NameSpaces
forall a. [a] -> [a] -> [a]
++ Element -> NameSpaces
elemToNameSpaces Element
el
  in  QName -> Element -> Maybe Element
findChild (NameSpaces -> String -> String -> QName
elemName NameSpaces
ns' String
pref String
name) Element
el

findChildrenByName :: NameSpaces -> String -> String -> Element -> [Element]
findChildrenByName :: NameSpaces -> String -> String -> Element -> [Element]
findChildrenByName NameSpaces
ns String
pref String
name Element
el =
  let ns' :: NameSpaces
ns' = NameSpaces
ns NameSpaces -> NameSpaces -> NameSpaces
forall a. [a] -> [a] -> [a]
++ Element -> NameSpaces
elemToNameSpaces Element
el
  in  QName -> Element -> [Element]
findChildren (NameSpaces -> String -> String -> QName
elemName NameSpaces
ns' String
pref String
name) Element
el

findAttrText :: QName -> Element -> Maybe T.Text
findAttrText :: QName -> Element -> Maybe Text
findAttrText QName
x = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Element -> Maybe String) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr QName
x

findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String
findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String
findAttrByName NameSpaces
ns String
pref String
name Element
el =
  let ns' :: NameSpaces
ns' = NameSpaces
ns NameSpaces -> NameSpaces -> NameSpaces
forall a. [a] -> [a] -> [a]
++ Element -> NameSpaces
elemToNameSpaces Element
el
  in  QName -> Element -> Maybe String
findAttr (NameSpaces -> String -> String -> QName
elemName NameSpaces
ns' String
pref String
name) Element
el

findAttrTextByName :: NameSpaces -> String -> String -> Element -> Maybe T.Text
findAttrTextByName :: NameSpaces -> String -> String -> Element -> Maybe Text
findAttrTextByName NameSpaces
a String
b String
c = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Element -> Maybe String) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaces -> String -> String -> Element -> Maybe String
findAttrByName NameSpaces
a String
b String
c