{-# 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 -> Map Text Text
elemToNameSpaces = (Attr -> Map Text Text -> Map Text Text)
-> Map Text Text -> [Attr] -> Map Text Text
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 -> 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

-- | Create a qualified name from namespace map, prefix, and local name
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)

-- | Check if element matches namespace prefix and local name
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'

-- | Find first child element matching namespace and name
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

-- | Find all children matching namespace and name
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

-- | Find element anywhere in descendants matching namespace and name
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

-- | Find attribute value by namespace prefix and name
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