{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.OOXML
   Copyright   : Copyright (C) 2012-2023 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 (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) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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 = 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 = 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 (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, forall a. Maybe a
Nothing)
                                       Just (Char
_,Text
zs) -> (Text
zs, forall a. a -> Maybe a
Just Text
xs)

toLazy :: B.ByteString -> BL.ByteString
toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 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 -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError forall a b. (a -> b) -> a -> b
$
                        String -> Text
T.pack String
relpath forall a. Semigroup a => a -> a -> a
<> Text
" missing in reference file"
            Just Entry
e  -> case Text -> Either Text Element
parseXMLElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toTextLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry forall a b. (a -> b) -> a -> b
$ Entry
e of
                       Left Text
msg ->
                         forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError (String -> Text
T.pack String
relpath) Text
msg
                       Right Element
d  -> 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) = forall a. a -> Maybe a
Just (Text
s, Text
val)
attrToNSPair Attr
_                                     = forall a. Maybe a
Nothing


elemToNameSpaces :: Element -> NameSpaces
elemToNameSpaces :: Element -> [(Text, Text)]
elemToNameSpaces = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attr -> Maybe (Text, Text)
attrToNSPair 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 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
prefix [(Text, Text)]
ns) (if Text -> Bool
T.null Text
prefix then forall a. Maybe a
Nothing else 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 forall a. [a] -> [a] -> [a]
++ Element -> [(Text, Text)]
elemToNameSpaces Element
element
  in QName -> Text
qName (Element -> QName
elName Element
element) forall a. Eq a => a -> a -> Bool
== Text
name Bool -> Bool -> Bool
&&
     QName -> Maybe Text
qURI (Element -> QName
elName Element
element) forall a. Eq a => a -> a -> Bool
== 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 forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pageWidth =
    (Integer
pageWidth, forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pageWidth forall a. Fractional a => a -> a -> a
/ Double
x) forall a. Num a => a -> a -> a
* Double
y)
  | Bool
otherwise = (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x, forall a b. (RealFrac a, Integral b) => a -> b
floor Double
y)