    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Writers.OOXML
       Copyright   : Copyright (C) 2012-2024 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    Functions common to OOXML writers (Docx and Powerpoint)
    -}
    module Text.Pandoc.Writers.OOXML ( mknode
                                     , mktnode
                                     , nodename
                                     , toLazy
                                     , renderXml
                                     , parseXml
                                     , elemToNameSpaces
                                     , elemName
                                     , isElem
                                     , NameSpaces
                                     , fitToPage
                                     ) where

    import Codec.Archive.Zip
    import Control.Monad (mplus)
    import Control.Monad.Except (throwError)
    import Text.Pandoc.Error
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import Data.Maybe (mapMaybe)
    import qualified Data.Text as T
    import Data.Text (Text)
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import qualified Text.Pandoc.UTF8 as UTF8
    import Text.Pandoc.XML.Light

    mknode :: Node t => Text -> [(Text,Text)] -> t -> Element
    mknode :: forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    s [(Text, Text)]
    attrs =
      [Attr] -> Element -> Element
    add_attrs (((Text, Text) -> Attr) -> [(Text, Text)] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Text
    k,Text
    v) -> QName -> Text -> Attr
    Attr (Text -> QName
    nodename Text
    k) Text
    v) [(Text, Text)]
    attrs) (Element -> Element) -> (t -> Element) -> t -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  QName -> t -> Element
    forall t. Node t => QName -> t -> Element
    node (Text -> QName
    nodename Text
    s)

    mktnode :: Text -> [(Text,Text)] -> T.Text -> Element
    mktnode :: Text -> [(Text, Text)] -> Text -> Element
    mktnode Text
    s [(Text, Text)]
    attrs = Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    s [(Text, Text)]
    attrs

    nodename :: Text -> QName
    nodename :: Text -> QName
    nodename Text
    s = QName{ qName :: Text
    qName = Text
    name, qURI :: Maybe Text
    qURI = Maybe Text
    forall a. Maybe a
    Nothing, qPrefix :: Maybe Text
    qPrefix = Maybe Text
    prefix }
     where (Text
    name, Maybe Text
    prefix) = case (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ':') Text
    s of
                              (Text
    xs,Text
    ys) -> case Text -> Maybe (Char, Text)
    T.uncons Text
    ys of
                                           Maybe (Char, Text)
    Nothing     -> (Text
    xs, Maybe Text
    forall a. Maybe a
    Nothing)
                                           Just (Char
    _,Text
    zs) -> (Text
    zs, Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    xs)

    toLazy :: B.ByteString -> BL.ByteString
    toLazy :: ByteString -> ByteString
    toLazy = [ByteString] -> ByteString
    BL.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[])

    renderXml :: Element -> BL.ByteString
    renderXml :: Element -> ByteString
    renderXml Element
    elt = ByteString -> ByteString
    BL.fromStrict (Text -> ByteString
    UTF8.fromText (Element -> Text
    showTopElement Element
    elt))

    parseXml :: PandocMonad m => Archive -> Archive -> String -> m Element
    parseXml :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    relpath =
      case String -> Archive -> Maybe Entry
    findEntryByPath String
    relpath Archive
    refArchive Maybe Entry -> Maybe Entry -> Maybe Entry
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
             String -> Archive -> Maybe Entry
    findEntryByPath String
    relpath Archive
    distArchive of
                Maybe Entry
    Nothing -> PandocError -> m Element
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m Element) -> PandocError -> m Element
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $
                            String -> Text
    T.pack String
    relpath Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " missing in reference file"
                Just Entry
    e  -> case Text -> Either Text Element
    parseXMLElement (Text -> Either Text Element)
    -> (Entry -> Text) -> Entry -> Either Text Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    UTF8.toTextLazy (ByteString -> Text) -> (Entry -> ByteString) -> Entry -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entry -> ByteString
    fromEntry (Entry -> Either Text Element) -> Entry -> Either Text Element
    forall a b. (a -> b) -> a -> b
    $ Entry
    e of
                           Left Text
    msg ->
                             PandocError -> m Element
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m Element) -> PandocError -> m Element
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocXMLError (String -> Text
    T.pack String
    relpath) Text
    msg
                           Right Element
    d  -> Element -> m Element
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    d

    -- Copied from Util

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

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

    elemName :: NameSpaces -> Text -> Text -> QName
    elemName :: [(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    prefix Text
    name =
      Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    name (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    prefix [(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 :: [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    prefix Text
    name Element
    element =
      let ns' :: [(Text, Text)]
    ns' = [(Text, Text)]
    ns [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++ Element -> [(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 -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    prefix [(Text, Text)]
    ns'

    type NameSpaces = [(Text, Text)]

    -- | Scales the image to fit the page
    -- sizes are passed in emu
    fitToPage :: (Double, Double) -> Integer -> (Integer, Integer)
    fitToPage :: (Double, Double) -> Integer -> (Integer, Integer)
    fitToPage (Double
    x, Double
    y) Integer
    pageWidth
      -- Fixes width to the page width and scales the height
      | Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    pageWidth =
        (Integer
    pageWidth, Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ (Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    pageWidth Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    x) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    y)
      | Bool
    otherwise = (Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    x, Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    y)