{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TypeApplications    #-}
{- |
   Module      : Text.Pandoc.Writers.Docx
   Copyright   : Copyright (C) 2012-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to docx.
-}
module Text.Pandoc.Writers.Docx.OpenXML ( writeOpenXML, maxListLevel ) where

import Control.Monad (when, unless)
import Control.Applicative ((<|>))
import Control.Monad.Except (catchError)
import Crypto.Hash (hashWith, SHA1(SHA1))
import qualified Data.ByteString.Lazy as BL
import Data.Char (isLetter, isSpace)
import Text.Pandoc.Char (isCJK)
import Data.Ord (comparing)
import Data.String (fromString)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, maybeToList, isJust)
import Control.Monad.State ( gets, modify, MonadTrans(lift) )
import Control.Monad.Reader ( asks, MonadReader(local) )
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import Skylighting
import Text.DocLayout (hcat, vcat, literal, render)
import Text.Pandoc.Class (PandocMonad, report, getMediaBag)
import Text.Pandoc.Translations (Term(Abstract), translateTerm)
import Text.Pandoc.MediaBag (lookupMedia, MediaItem(..))
import qualified Text.Pandoc.Translations as Term
import qualified Text.Pandoc.Class.PandocMonad as P
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.UTF8 (fromText)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (highlight)
import Text.Pandoc.Templates (compileDefaultTemplate, renderTemplate)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
import Text.Pandoc.Options
import Text.Pandoc.Writers.Docx.StyleMap
import Text.Pandoc.Writers.Docx.Table as Table
import Text.Pandoc.Writers.Docx.Types
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import qualified Text.Pandoc.Writers.GridTable as Grid
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.TeXMath
import Text.Pandoc.Writers.OOXML
import Text.Pandoc.XML.Light as XML
import Data.List (sortBy, intercalate, groupBy)

-- from wml.xsd EG_RPrBase
rPrTagOrder :: M.Map Text Int
rPrTagOrder :: Map Text Int
rPrTagOrder =
  [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  ([Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ Text
"rStyle"
    , Text
"rFonts"
    , Text
"b"
    , Text
"bCs"
    , Text
"i"
    , Text
"iCs"
    , Text
"caps"
    , Text
"smallCaps"
    , Text
"strike"
    , Text
"dstrike"
    , Text
"outline"
    , Text
"shadow"
    , Text
"emboss"
    , Text
"imprint"
    , Text
"noProof"
    , Text
"snapToGrid"
    , Text
"vanish"
    , Text
"webHidden"
    , Text
"color"
    , Text
"spacing"
    , Text
"w"
    , Text
"kern"
    , Text
"position"
    , Text
"sz"
    , Text
"szCs"
    , Text
"highlight"
    , Text
"u"
    , Text
"effect"
    , Text
"bdr"
    , Text
"shd"
    , Text
"fitText"
    , Text
"vertAlign"
    , Text
"rtl"
    , Text
"cs"
    , Text
"em"
    , Text
"lang"
    , Text
"eastAsianLayout"
    , Text
"specVanish"
    , Text
"oMath"
    ] [Int
0..])

sortSquashed :: [Element] -> [Element]
sortSquashed :: [Element] -> [Element]
sortSquashed [Element]
l =
  (Element -> Element -> Ordering) -> [Element] -> [Element]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Element -> Int) -> Element -> Element -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Element -> Int
tagIndex) [Element]
l
  where
    tagIndex :: Element -> Int
    tagIndex :: Element -> Int
tagIndex Element
el =
      Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tag Map Text Int
rPrTagOrder)
      where tag :: Text
tag = (QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
el

squashProps :: EnvProps -> [Element]
squashProps :: EnvProps -> [Element]
squashProps (EnvProps Maybe Element
Nothing [Element]
es) = [Element] -> [Element]
sortSquashed [Element]
es
squashProps (EnvProps (Just Element
e) [Element]
es) = [Element] -> [Element]
sortSquashed (Element
e Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
es)

-- | Certain characters are invalid in XML even if escaped.
-- See #1992
stripInvalidChars :: Text -> Text
stripInvalidChars :: Text -> Text
stripInvalidChars = (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isValidChar

-- | See XML reference
isValidChar :: Char -> Bool
isValidChar :: Char -> Bool
isValidChar Char
'\t' = Bool
True
isValidChar Char
'\n' = Bool
True
isValidChar Char
'\r' = Bool
True
isValidChar Char
'\xFFFE' = Bool
False
isValidChar Char
'\xFFFF' = Bool
False
isValidChar Char
c = (Char
' ' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD7FF') Bool -> Bool -> Bool
|| (Char
'\xE000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c)

-- this is the lowest number used for a list numId
baseListId :: Int
baseListId :: Int
baseListId = Int
1000

getNumId :: (PandocMonad m) => WS m Int
getNumId :: forall (m :: * -> *). PandocMonad m => WS m Int
getNumId = (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int
baseListId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (WriterState -> Int) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListMarker] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ListMarker] -> Int)
-> (WriterState -> [ListMarker]) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [ListMarker]
stLists)

makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeTOC :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeTOC WriterOptions
opts = do
  let depth :: Text
depth = Text
"1-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
  let tocCmd :: Text
tocCmd = Text
"TOC \\o \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
depth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" \\h \\z \\u"
  tocTitle <- (WriterState -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Inline]
stTocTitle
  title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle])
  return
    [mknode "w:sdt" [] [
      mknode "w:sdtPr" [] (
        mknode "w:docPartObj" []
          [mknode "w:docPartGallery" [("w:val","Table of Contents")] (),
          mknode "w:docPartUnique" [] ()]
         -- w:docPartObj
      ), -- w:sdtPr
      mknode "w:sdtContent" [] (title ++ [ Elem $
        mknode "w:p" [] (
          mknode "w:r" [] [
            mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
            mknode "w:instrText" [("xml:space","preserve")] tocCmd,
            mknode "w:fldChar" [("w:fldCharType","separate")] (),
            mknode "w:fldChar" [("w:fldCharType","end")] ()
          ] -- w:r
        ) -- w:p
      ])
    ]] -- w:sdt

makeLOF :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeLOF :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeLOF WriterOptions
opts = do
  let lofCmd :: Text
lofCmd = Text
"TOC \\h \\z \\t \"Image Caption\" \\c" :: Text
  lofTitle <- Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> (Text -> Many Inline) -> Text -> [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Many Inline
B.text (Text -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.ListOfFigures
  title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para lofTitle])
  return
    [mknode "w:sdt" [] [
      mknode "w:sdtPr" [] (
        mknode "w:docPartObj" []
          [mknode "w:docPartGallery" [("w:val","List of Figures")] (),
          mknode "w:docPartUnique" [] ()]
         -- w:docPartObj
      ), -- w:sdtPr
      mknode "w:sdtContent" [] (title ++ [ Elem $
        mknode "w:p" [] (
          mknode "w:r" [] [
            mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
            mknode "w:instrText" [("xml:space","preserve")] lofCmd,
            mknode "w:fldChar" [("w:fldCharType","separate")] (),
            mknode "w:fldChar" [("w:fldCharType","end")] ()
          ] -- w:r
        ) -- w:p
      ]) -- w:sdtContent
    ]] -- w:sdt

makeLOT :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeLOT :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeLOT WriterOptions
opts = do
  let lotCmd :: Text
lotCmd = Text
"TOC \\h \\z \\t \"Table Caption\" \\c" :: Text
  lotTitle <- Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> (Text -> Many Inline) -> Text -> [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Many Inline
B.text (Text -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.ListOfTables
  title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para lotTitle])
  return
    [mknode "w:sdt" [] [
      mknode "w:sdtPr" [] (
        mknode "w:docPartObj" []
          [mknode "w:docPartGallery" [("w:val","List of Tables")] (),
          mknode "w:docPartUnique" [] ()]
         -- w:docPartObj
      ), -- w:sdtPr
      mknode "w:sdtContent" [] (title ++ [ Elem $
        mknode "w:p" [] (
          mknode "w:r" [] [
            mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
            mknode "w:instrText" [("xml:space","preserve")] lotCmd,
            mknode "w:fldChar" [("w:fldCharType","separate")] (),
            mknode "w:fldChar" [("w:fldCharType","end")] ()
          ] -- w:r
        ) -- w:p
      ]) -- w:sdtContent
    ]] -- w:sdt

-- | Convert Pandoc document to rendered document contents plus two lists of
-- OpenXML elements (footnotes and comments).
writeOpenXML :: PandocMonad m
             => WriterOptions -> Pandoc
             -> WS m (Text, [Element], [Element])
writeOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> WS m (Text, [Element], [Element])
writeOpenXML WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  Meta -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => Meta -> m ()
setupTranslations Meta
meta
  let includeTOC :: Bool
includeTOC = WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"toc" Meta
meta
  let includeLOF :: Bool
includeLOF = WriterOptions -> Bool
writerListOfFigures WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"lof" Meta
meta
  let includeLOT :: Bool
includeLOT = WriterOptions -> Bool
writerListOfTables WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"lot" Meta
meta
  abstractTitle <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"abstract-title" Meta
meta of
      Just (MetaBlocks [Block]
bs)   -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT WriterEnv (StateT WriterState m) Text)
-> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bs
      Just (MetaInlines [Inline]
ils) -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT WriterEnv (StateT WriterState m) Text)
-> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
      Just (MetaString Text
s)    -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
      Maybe MetaValue
_                      -> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Abstract
  abstract <-
    case lookupMetaBlocks "abstract" meta of
      [] -> Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
      [Block]
xs -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Content] -> [Doc Text]) -> [Content] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) ([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Abstract") (WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
xs)

  let toInlineMeta Text
field = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ([Content] -> [Doc Text]) -> [Content] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) ([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts (Text -> Meta -> [Inline]
lookupMetaInlines Text
field Meta
meta)

  title <- toInlineMeta "title"
  subtitle <- toInlineMeta "subtitle"
  date <- toInlineMeta "date"

  author <- mapM
             (fmap (hcat . map (literal . showContent)) . inlinesToOpenXML opts)
             (docAuthors meta)

  doc' <- setFirstPara >> blocksToOpenXML opts blocks
  let body = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) [Content]
doc'
  notes' <- gets (reverse . stFootnotes)
  comments <- gets (reverse . stComments)
  let toComment ([(Text, Text)]
kvs, [Inline]
ils) = do
        annotation <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
        return $
          mknode "w:comment" [("w:" <> k, v) | (k,v) <- kvs]
            [ mknode "w:p" [] $
              map Elem
              [ mknode "w:pPr" []
                [ mknode "w:pStyle" [("w:val", "CommentText")] () ]
              , mknode "w:r" []
                [ mknode "w:rPr" []
                  [ mknode "w:rStyle" [("w:val", "CommentReference")] ()
                  ]
                  , mknode "w:annotationRef" [] ()
                ]
              ] ++ annotation
            ]
  comments' <- mapM toComment comments
  toc <- if includeTOC
            then makeTOC opts
            else return []
  lof <- if includeLOF
            then makeLOF opts
            else return []
  lot <- if includeLOT
            then makeLOT opts
            else return []
  metadata <- metaToContext opts
                 (fmap (vcat . map (literal . showContent)) . blocksToOpenXML opts)
                 (fmap (hcat . map (literal . showContent)) . inlinesToOpenXML opts)
                 meta
  cStyleMap <- gets (smParaStyle . stStyleMaps)
  let styleIdOf ParaStyleName
name = ParaStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId (ParaStyleId -> Text) -> ParaStyleId -> Text
forall a b. (a -> b) -> a -> b
$ ParaStyleName -> ParaStyleNameMap -> StyleId ParStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
 HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName ParaStyleName
name ParaStyleNameMap
cStyleMap
  let context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"body" Doc Text
body
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"toc"
                   ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
toc))
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lof"
                   ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
lof))
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lot"
                   ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
lot))
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title" Doc Text
title
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"subtitle" Doc Text
subtitle
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Doc Text] -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"author" [Doc Text]
author
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date" Doc Text
date
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-title" Text
abstractTitle
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract" Doc Text
abstract
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Title")
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"subtitle-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Subtitle")
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"author-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Author")
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Date")
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-title-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"AbstractTitle")
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Abstract")
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  tpl <- maybe (lift $ compileDefaultTemplate "openxml") pure $ writerTemplate opts
  let rendered = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
  return (rendered, notes', comments')

-- | Convert a list of Pandoc blocks to OpenXML.
blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts = ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT WriterEnv (StateT WriterState m) [[Content]]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ([Block]
    -> ReaderT WriterEnv (StateT WriterState m) [[Content]])
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Block -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts) ([Block] -> ReaderT WriterEnv (StateT WriterState m) [[Content]])
-> ([Block] -> [Block])
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
separateTables ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isForeignRawBlock)

isForeignRawBlock :: Block -> Bool
isForeignRawBlock :: Block -> Bool
isForeignRawBlock (RawBlock Format
format Text
_) = Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
"openxml"
isForeignRawBlock Block
_                   = Bool
False

-- Word combines adjacent tables unless you put an empty paragraph between
-- them.  See #4315.
separateTables :: [Block] -> [Block]
separateTables :: [Block] -> [Block]
separateTables [] = []
separateTables (x :: Block
x@Table{}:xs :: [Block]
xs@(Table{}:[Block]
_)) =
  Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"openxml") Text
"<w:p />" Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
separateTables [Block]
xs
separateTables (Block
x:[Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
separateTables [Block]
xs

rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
rStyleM :: forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
styleName = do
  cStyleMap <- (WriterState -> CharStyleNameMap)
-> ReaderT WriterEnv (StateT WriterState m) CharStyleNameMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StyleMaps -> CharStyleNameMap
smCharStyle (StyleMaps -> CharStyleNameMap)
-> (WriterState -> StyleMaps) -> WriterState -> CharStyleNameMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> StyleMaps
stStyleMaps)
  let sty' = CharStyleName -> CharStyleNameMap -> StyleId CharStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
 HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName CharStyleName
styleName CharStyleNameMap
cStyleMap
  return $ mknode "w:rStyle" [("w:val", fromStyleId sty')] ()

getUniqueId :: (PandocMonad m) => WS m Text
getUniqueId :: forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId = do
  n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCurId
  modify $ \WriterState
st -> WriterState
st{stCurId = n + 1}
  return $ tshow n

-- | Key for specifying user-defined docx styles.
dynamicStyleKey :: Text
dynamicStyleKey :: Text
dynamicStyleKey = Text
"custom-style"

-- | Convert a Pandoc block element to OpenXML.
blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Content]
blockToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts Block
blk = WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
withDirection (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML' WriterOptions
opts Block
blk

blockToOpenXML' :: (PandocMonad m) => WriterOptions -> Block -> WS m [Content]
blockToOpenXML' :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML' WriterOptions
opts (Div (Text
ident,[Text]
_classes,[(Text, Text)]
kvs) [Block]
bs) = do
  stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
                   Just (String -> ParaStyleName
forall a. IsString a => String -> a
fromString (String -> ParaStyleName)
-> (Text -> String) -> Text -> ParaStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack -> ParaStyleName
sty) -> do
                      (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
                        WriterState
s{stDynamicParaProps = Set.insert sty
                             (stDynamicParaProps s)}
                      (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
 -> ReaderT
      WriterEnv
      (StateT WriterState m)
      (WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
sty)
                   Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
  dirmod <- case lookup "dir" kvs of
                 Just Text
"rtl" -> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
 -> ReaderT
      WriterEnv
      (StateT WriterState m)
      (WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = True })
                 Just Text
"ltr" -> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
 -> ReaderT
      WriterEnv
      (StateT WriterState m)
      (WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = False })
                 Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
     WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
  let (hs, bs') = if ident == "refs"
                     then span isHeaderBlock bs
                     else ([], bs)
  let bibmod = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs"
                  then WS m Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Bibliography")
                  else WS m a -> WS m a
forall a. a -> a
id
  let langmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
                  Maybe Text
Nothing -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
                  Just Text
lang -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envLang = Just lang})
  header <- dirmod $ stylemod $ blocksToOpenXML opts hs
  contents <- dirmod $ bibmod $ stylemod $ langmod $ blocksToOpenXML opts bs'
  wrapBookmark ident $ header <> contents
blockToOpenXML' WriterOptions
opts (Header Int
lev (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
lst) = do
  ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  let isChapter :: Bool
isChapter = Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts TopLevelDivision -> TopLevelDivision -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelDivision
TopLevelChapter
  paraProps <- WS m Element -> WS m [Element] -> WS m [Element]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (String -> ParaStyleName
forall a. IsString a => String -> a
fromString (String -> ParaStyleName) -> String -> ParaStyleName
forall a b. (a -> b) -> a -> b
$ String
"Heading "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
lev)) (WS m [Element] -> WS m [Element])
-> WS m [Element] -> WS m [Element]
forall a b. (a -> b) -> a -> b
$
                    Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
False
  number <-
        if writerNumberSections opts
           then
             case lookup "number" kvs of
                Just Text
n -> do
                   num <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"SectionNumber")
                            (WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
n))
                   return $ num ++ [Elem $ mknode "w:r" [] [mknode "w:tab" [] ()]]
                Maybe Text
Nothing -> [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
           else return []
  contents <- (number ++) <$> inlinesToOpenXML opts lst
  let addSectionBreak
       | Bool
isChapter = (Element -> Content
Elem (Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" []
                            (Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" []
                             [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:sectPr" [] ()])) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:)
       | Bool
otherwise = [Content] -> [Content]
forall a. a -> a
id
  addSectionBreak <$>
    if T.null ident
       then return [Elem $ mknode "w:p" [] (map Elem paraProps ++ contents)]
       else do
         let bookmarkName = Text
ident
         modify $ \WriterState
s -> WriterState
s{ stSectionIds = Set.insert bookmarkName
                                        $ stSectionIds s }
         bookmarkedContents <- wrapBookmark bookmarkName contents
         return [Elem $ mknode "w:p" [] (map Elem paraProps ++ bookmarkedContents)]
blockToOpenXML' WriterOptions
opts (Plain [Inline]
lst) = do
  isInTable <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
  isInList <- gets stInList
  let block = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
  prop <- pStyleM "Compact"
  if isInTable || isInList
     then withParaProp prop block
     else block
blockToOpenXML' WriterOptions
opts (Para [Inline]
lst)
  | [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst Bool -> Bool -> Bool
&& Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
opts) = [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = do
      isFirstPara <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
      let displayMathPara = case [Inline]
lst of
                                 [Inline
x] -> Inline -> Bool
isDisplayMath Inline
x
                                 [Inline]
_   -> Bool
False
      paraProps <- getParaProps displayMathPara
      bodyTextStyle <- pStyleM $ if isFirstPara
                       then "First Paragraph"
                       else "Body Text"
      let paraProps' = case [Element]
paraProps of
            []               -> [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element
bodyTextStyle]]
            [Element]
ps               -> [Element]
ps
      modify $ \WriterState
s -> WriterState
s { stFirstPara = False }
      contents <- inlinesToOpenXML opts lst
      return [Elem $ mknode "w:p" [] (map Elem paraProps' ++ contents)]
blockToOpenXML' WriterOptions
opts (LineBlock [[Inline]]
lns) = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToOpenXML' WriterOptions
_ b :: Block
b@(RawBlock Format
format Text
str)
  | Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"openxml" = [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [
        CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing)
      ]
  | Bool
otherwise                  = do
      LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToOpenXML' WriterOptions
opts (BlockQuote [Block]
blocks) = do
  inNote <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInNote
  p <- withParaPropM (pStyleM
                       (if inNote
                           then "Footnote Block Text"
                           else "Block Text"))
       $ blocksToOpenXML opts blocks
  setFirstPara
  return p
blockToOpenXML' WriterOptions
opts (CodeBlock attrs :: (Text, [Text], [(Text, Text)])
attrs@(Text
ident, [Text]
_, [(Text, Text)]
_) Text
str) = do
  p <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Source Code") (WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [(Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attrs Text
str])
  setFirstPara
  wrapBookmark ident p
blockToOpenXML' WriterOptions
_ Block
HorizontalRule = do
  ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
    Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pict" []
    (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"v:rect" [(Text
"style",Text
"width:0;height:1.5pt"),
                       (Text
"o:hralign",Text
"center"),
                       (Text
"o:hrstd",Text
"t"),(Text
"o:hr",Text
"t")] () ]
blockToOpenXML' WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
  -- Remove extra paragraph indentation due to list items (#5947).
  -- This means that tables in lists will not be indented, but it
  -- avoids unwanted indentation in each cell.
  content <- WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
tableToOpenXML WriterOptions
opts
              ((WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envListLevel = -1 }) (WS m [Content] -> WS m [Content])
-> ([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts)
                 ((Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Grid.toTable (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot)
  let (tableId, _, _) = attr
  wrapBookmark tableId content
blockToOpenXML' WriterOptions
opts Block
el
  | BulletList [[Block]]
lst <- Block
el
    = case ([Block] -> Maybe (Bool, [Block]))
-> [[Block]] -> Maybe [(Bool, [Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Maybe (Bool, [Block])
forall (m :: * -> *). MonadPlus m => [Block] -> m (Bool, [Block])
toTaskListItem [[Block]]
lst of
      Just [(Bool, [Block])]
items -> [[Content]] -> [Content]
forall a. Monoid a => [a] -> a
mconcat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ((Bool, [Block]) -> WS m [Content])
-> [(Bool, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Bool
checked, [Block]
bs) -> ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList (Bool -> ListMarker
CheckboxMarker Bool
checked) [[Block]
bs]) [(Bool, [Block])]
items
      Maybe [(Bool, [Block])]
Nothing -> ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ListMarker
BulletMarker [[Block]]
lst
  | OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) [[Block]]
lst <- Block
el
    = ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList (ListNumberStyle -> ListNumberDelim -> Int -> ListMarker
NumberMarker ListNumberStyle
numstyle ListNumberDelim
numdelim Int
start) [[Block]]
lst
  where
    addOpenXMLList :: ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ListMarker
marker t [Block]
items = do
      ListMarker -> WS m ()
forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker
      numid <- WS m Int
forall (m :: * -> *). PandocMonad m => WS m Int
getNumId
      exampleid <- case marker of
                     NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ -> (WriterState -> Maybe Int)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe Int
stExampleId
                     ListMarker
_ -> Maybe Int -> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
      l <- asList $ concat <$>
             mapM (listItemToOpenXML opts $ fromMaybe numid exampleid) items
      setFirstPara
      return l
blockToOpenXML' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  l <- [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([Inline], [[Block]]) -> WS m [Content])
-> [([Inline], [[Block]])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts) [([Inline], [[Block]])]
items
  setFirstPara
  return l
blockToOpenXML' WriterOptions
opts (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
_ [Block]
longcapt) [Block]
body) = do
  ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  fignum <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextFigureNum
  unless (null longcapt) $ modify $ \WriterState
st -> WriterState
st{ stNextFigureNum = fignum + 1 }
  let refid = if Text -> Bool
T.null Text
ident
              then Text
"ref_fig" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
fignum
              else Text
"ref_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
  figname <- translateTerm Term.Figure
  prop <- pStyleM $
    if null longcapt
    then "Figure"
    else "Captioned Figure"
  paraProps <- local
    (\WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps (Just prop) [] <>
                                       envParaProperties env })
    (getParaProps False)

  -- Figure contents
  let simpleImage Inline
x = do
        imgXML <- WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts Inline
x
        pure $ Elem (mknode "w:p" [] (map Elem paraProps ++ imgXML))
  contentsNode <- case body of
    [Plain [img :: Inline
img@Image {}]] -> Inline -> ReaderT WriterEnv (StateT WriterState m) Content
forall {m :: * -> *}.
PandocMonad m =>
Inline -> ReaderT WriterEnv (StateT WriterState m) Content
simpleImage Inline
img
    [Para  [img :: Inline
img@Image {}]] -> Inline -> ReaderT WriterEnv (StateT WriterState m) Content
forall {m :: * -> *}.
PandocMonad m =>
Inline -> ReaderT WriterEnv (StateT WriterState m) Content
simpleImage Inline
img
    [Block]
_                      -> WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) Content
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m Content
toFigureTable WriterOptions
opts [Block]
body
  -- Caption
  let imageCaption = WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Image Caption")
                   (WS m [Content] -> WS m [Content])
-> ([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts
  let fstCaptionPara [Inline]
inlns = [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$
        if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
opts
        then [Inline]
inlns
        else let rawfld :: Inline
rawfld = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                          [ Text
"<w:fldSimple w:instr=\"SEQ Figure"
                          , Text
" \\* ARABIC \"><w:r><w:t>"
                          , Int -> Text
forall a. Show a => a -> Text
tshow Int
fignum
                          , Text
"</w:t></w:r></w:fldSimple>"
                          ]
             in (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
refid,[],[]) [Text -> Inline
Str (Text
figname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\160") , Inline
rawfld]
                Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
": " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
inlns
  captionNode <- case longcapt of
    []              -> [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    (Para [Inline]
xs  : [Block]
bs) -> [Block] -> WS m [Content]
imageCaption ([Inline] -> Block
fstCaptionPara [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs)
    (Plain [Inline]
xs : [Block]
bs) -> [Block] -> WS m [Content]
imageCaption ([Inline] -> Block
fstCaptionPara [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs)
    [Block]
_               -> [Block] -> WS m [Content]
imageCaption [Block]
longcapt
  wrapBookmark ident $
    case writerFigureCaptionPosition opts of
      CaptionPosition
CaptionBelow -> Content
contentsNode Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
captionNode
      CaptionPosition
CaptionAbove -> [Content]
captionNode [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content
contentsNode]

toFigureTable :: PandocMonad m
              => WriterOptions -> [Block] -> WS m Content
toFigureTable :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m Content
toFigureTable WriterOptions
opts [Block]
blks = do
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable = True }
  let ncols :: Int
ncols = [Block] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
blks
  let textwidth :: Double
textwidth = Double
7920  -- 5.5 in in twips       (1 twip == 1/20 pt)
  let cellfrac :: Double
cellfrac = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols
  let colwidth :: Text
colwidth = forall a. Show a => a -> Text
tshow @Integer (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
textwidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellfrac) -- twips
  let gridCols :: [Element]
gridCols = Int -> Element -> [Element]
forall a. Int -> a -> [a]
replicate Int
ncols (Element -> [Element]) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridCol" [(Text
"w:w", Text
colwidth)] ()
  let scaleImage :: Inline -> Inline
scaleImage = \case
        Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
ident, [Text]
classes, [(Text, Text)]
attribs) [Inline]
alt (Text, Text)
tgt ->
          let dimWidth :: Dimension
dimWidth  = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
                            Maybe Dimension
Nothing -> Double -> Dimension
Percent (Double
cellfrac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
                            Just Dimension
d  -> Double -> Dimension -> Dimension
scaleDimension Double
cellfrac Dimension
d
              dimHeight :: Maybe Dimension
dimHeight = Double -> Dimension -> Dimension
scaleDimension Double
cellfrac (Dimension -> Dimension) -> Maybe Dimension -> Maybe Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr
              attribs' :: [(Text, Text)]
attribs' = (Direction -> Text
forall a. Show a => a -> Text
tshow Direction
Width, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
dimWidth) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
                         (case Maybe Dimension
dimHeight of
                            Maybe Dimension
Nothing -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id
                            Just Dimension
h  -> ((Direction -> Text
forall a. Show a => a -> Text
tshow Direction
Height, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
h) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:))
                         [ (Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
attribs
                                  , Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"width", Text
"height"]
                                  ]
          in (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text
ident, [Text]
classes, [(Text, Text)]
attribs') [Inline]
alt (Text, Text)
tgt
        Inline
x -> Inline
x
  let blockToCell :: Block -> OOXMLCell
blockToCell = (Text, [Text], [(Text, Text)])
-> Alignment -> RowSpan -> ColSpan -> [Block] -> OOXMLCell
Table.OOXMLCell (Text, [Text], [(Text, Text)])
nullAttr Alignment
AlignCenter RowSpan
1 ColSpan
1 ([Block] -> OOXMLCell) -> (Block -> [Block]) -> Block -> OOXMLCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[])
                  (Block -> [Block]) -> (Block -> Block) -> Block -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> Block -> Block
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
scaleImage
  tblBody <- ([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe Element)
forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe Element)
Table.rowToOpenXML (WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts) (OOXMLRow -> WS m (Maybe Element))
-> ([OOXMLCell] -> OOXMLRow) -> [OOXMLCell] -> WS m (Maybe Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             RowType
-> (Text, [Text], [(Text, Text)]) -> [OOXMLCell] -> OOXMLRow
Table.OOXMLRow RowType
Table.BodyRow (Text, [Text], [(Text, Text)])
nullAttr ([OOXMLCell] -> WS m (Maybe Element))
-> [OOXMLCell] -> WS m (Maybe Element)
forall a b. (a -> b) -> a -> b
$
             (Block -> OOXMLCell) -> [Block] -> [OOXMLCell]
forall a b. (a -> b) -> [a] -> [b]
map Block -> OOXMLCell
blockToCell [Block]
blks
  let tbl = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tbl" []
        ( Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblPr" []
          [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblStyle" [(Text
"w:val",Text
"FigureTable")] (),
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblW" [ (Text
"w:type", Text
"auto"), (Text
"w:w", Text
"0") ] (),
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:jc" [(Text
"w:val",Text
"center")] (),
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblLook" [ (Text
"w:firstRow", Text
"0")
                               , (Text
"w:lastRow", Text
"0")
                               , (Text
"w:firstColumn", Text
"0")
                               , (Text
"w:lastColumn", Text
"0")
                               ] ()
          ]
          Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblGrid" [] [Element]
gridCols
          Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList Maybe Element
tblBody
        )
  modify $ \WriterState
s -> WriterState
s { stInTable = False }
  return $ Elem tbl


definitionListItemToOpenXML  :: (PandocMonad m)
                             => WriterOptions -> ([Inline],[[Block]])
                             -> WS m [Content]
definitionListItemToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts ([Inline]
term,[[Block]]
defs) = do
  term' <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Definition Term")
           (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
term)
  defs' <- withParaPropM (pStyleM "Definition")
           $ concat `fmap` mapM (blocksToOpenXML opts) defs
  return $ term' ++ defs'

addList :: (PandocMonad m) => ListMarker -> WS m ()
addList :: forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker = do
  lists <- (WriterState -> [ListMarker])
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [ListMarker]
stLists
  lastExampleId <- gets stExampleId
  modify $ \WriterState
st -> WriterState
st{ stLists = lists ++ case marker of
                                         -- Use only first occurrence of Example for list declaration to avoid overhead
                                         NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
lastExampleId -> []
                                         ListMarker
_ -> [ListMarker
marker]
                    , stExampleId = case marker of
                                         -- Reuse the same identifier for all other occurrences of Example
                                         NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ -> Maybe Int
lastExampleId Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
baseListId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ListMarker] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ListMarker]
lists)
                                         ListMarker
_ -> Maybe Int
lastExampleId
                  }

listItemToOpenXML :: (PandocMonad m)
                  => WriterOptions
                  -> Int -> [Block]
                  -> WS m [Content]
listItemToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> WS m [Content]
listItemToOpenXML WriterOptions
opts Int
numid [Block]
bs = do
  oldInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
  modify $ \WriterState
st -> WriterState
st{ stInList = True }
  let isListBlock = \case
        BulletList{}  -> Bool
True
        OrderedList{} -> Bool
True
        Block
_             -> Bool
False
  -- Prepend an empty string if the first entry is another
  -- list. Otherwise the outer bullet will disappear.
  let bs' = case [Block]
bs of
                 [] -> []
                 Block
x:[Block]
xs -> if Block -> Bool
isListBlock Block
x
                               then [Inline] -> Block
Plain [Text -> Inline
Str Text
""]Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs
                               else Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs
  modify $ \WriterState
st -> WriterState
st{ stNumIdUsed = False }
  contents <- withNumId numid $ blocksToOpenXML opts bs'
  modify $ \WriterState
st -> WriterState
st{ stInList = oldInList }
  return contents

-- | Convert a list of inline elements to OpenXML.
inlinesToOpenXML :: PandocMonad m => WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst = [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Inline -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts) ([Inline] -> [Inline]
convertSpace [Inline]
lst)

withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
withNumId :: forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
withNumId Int
numid = (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv)
 -> ReaderT WriterEnv (StateT WriterState m) a
 -> ReaderT WriterEnv (StateT WriterState m) a)
-> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListNumId = numid }

asList :: (PandocMonad m) => WS m a -> WS m a
asList :: forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
asList = (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv)
 -> ReaderT WriterEnv (StateT WriterState m) a
 -> ReaderT WriterEnv (StateT WriterState m) a)
-> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListLevel = envListLevel env + 1 }

getTextProps :: (PandocMonad m) => WS m [Element]
getTextProps :: forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps = do
  props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envTextProperties
  mblang <- asks envLang
  let langnode = case Maybe Text
mblang of
                   Maybe Text
Nothing -> EnvProps
forall a. Monoid a => a
mempty
                   Just Text
l  -> Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing
                               [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:lang" [(Text
"w:val", Text
l)] ()]
  let squashed = EnvProps -> [Element]
squashProps (EnvProps
props EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> EnvProps
langnode)
  return [mknode "w:rPr" [] squashed | (not . null) squashed]

withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
withTextProp :: forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp Element
d WS m a
p =
  (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envTextProperties = ep <> envTextProperties env}) WS m a
p
  where ep :: EnvProps
ep = if Element -> Bool
isStyle Element
d then Maybe Element -> [Element] -> EnvProps
EnvProps (Element -> Maybe Element
forall a. a -> Maybe a
Just Element
d) [] else Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing [Element
d]

withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
withTextPropM :: forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM WS m Element
md WS m a
p = do
  d <- WS m Element
md
  withTextProp d p

getParaProps :: PandocMonad m => Bool -> WS m [Element]
getParaProps :: forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
displayMathPara = do
  props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
  listLevel <- asks envListLevel
  numid <- asks envListNumId
  numIdUsed <- gets stNumIdUsed
  -- clear numId after first use to support multiple paragraphs in the same bullet
  -- baseListId is the code for no list marker
  let numid' = if Bool
numIdUsed then Int
baseListId else Int
numid
  modify $ \WriterState
st -> WriterState
st{ stNumIdUsed = True }
  let listPr = [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:numPr" []
                [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:ilvl" [(Text
"w:val",Int -> Text
forall a. Show a => a -> Text
tshow Int
listLevel)] ()
                , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:numId" [(Text
"w:val",Int -> Text
forall a. Show a => a -> Text
tshow Int
numid')] () ] | Int
listLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
displayMathPara]
  return $ case squashProps (EnvProps Nothing listPr <> props) of
                [] -> []
                [Element]
ps -> [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element]
ps]

formattedString :: PandocMonad m => Text -> WS m [Element]
formattedString :: forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString Text
str =
  -- properly handle soft hyphens
  case (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\173') Text
str of
      [Text
w] -> Text -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' Text
w
      [Text]
ws  -> do
         sh <- [Element] -> WS m Element
forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:softHyphen" [] ()]
         intercalate [sh] <$> mapM formattedString' ws

formattedString' :: PandocMonad m => Text -> WS m [Element]
formattedString' :: forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' Text
str = do
  inDel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInDel
  let mkrun Text
s =
        (if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
s
            then Element -> WS m Element -> WS m Element
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rFonts" [(Text
"w:hint",Text
"eastAsia")] ())
            else WS m Element -> WS m Element
forall a. a -> a
id) (WS m Element -> WS m Element) -> WS m Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ [Element] -> WS m Element
forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun
                       [ Text -> [(Text, Text)] -> Text -> Element
mktnode (if Bool
inDel then Text
"w:delText" else Text
"w:t")
                          [(Text
"xml:space",Text
"preserve")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
s ]
  mapM mkrun $ breakIntoChunks $ stripInvalidChars str

-- For motivation see #9817.
breakIntoChunks :: Text -> [Text]
breakIntoChunks :: Text -> [Text]
breakIntoChunks Text
t
  | Text -> Bool
T.null Text
t = []
  | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
t
    = let cs :: [Text]
cs = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
c Char
d -> (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
d) Bool -> Bool -> Bool
||
                                  Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
d)) Text
t
          css :: [[Text]]
css = (Text -> Text -> Bool) -> [Text] -> [[Text]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Text
x Text
y -> Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
x Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
y)
                                  Bool -> Bool -> Bool
|| ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
x Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
y))
                                  Bool -> Bool -> Bool
|| ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
y Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
x)))
                        [Text]
cs
       in ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [[Text]]
css
  | Bool
otherwise = [Text
t]

formattedRun :: PandocMonad m => [Element] -> WS m Element
formattedRun :: forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun [Element]
els = do
  props <- WS m [Element]
forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps
  return $ mknode "w:r" [] $ props ++ els

-- | Convert an inline element to OpenXML.
inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts Inline
il = WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
withDirection (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML' WriterOptions
opts Inline
il

inlineToOpenXML' :: PandocMonad m => WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML' :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML' WriterOptions
_ (Str Text
str) =
  (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString Text
str
inlineToOpenXML' WriterOptions
opts Inline
Space = WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
" ")
inlineToOpenXML' WriterOptions
opts Inline
SoftBreak = WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
" ")
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"mark"],[]) [Inline]
ils) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:highlight" [(Text
"w:val",Text
"yellow")] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
    WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-block"],[]) [Inline]
ils) =
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
ils) =
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-right-inline"],[]) [Inline]
ils) =
   ([Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
     Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
     (Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:t"
       [(Text
"xml:space",Text
"preserve")]
       (Text
"\t" :: Text))] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++)
    ([Content] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-indent"],[]) [Inline]
ils) =
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
_ (Span (Text
ident,[Text
"comment-start"],[(Text, Text)]
kvs) [Inline]
ils) = do
  -- prefer the "id" in kvs, since that is the one produced by the docx
  -- reader.
  let ident' :: Text
ident' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ident (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
kvs)
      kvs' :: [(Text, Text)]
kvs' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text
"id" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stComments = (("id",ident'):kvs', ils) : stComments st }
  [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:commentRangeStart" [(Text
"w:id", Text
ident')] () ]
inlineToOpenXML' WriterOptions
_ (Span (Text
ident,[Text
"comment-end"],[(Text, Text)]
kvs) [Inline]
_) =
  -- prefer the "id" in kvs, since that is the one produced by the docx
  -- reader.
  let ident' :: Text
ident' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ident (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
kvs)
  in [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ([Element] -> [Content])
-> [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
     [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:commentRangeEnd" [(Text
"w:id", Text
ident')] ()
     , Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
       [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" []
         [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rStyle" [(Text
"w:val", Text
"CommentReference")] () ]
       , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:commentReference" [(Text
"w:id", Text
ident')] () ]
     ]
inlineToOpenXML' WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
  stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
                   Just (String -> CharStyleName
forall a. IsString a => String -> a
fromString (String -> CharStyleName)
-> (Text -> String) -> Text -> CharStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack -> CharStyleName
sty) -> do
                      (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
                        WriterState
s{stDynamicTextProps = Set.insert sty
                              (stDynamicTextProps s)}
                      (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
     WriterEnv
     (StateT WriterState m)
     (ReaderT WriterEnv (StateT WriterState m) [Content]
      -> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ReaderT WriterEnv (StateT WriterState m) [Content]
  -> ReaderT WriterEnv (StateT WriterState m) [Content])
 -> ReaderT
      WriterEnv
      (StateT WriterState m)
      (ReaderT WriterEnv (StateT WriterState m) [Content]
       -> ReaderT WriterEnv (StateT WriterState m) [Content]))
-> (ReaderT WriterEnv (StateT WriterState m) [Content]
    -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
     WriterEnv
     (StateT WriterState m)
     (ReaderT WriterEnv (StateT WriterState m) [Content]
      -> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a b. (a -> b) -> a -> b
$ WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
sty)
                   Maybe Text
_ -> (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
     WriterEnv
     (StateT WriterState m)
     (ReaderT WriterEnv (StateT WriterState m) [Content]
      -> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> a
id
  let dirmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                 Just Text
"rtl" -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = True })
                 Just Text
"ltr" -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = False })
                 Maybe Text
_          -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
      off Text
x = Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
x [(Text
"w:val",Text
"0")] ())
      pmod =  (if Text
"csl-no-emph" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:i" else WS m a -> WS m a
forall a. a -> a
id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (if Text
"csl-no-strong" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:b" else WS m a -> WS m a
forall a. a -> a
id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (if Text
"csl-no-smallcaps" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                  then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:smallCaps"
                  else WS m a -> WS m a
forall a. a -> a
id)
      getChangeAuthorDate = do
        defaultAuthor <- (WriterEnv -> Text)
-> ReaderT WriterEnv (StateT WriterState m) Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Text
envChangesAuthor
        let author = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultAuthor (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"author" [(Text, Text)]
kvs)
        let mdate = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"date" [(Text, Text)]
kvs
        return $ ("w:author", author) :
                   maybe [] (\Text
date -> [(Text
"w:date", Text
date)]) mdate
  insmod <- if "insertion" `elem` classes
               then do
                 changeAuthorDate <- getChangeAuthorDate
                 insId <- gets stInsId
                 modify $ \WriterState
s -> WriterState
s{stInsId = insId + 1}
                 return $ \ReaderT WriterEnv (StateT WriterState m) [Content]
f -> do
                   x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
                   return [Elem $
                           mknode "w:ins"
                             (("w:id", tshow insId) : changeAuthorDate) x]
               else return id
  delmod <- if "deletion" `elem` classes
               then do
                 changeAuthorDate <- getChangeAuthorDate
                 delId <- gets stDelId
                 modify $ \WriterState
s -> WriterState
s{stDelId = delId + 1}
                 return $ \ReaderT WriterEnv (StateT WriterState m) [Content]
f -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env->WriterEnv
env{envInDel=True}) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ do
                   x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
                   return [Elem $ mknode "w:del"
                             (("w:id", tshow delId) : changeAuthorDate) x]
               else return id
  let langmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
                  Maybe Text
Nothing -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
                  Just Text
lang -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envLang = Just lang})
  contents <- insmod $ delmod $ dirmod $ stylemod $ pmod $
              langmod $ inlinesToOpenXML opts ils
  wrapBookmark ident contents
inlineToOpenXML' WriterOptions
opts (Strong [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bCs" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ -- needed for LTR, #6911
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:b" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Emph [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:iCs" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$  -- needed for LTR, #6911
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:i" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Underline [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:u" [(Text
"w:val",Text
"single")] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
    WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Subscript [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vertAlign" [(Text
"w:val",Text
"subscript")] ())
  (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Superscript [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vertAlign" [(Text
"w:val",Text
"superscript")] ())
  (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (SmallCaps [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:smallCaps" [] ())
  (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Strikeout [Inline]
lst) =
  Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:strike" [] ())
  (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
_ Inline
LineBreak = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem Element
br]
inlineToOpenXML' WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"openxml" = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            [CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing)]
  | Bool
otherwise             = do
      LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
inlineToOpenXML' WriterOptions
opts (Quoted QuoteType
quoteType [Inline]
lst) =
  WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts ([Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
close]
    where (Text
open, Text
close) = case QuoteType
quoteType of
                            QuoteType
SingleQuote -> (Text
"\x2018", Text
"\x2019")
                            QuoteType
DoubleQuote -> (Text
"\x201C", Text
"\x201D")
inlineToOpenXML' WriterOptions
opts (Math MathType
mathType Text
str) = do
  Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MathType
mathType MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath) ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  res <- (StateT WriterState m (Either Inline Element)
-> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
forall (m :: * -> *) a. Monad m => m a -> ReaderT WriterEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT WriterState m (Either Inline Element)
 -> ReaderT
      WriterEnv (StateT WriterState m) (Either Inline Element))
-> (m (Either Inline Element)
    -> StateT WriterState m (Either Inline Element))
-> m (Either Inline Element)
-> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either Inline Element)
-> StateT WriterState m (Either Inline Element)
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ((DisplayType -> [Exp] -> Element)
-> MathType -> Text -> m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeOMML MathType
mathType Text
str)
  case res of
       Right Element
r -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element -> Element
fromXLElement Element
r]
       Left Inline
il -> WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML' WriterOptions
opts Inline
il
inlineToOpenXML' WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
attrs Text
str) = do
  let alltoktypes :: [TokenType]
alltoktypes = [TokenType
KeywordTok ..]
  tokTypesMap <- (TokenType
 -> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element))
-> [TokenType]
-> ReaderT WriterEnv (StateT WriterState m) [(TokenType, Element)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\TokenType
tt -> (,) TokenType
tt (Element -> (TokenType, Element))
-> WS m Element
-> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM (String -> CharStyleName
forall a. IsString a => String -> a
fromString (String -> CharStyleName) -> String -> CharStyleName
forall a b. (a -> b) -> a -> b
$ TokenType -> String
forall a. Show a => a -> String
show TokenType
tt)) [TokenType]
alltoktypes
  let unhighlighted = ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> [Content])
-> ([[Element]] -> [Element]) -> [[Element]] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br]) ([[Element]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                       (Text -> ReaderT WriterEnv (StateT WriterState m) [Element])
-> [Text] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString (Text -> [Text]
T.lines Text
str)
      formatOpenXML p
_fmtOpts = [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br] ([[Element]] -> [Element])
-> ([[(TokenType, t)]] -> [[Element]])
-> [[(TokenType, t)]]
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TokenType, t)] -> [Element])
-> [[(TokenType, t)]] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map (((TokenType, t) -> Element) -> [(TokenType, t)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, t) -> Element
forall {t}. Node t => (TokenType, t) -> Element
toHlTok)
      toHlTok (TokenType
toktype,t
tok) =
        Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
          [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
            Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList (TokenType -> [(TokenType, Element)] -> Maybe Element
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TokenType
toktype [(TokenType, Element)]
tokTypesMap)
            , Text -> [(Text, Text)] -> t -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:t" [(Text
"xml:space",Text
"preserve")] t
tok ]
  withTextPropM (rStyleM "Verbatim Char")
    $ if isNothing (writerHighlightStyle opts)
          then unhighlighted
          else case highlight (writerSyntaxMap opts)
                      formatOpenXML attrs str of
                    Right [Element]
h  -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
h)
                    Left Text
msg -> do
                      Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (ReaderT WriterEnv (StateT WriterState m) ()
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                      ReaderT WriterEnv (StateT WriterState m) [Content]
unhighlighted
inlineToOpenXML' WriterOptions
opts (Note [Block]
bs) = do
  notes <- (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Element]
stFootnotes
  notenum <- getUniqueId
  footnoteStyle <- rStyleM "Footnote Reference"
  let notemarker = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
                   [ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" [] Element
footnoteStyle
                   , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:footnoteRef" [] () ]
  let notemarkerXml = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppElement Element
notemarker
  let insertNoteRef (Plain [Inline]
ils : [Block]
xs) = [Inline] -> Block
Plain (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
      insertNoteRef (Para [Inline]
ils  : [Block]
xs) = [Inline] -> Block
Para  (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
      insertNoteRef [Block]
xs               = [Inline] -> Block
Para [Inline
notemarkerXml] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs

  contents <- local (\WriterEnv
env -> WriterEnv
env{ envListLevel = -1
                                , envParaProperties = mempty
                                , envTextProperties = mempty
                                , envInNote = True })
              (withParaPropM (pStyleM "Footnote Text") $
               blocksToOpenXML opts $ insertNoteRef bs)
  let newnote = Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:footnote" [(Text
"w:id", Text
notenum)] [Content]
contents
  modify $ \WriterState
s -> WriterState
s{ stFootnotes = newnote : notes }
  return [ Elem $ mknode "w:r" []
           [ mknode "w:rPr" [] footnoteStyle
           , mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
-- internal link:
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
xs),Text
_)) = do
  contents <- WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Hyperlink") (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
  return
    [ Elem $ mknode "w:hyperlink" [("w:anchor", toBookmarkName xs)] contents ]
-- external link:
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src,Text
_)) = do
  contents <- WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Hyperlink") (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
  extlinks <- gets stExternalLinks
  id' <- case M.lookup src extlinks of
            Just Text
i   -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
i
            Maybe Text
Nothing  -> do
              i <- (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
              modify $ \WriterState
st -> WriterState
st{ stExternalLinks =
                        M.insert src i extlinks }
              return i
  return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ]
inlineToOpenXML' WriterOptions
opts (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
imgident, [Text]
_, [(Text, Text)]
_) [Inline]
alt (Text
src, Text
title)) = do
  pageWidth <- (WriterEnv -> Integer)
-> ReaderT WriterEnv (StateT WriterState m) Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Integer
envPrintWidth
  imgs <- gets stImages
  let
    stImage = String
-> Map String (String, String, Maybe Text, ByteString)
-> Maybe (String, String, Maybe Text, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> String
T.unpack Text
src) Map String (String, String, Maybe Text, ByteString)
imgs
    generateImgElt (String
ident, b
_fp, Maybe Text
mt, ByteString
img) = do
      docprid <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
      nvpicprid <- getUniqueId
      (blipAttrs, blipContents) <-
        case T.takeWhile (/=';') <$> mt of
          Just Text
"image/svg+xml" -> do
            -- get fallback png
            mediabag <- ReaderT WriterEnv (StateT WriterState m) MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
            mbFallback <-
              case lookupMedia (T.unpack (src <> ".png")) mediabag of
                Just MediaItem
item -> do
                  id' <- Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> String)
-> WS m Text -> ReaderT WriterEnv (StateT WriterState m) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
                  let fp' = String
"media/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
id' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".png"
                  let imgdata = (String
id',
                                 String
fp',
                                 Text -> Maybe Text
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item),
                                 LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MediaItem -> LazyByteString
mediaContents MediaItem
item)
                  modify $ \WriterState
st -> WriterState
st { stImages =
                            M.insert fp' imgdata $ stImages st }
                  return $ Just id'
                Maybe MediaItem
Nothing -> Maybe String
-> ReaderT WriterEnv (StateT WriterState m) (Maybe String)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
            let extLst = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:extLst" []
                            [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext"
                              [(Text
"uri",Text
"{28A0092B-C50C-407E-A947-70E740481C1C}")]
                              [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a14:useLocalDpi"
                                [(Text
"xmlns:a14",Text
"http://schemas.microsoft.com/office/drawing/2010/main"),
                                 (Text
"val",Text
"0")] () ]
                            , Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext"
                              [(Text
"uri",Text
"{96DAC541-7B7A-43D3-8B79-37D633B846F1}")]
                              [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"asvg:svgBlip"
                                [(Text
"xmlns:asvg", Text
"http://schemas.microsoft.com/office/drawing/2016/SVG/main"),
                                 (Text
"r:embed",String -> Text
T.pack String
ident)] () ]
                            ]
            return (maybe [] (\String
id'' -> [(Text
"r:embed", String -> Text
T.pack String
id'')]) mbFallback,
                    [extLst])
          Maybe Text
_ -> ([(Text, Text)], [Element])
-> ReaderT
     WriterEnv (StateT WriterState m) ([(Text, Text)], [Element])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text
"r:embed", String -> Text
T.pack String
ident)], [])
      let
        (xpt,ypt) = desiredSizeInPoints opts attr
               (either (const def) id (imageSize opts img))
        -- 12700 emu = 1 pt
        pageWidthPt = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
                        Just (Percent Double
a) -> Integer
pageWidth Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
127)
                        Maybe Dimension
_                -> Integer
pageWidth Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12700
        (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
        cNvPicPr = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:cNvPicPr" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
                         Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:picLocks" [(Text
"noChangeArrowheads",Text
"1")
                                             ,(Text
"noChangeAspect",Text
"1")] ()
        nvPicPr  = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:nvPicPr" []
                        [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:cNvPr"
                            [(Text
"descr",Text
src)
                            ,(Text
"id", Text
nvpicprid)
                            ,(Text
"name",Text
"Picture")] ()
                        , Element
cNvPicPr ]
        blipFill = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:blipFill" []
          [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:blip" [(Text, Text)]
blipAttrs [Element]
blipContents
          , Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:stretch" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
              Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:fillRect" [] ()
          ]
        xfrm =    Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:xfrm" []
                        [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:off" [(Text
"x",Text
"0"),(Text
"y",Text
"0")] ()
                        , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext" [(Text
"cx",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xemu)
                                         ,(Text
"cy",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
yemu)] () ]
        prstGeom = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:prstGeom" [(Text
"prst",Text
"rect")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
                         Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:avLst" [] ()
        ln =      Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ln" [(Text
"w",Text
"9525")]
                        [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] ()
                        , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:headEnd" [] ()
                        , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tailEnd" [] () ]
        spPr =    Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:spPr" [(Text
"bwMode",Text
"auto")]
                        [Element
xfrm, Element
prstGeom, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] (), Element
ln]
        graphic = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphic" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
          Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphicData"
            [(Text
"uri",Text
"http://schemas.openxmlformats.org/drawingml/2006/picture")]
            [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:pic" []
              [ Element
nvPicPr
              , Element
blipFill
              , Element
spPr
              ]
            ]
        imgElt = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
          Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:drawing" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
            Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:inline" []
              [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:extent" [(Text
"cx",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xemu),(Text
"cy",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
yemu)] ()
              , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:effectExtent"
                [(Text
"b",Text
"0"),(Text
"l",Text
"0"),(Text
"r",Text
"0"),(Text
"t",Text
"0")] ()
              , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:docPr"
                [ (Text
"descr", [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt)
                , (Text
"title", Text
title)
                , (Text
"id", Text
docprid)
                , (Text
"name",Text
"Picture")
                ] ()
              , Element
graphic
              ]
      return [Elem imgElt]

  wrapBookmark imgident =<< case stImage of
    Just (String, String, Maybe Text, ByteString)
imgData -> (String, String, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {m :: * -> *} {b}.
PandocMonad m =>
(String, b, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
generateImgElt (String, String, Maybe Text, ByteString)
imgData
    Maybe (String, String, Maybe Text, ByteString)
Nothing -> ( do --try
      (img, mt) <- Text
-> ReaderT
     WriterEnv (StateT WriterState m) (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
src
      ident <- ("rId" <>) <$> getUniqueId

      let
        imgext = case Maybe Text
mt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType of
          Just Text
x    -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
          Maybe Text
Nothing   -> case ByteString -> Maybe ImageType
imageType ByteString
img of
            Just ImageType
Png  -> Text
".png"
            Just ImageType
Jpeg -> Text
".jpeg"
            Just ImageType
Gif  -> Text
".gif"
            Just ImageType
Pdf  -> Text
".pdf"
            Just ImageType
Eps  -> Text
".eps"
            Just ImageType
Svg  -> Text
".svg"
            Just ImageType
Emf  -> Text
".emf"
            Just ImageType
Tiff -> Text
".tiff"
            Just ImageType
Webp -> Text
".webp"
            Maybe ImageType
Nothing   -> Text
""
        imgpath = Text
"media/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
imgext
        mbMimeType = Maybe Text
mt Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
imgpath)

        imgData = (Text -> String
T.unpack Text
ident, Text -> String
T.unpack Text
imgpath, Maybe Text
mbMimeType, ByteString
img)

      if T.null imgext
         then -- without an extension there is no rule for content type
           inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
         else do
           -- insert mime type to use in constructing [Content_Types].xml
           modify $ \WriterState
st -> WriterState
st { stImages = M.insert (T.unpack src) imgData $ stImages st }
           generateImgElt imgData
      )
      ReaderT WriterEnv (StateT WriterState m) [Content]
-> (PandocError
    -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a.
ReaderT WriterEnv (StateT WriterState m) a
-> (PandocError -> ReaderT WriterEnv (StateT WriterState m) a)
-> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ( \PandocError
e -> do
        LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (PandocError -> String
forall a. Show a => a -> String
show PandocError
e)
        -- emit alt text
        WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
alt
      )

br :: Element
br :: Element
br = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:br" [] ()]


withDirection :: PandocMonad m => WS m a -> WS m a
withDirection :: forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
withDirection WS m a
x = do
  isRTL <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envRTL
  paraProps <- asks envParaProperties
  textProps <- asks envTextProperties
  -- We want to clean all bidirection (bidi) and right-to-left (rtl)
  -- properties from the props first. This is because we don't want
  -- them to stack up.
  let paraProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"bidi") (EnvProps -> [Element]
otherElements EnvProps
paraProps)
      textProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"rtl") (EnvProps -> [Element]
otherElements EnvProps
textProps)
      paraStyle = EnvProps -> Maybe Element
styleElement EnvProps
paraProps
      textStyle = EnvProps -> Maybe Element
styleElement EnvProps
textProps
  if isRTL
    -- if we are going right-to-left, we (re?)add the properties.
    then flip local x $
         \WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
                     , envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
                     }
    else flip local x $ \WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps paraStyle paraProps'
                                    , envTextProperties = EnvProps textStyle textProps'
                                    }

wrapBookmark :: (PandocMonad m) => Text -> [Content] -> WS m [Content]
wrapBookmark :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
"" [Content]
contents = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
contents
wrapBookmark Text
ident [Content]
contents = do
  id' <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
  let bookmarkStart = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bookmarkStart"
                       [(Text
"w:id", Text
id')
                       ,(Text
"w:name", Text -> Text
toBookmarkName Text
ident)] ()
      bookmarkEnd = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bookmarkEnd" [(Text
"w:id", Text
id')] ()
  return $ Elem bookmarkStart : contents ++ [Elem bookmarkEnd]

-- Word imposes a 40 character limit on bookmark names and requires
-- that they begin with a letter.  So we just use a hash of the
-- identifier when otherwise we'd have an illegal bookmark name.
toBookmarkName :: Text -> Text
toBookmarkName :: Text -> Text
toBookmarkName Text
s
  | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s
  , Char -> Bool
isLetter Char
c
  , Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
40 = Text
s
  | Bool
otherwise = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'X' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Digest SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 (Text -> ByteString
fromText Text
s)))

maxListLevel :: Int
maxListLevel :: Int
maxListLevel = Int
8

convertSpace :: [Inline] -> [Inline]
convertSpace :: [Inline] -> [Inline]
convertSpace (Str Text
x : Inline
Space : Str Text
y : [Inline]
xs) = [Inline] -> [Inline]
convertSpace (Text -> Inline
Str (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)
convertSpace (Str Text
x : Str Text
y : [Inline]
xs)         = [Inline] -> [Inline]
convertSpace (Text -> Inline
Str (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)
convertSpace (Inline
x:[Inline]
xs)                       = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
convertSpace [Inline]
xs
convertSpace []                           = []