    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Writers.OOXML
       Copyright   : Copyright (C) 2012-2020 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.Reader
    import Control.Monad.Except (throwError)
    import Text.Pandoc.Error
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.ByteString.Lazy.Char8 as BL8
    import Data.Maybe (mapMaybe)
    import qualified Data.Text as T
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import qualified Text.Pandoc.UTF8 as UTF8
    import Text.XML.Light as XML

    mknode :: Node t => String -> [(String,String)] -> t -> Element
    mknode :: String -> [(String, String)] -> t -> Element
    mknode s :: String
    s attrs :: [(String, String)]
    attrs =
      [Attr] -> Element -> Element
    add_attrs (((String, String) -> Attr) -> [(String, String)] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(k :: String
    k,v :: String
    v) -> QName -> String -> Attr
    Attr (String -> QName
    nodename String
    k) String
    v) [(String, String)]
    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 (String -> QName
    nodename String
    s)

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

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

    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 elt :: Element
    elt = String -> ByteString
    BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <>
      String -> ByteString
    UTF8.fromStringLazy (Element -> String
    showElement Element
    elt)

    parseXml :: PandocMonad m => Archive -> Archive -> String -> m Element
    parseXml :: Archive -> Archive -> String -> m Element
    parseXml refArchive :: Archive
    refArchive distArchive :: Archive
    distArchive relpath :: String
    relpath =
      case String -> Archive -> Maybe Entry
    findEntryByPath String
    relpath Archive
    refArchive Maybe Entry -> Maybe Entry -> Maybe Entry
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
             String -> Archive -> Maybe Entry
    findEntryByPath String
    relpath Archive
    distArchive of
                Nothing -> PandocError -> m Element
    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
    <> " missing in reference file"
                Just e :: Entry
    e  -> case String -> Maybe Element
    forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc (String -> Maybe Element)
    -> (Entry -> String) -> Entry -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    UTF8.toStringLazy (ByteString -> String) -> (Entry -> ByteString) -> Entry -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entry -> ByteString
    fromEntry (Entry -> Maybe Element) -> Entry -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ Entry
    e of
                           Nothing -> PandocError -> m Element
    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
    <> " corrupt in reference file"
                           Just d :: Element
    d  -> Element -> m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    d

    -- Copied from Util

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

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

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

    type NameSpaces = [(String, String)]

    -- | 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 (x :: Double
    x, y :: Double
    y) pageWidth :: 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 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 a b. (RealFrac a, Integral b) => a -> b
    floor Double
    x, Double -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    y)