    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Readers.OOXML.Shared
       Copyright   : © 2025 Anton Antic
       License     : GNU GPL, version 2 or above

       Maintainer  : Anton Antic <anton@everworker.ai>
       Stability   : alpha
       Portability : portable

    Shared utilities for Office Open XML (OOXML) readers (DOCX, PPTX).
    Provides common functions for ZIP archive handling, XML parsing,
    namespace management, and DrawingML parsing.
    -}
    module Text.Pandoc.Readers.OOXML.Shared
      ( -- * Constants
        emusPerInch
      , emuToInches
      , inchesToEmu
        -- * Types
      , NameSpaces
      , elemName
      , elemToNameSpaces
      , isElem
      , findChildByName
      , findChildrenByName
      , findElementByName
      , findAttrByName
      ) where

    import qualified Data.Map as M
    import qualified Data.Text as T
    import Data.Text (Text)
    import Text.Pandoc.XML.Light

    -- | Type alias for namespace mappings
    type NameSpaces = M.Map Text Text

    -- | English Metric Units per inch
    -- 1 inch = 914400 EMUs (used in OOXML for dimensions)
    emusPerInch :: Integer
    emusPerInch :: Integer
    emusPerInch = Integer
    914400

    -- | Convert EMUs to inches
    emuToInches :: Integer -> Double
    emuToInches :: Integer -> Double
    emuToInches Integer
    n = Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    emusPerInch

    -- | Convert inches to EMUs
    inchesToEmu :: Double -> Integer
    inchesToEmu :: Double -> Integer
    inchesToEmu Double
    n = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    emusPerInch)

    -- | Extract namespace declarations from element attributes
    elemToNameSpaces :: Element -> NameSpaces
    elemToNameSpaces :: Element -> NameSpaces
    elemToNameSpaces = (Attr -> NameSpaces -> NameSpaces)
    -> NameSpaces -> [Attr] -> NameSpaces
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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 -> NameSpaces -> NameSpaces
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Text
    s Text
    val
                                  QName
    _ -> NameSpaces -> NameSpaces
    forall a. a -> a
    id) NameSpaces
    forall a. Monoid a => a
    mempty ([Attr] -> NameSpaces)
    -> (Element -> [Attr]) -> Element -> NameSpaces
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> [Attr]
    elAttribs

    -- | Create a qualified name from namespace map, prefix, and local name
    elemName :: NameSpaces -> Text -> Text -> QName
    elemName :: NameSpaces -> Text -> Text -> QName
    elemName NameSpaces
    ns Text
    prefix Text
    name =
      Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    name
            (Text -> NameSpaces -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    prefix NameSpaces
    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)

    -- | Check if element matches namespace prefix and local name
    isElem :: NameSpaces -> Text -> Text -> Element -> Bool
    isElem :: NameSpaces -> Text -> Text -> Element -> Bool
    isElem NameSpaces
    ns Text
    prefix Text
    name Element
    element =
      let ns' :: NameSpaces
    ns' = NameSpaces
    ns NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <> Element -> NameSpaces
    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 -> NameSpaces -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    prefix NameSpaces
    ns'

    -- | Find first child element matching namespace and name
    findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
    findChildByName NameSpaces
    ns Text
    pref Text
    name Element
    el =
      let ns' :: NameSpaces
    ns' = NameSpaces
    ns NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <> Element -> NameSpaces
    elemToNameSpaces Element
    el
      in  QName -> Element -> Maybe Element
    findChild (NameSpaces -> Text -> Text -> QName
    elemName NameSpaces
    ns' Text
    pref Text
    name) Element
    el

    -- | Find all children matching namespace and name
    findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
    findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
    findChildrenByName NameSpaces
    ns Text
    pref Text
    name Element
    el =
      let ns' :: NameSpaces
    ns' = NameSpaces
    ns NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <> Element -> NameSpaces
    elemToNameSpaces Element
    el
      in  QName -> Element -> [Element]
    findChildren (NameSpaces -> Text -> Text -> QName
    elemName NameSpaces
    ns' Text
    pref Text
    name) Element
    el

    -- | Find element anywhere in descendants matching namespace and name
    findElementByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
    findElementByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
    findElementByName NameSpaces
    ns Text
    pref Text
    name Element
    el =
      let ns' :: NameSpaces
    ns' = NameSpaces
    ns NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <> Element -> NameSpaces
    elemToNameSpaces Element
    el
      in  QName -> Element -> Maybe Element
    findElement (NameSpaces -> Text -> Text -> QName
    elemName NameSpaces
    ns' Text
    pref Text
    name) Element
    el

    -- | Find attribute value by namespace prefix and name
    findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
    findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
    findAttrByName NameSpaces
    ns Text
    pref Text
    name Element
    el =
      let ns' :: NameSpaces
    ns' = NameSpaces
    ns NameSpaces -> NameSpaces -> NameSpaces
    forall a. Semigroup a => a -> a -> a
    <> Element -> NameSpaces
    elemToNameSpaces Element
    el
      in  QName -> Element -> Maybe Text
    findAttr (NameSpaces -> Text -> Text -> QName
    elemName NameSpaces
    ns' Text
    pref Text
    name) Element
    el