{-# 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 qualified Data.ByteString.Lazy as BL
import Data.Char (isLetter, isSpace)
import Data.Bifunctor (first)
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 qualified Data.Text.Lazy as TL
import Data.Digest.Pure.SHA (sha1, showDigest)
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 Text.Pandoc.UTF8 (fromTextLazy)
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"
  [Inline]
tocTitle <- (WriterState -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Inline]
stTocTitle
  [Content]
title <- 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
"TOC Heading") (WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [[Inline] -> Block
Para [Inline]
tocTitle])
  [Element] -> WS m [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return
    [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:sdt" [] [
      Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:sdtPr" [] (
        Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:docPartObj" []
          [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:docPartGallery" [(Text
"w:val",Text
"Table of Contents")] (),
          Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:docPartUnique" [] ()]
         -- w:docPartObj
      ), -- w:sdtPr
      Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:sdtContent" [] ([Content]
title [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [ 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" [] (
          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:fldChar" [(Text
"w:fldCharType",Text
"begin"),(Text
"w:dirty",Text
"true")] (),
            Text -> [(Text, Text)] -> Text -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:instrText" [(Text
"xml:space",Text
"preserve")] Text
tocCmd,
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:fldChar" [(Text
"w:fldCharType",Text
"separate")] (),
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:fldChar" [(Text
"w:fldCharType",Text
"end")] ()
          ] -- w:r
        ) -- w:p
      ])
    ]] -- 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
  Text
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
  Doc Text
abstract <-
    case Text -> Meta -> [Block]
lookupMetaBlocks Text
"abstract" Meta
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 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
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)

  Doc Text
title <- Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
toInlineMeta Text
"title"
  Doc Text
subtitle <- Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
toInlineMeta Text
"subtitle"
  Doc Text
date <- Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
toInlineMeta Text
"date"

  [Doc Text]
author <- ([Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> [[Inline]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
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
             (([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
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 ([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)) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts)
             (Meta -> [[Inline]]
docAuthors Meta
meta)

  [Content]
doc' <- ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
blocks
  let body :: Doc Text
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'
  [Element]
notes' <- (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Element] -> [Element]
forall a. [a] -> [a]
reverse ([Element] -> [Element])
-> (WriterState -> [Element]) -> WriterState -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [Element]
stFootnotes)
  [([(Text, Text)], [Inline])]
comments <- (WriterState -> [([(Text, Text)], [Inline])])
-> ReaderT
     WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])]
forall a. [a] -> [a]
reverse ([([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])])
-> (WriterState -> [([(Text, Text)], [Inline])])
-> WriterState
-> [([(Text, Text)], [Inline])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [([(Text, Text)], [Inline])]
stComments)
  let toComment :: ([(Text, Text)], [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Element
toComment ([(Text, Text)]
kvs, [Inline]
ils) = do
        [Content]
annotation <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
        Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
-> Element -> ReaderT WriterEnv (StateT WriterState m) 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:comment" [(Text
"w:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs]
            [ Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$
              (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem
              [ 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:pStyle" [(Text
"w:val", Text
"CommentText")] () ]
              , 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:annotationRef" [] ()
                ]
              ] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
annotation
            ]
  [Element]
comments' <- (([(Text, Text)], [Inline]) -> WS m Element)
-> [([(Text, Text)], [Inline])]
-> 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, Text)], [Inline]) -> WS m Element
forall {m :: * -> *}.
PandocMonad m =>
([(Text, Text)], [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Element
toComment [([(Text, Text)], [Inline])]
comments
  [Element]
toc <- if Bool
includeTOC
            then WriterOptions -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeTOC WriterOptions
opts
            else [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Context Text
metadata <- WriterOptions
-> ([Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline]
    -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> Meta
-> ReaderT WriterEnv (StateT WriterState m) (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                 (([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
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 ([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)) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Block] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts)
                 (([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
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 ([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)) (ReaderT WriterEnv (StateT WriterState m) [Content]
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts)
                 Meta
meta
  let context :: Context Text
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
"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
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  Template Text
tpl <- ReaderT WriterEnv (StateT WriterState m) (Template Text)
-> (Template Text
    -> ReaderT WriterEnv (StateT WriterState m) (Template Text))
-> Maybe (Template Text)
-> ReaderT WriterEnv (StateT WriterState m) (Template Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StateT WriterState m (Template Text)
-> ReaderT WriterEnv (StateT WriterState m) (Template Text)
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 (Template Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Template Text))
-> StateT WriterState m (Template Text)
-> ReaderT WriterEnv (StateT WriterState m) (Template Text)
forall a b. (a -> b) -> a -> b
$ Text -> StateT WriterState m (Template Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
compileDefaultTemplate Text
"openxml") Template Text
-> ReaderT WriterEnv (StateT WriterState m) (Template Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Template Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Template Text))
-> Maybe (Template Text)
-> ReaderT WriterEnv (StateT WriterState m) (Template Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts
  let rendered :: Text
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
  (Text, [Element], [Element]) -> WS m (Text, [Element], [Element])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
rendered, [Element]
notes', [Element]
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
  CharStyleNameMap
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' :: StyleId CharStyle
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
  Element -> WS m Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rStyle" [(Text
"w:val", CharStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId CharStyleId
sty')] ()

getUniqueId :: (PandocMonad m) => WS m Text
getUniqueId :: forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId = do
  Int
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCurId
  (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{stCurId = n + 1}
  Text -> WS m Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> WS m Text) -> Text -> WS m Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
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
  WS m [Content] -> WS m [Content]
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 ([Char] -> ParaStyleName
forall a. IsString a => [Char] -> a
fromString ([Char] -> ParaStyleName)
-> (Text -> [Char]) -> Text -> ParaStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
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
  WS m [Content] -> WS m [Content]
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" -> (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 ([Block]
hs, [Block]
bs') = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs"
                     then (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isHeaderBlock [Block]
bs
                     else ([], [Block]
bs)
  let bibmod :: WS m a -> WS m a
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 :: ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
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})
  [Content]
header <- WS m [Content] -> WS m [Content]
dirmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
stylemod (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]
blocksToOpenXML WriterOptions
opts [Block]
hs
  [Content]
contents <- WS m [Content] -> WS m [Content]
dirmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
forall {a}. WS m a -> WS m a
bibmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
stylemod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
forall {a}. WS m a -> WS m a
langmod (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]
blocksToOpenXML WriterOptions
opts [Block]
bs'
  Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
header [Content] -> [Content] -> [Content]
forall a. Semigroup a => a -> a -> a
<> [Content]
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
  [Element]
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 ([Char] -> ParaStyleName
forall a. IsString a => [Char] -> a
fromString ([Char] -> ParaStyleName) -> [Char] -> ParaStyleName
forall a b. (a -> b) -> a -> b
$ [Char]
"Heading "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
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
  [Content]
number <-
        if WriterOptions -> Bool
writerNumberSections WriterOptions
opts
           then
             case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
                Just Text
n -> do
                   [Content]
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))
                   [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
num [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [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)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"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 [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [Content]
contents <- ([Content]
number [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++) ([Content] -> [Content]) -> WS m [Content] -> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
  if Text -> Bool
T.null Text
ident
     then [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
contents)]
     else do
       let bookmarkName :: Text
bookmarkName = Text
ident
       (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{ stSectionIds = Set.insert bookmarkName
                                      $ stSectionIds s }
       [Content]
bookmarkedContents <- Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
bookmarkName [Content]
contents
       [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
bookmarkedContents)]
blockToOpenXML' WriterOptions
opts (Plain [Inline]
lst) = do
  Bool
isInTable <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
  Bool
isInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
  let block :: WS m [Content]
block = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
  Element
prop <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Compact"
  if Bool
isInTable Bool -> Bool -> Bool
|| Bool
isInList
     then Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp Element
prop WS m [Content]
block
     else WS m [Content]
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
      Bool
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 :: Bool
displayMathPara = case [Inline]
lst of
                                 [Inline
x] -> Inline -> Bool
isDisplayMath Inline
x
                                 [Inline]
_   -> Bool
False
      [Element]
paraProps <- Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
displayMathPara
      Element
bodyTextStyle <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (ParaStyleName -> WS m Element) -> ParaStyleName -> WS m Element
forall a b. (a -> b) -> a -> b
$ if Bool
isFirstPara
                       then ParaStyleName
"First Paragraph"
                       else ParaStyleName
"Body Text"
      let paraProps' :: [Element]
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
      (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 { stFirstPara = False }
      [Content]
contents <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
      [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
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 Line -> CData
CData CDataKind
CDataRaw Text
str Maybe Line
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
  Bool
inNote <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInNote
  [Content]
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
                       (if Bool
inNote
                           then ParaStyleName
"Footnote Block Text"
                           else ParaStyleName
"Block Text"))
       (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]
blocksToOpenXML WriterOptions
opts [Block]
blocks
  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 [Content]
p
blockToOpenXML' WriterOptions
opts (CodeBlock attrs :: (Text, [Text], [(Text, Text)])
attrs@(Text
ident, [Text]
_, [(Text, Text)]
_) Text
str) = do
  [Content]
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])
  ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident [Content]
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]
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 (Text
tableId, [Text]
_, [(Text, Text)]
_) = (Text, [Text], [(Text, Text)])
attr
  Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
tableId [Content]
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 -> [(Maybe ListMarker, [Block])] -> WS m [Content]
forall {m :: * -> *}.
PandocMonad m =>
[(Maybe ListMarker, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList (((Bool, [Block]) -> (Maybe ListMarker, [Block]))
-> [(Bool, [Block])] -> [(Maybe ListMarker, [Block])]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> Maybe ListMarker)
-> (Bool, [Block]) -> (Maybe ListMarker, [Block])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ListMarker -> Maybe ListMarker
forall a. a -> Maybe a
Just (ListMarker -> Maybe ListMarker)
-> (Bool -> ListMarker) -> Bool -> Maybe ListMarker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ListMarker
CheckboxMarker)) [(Bool, [Block])]
items)
      Maybe [(Bool, [Block])]
Nothing -> [(Maybe ListMarker, [Block])] -> WS m [Content]
forall {m :: * -> *}.
PandocMonad m =>
[(Maybe ListMarker, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ([(Maybe ListMarker, [Block])] -> WS m [Content])
-> [(Maybe ListMarker, [Block])] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Maybe ListMarker] -> [[Block]] -> [(Maybe ListMarker, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip (ListMarker -> Maybe ListMarker
forall a. a -> Maybe a
Just ListMarker
BulletMarker Maybe ListMarker -> [Maybe ListMarker] -> [Maybe ListMarker]
forall a. a -> [a] -> [a]
: Maybe ListMarker -> [Maybe ListMarker]
forall a. a -> [a]
repeat Maybe ListMarker
forall a. Maybe a
Nothing) [[Block]]
lst
  | OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) [[Block]]
lst <- Block
el
  = [(Maybe ListMarker, [Block])] -> WS m [Content]
forall {m :: * -> *}.
PandocMonad m =>
[(Maybe ListMarker, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ([(Maybe ListMarker, [Block])] -> WS m [Content])
-> [(Maybe ListMarker, [Block])] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
    [Maybe ListMarker] -> [[Block]] -> [(Maybe ListMarker, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip (ListMarker -> Maybe ListMarker
forall a. a -> Maybe a
Just (ListNumberStyle -> ListNumberDelim -> Int -> ListMarker
NumberMarker ListNumberStyle
numstyle ListNumberDelim
numdelim Int
start) Maybe ListMarker -> [Maybe ListMarker] -> [Maybe ListMarker]
forall a. a -> [a] -> [a]
: Maybe ListMarker -> [Maybe ListMarker]
forall a. a -> [a]
repeat Maybe ListMarker
forall a. Maybe a
Nothing) [[Block]]
lst
  where
    addOpenXMLList :: [(Maybe ListMarker, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList [(Maybe ListMarker, [Block])]
items = do
      Maybe Int
exampleid <- case [(Maybe ListMarker, [Block])]
items of
                        (Just (NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_),[Block]
_) : [(Maybe ListMarker, [Block])]
_ -> (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
                        [(Maybe ListMarker, [Block])]
_ -> 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
      [Content]
l <- ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
asList (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
$ [[Content]] -> [Content]
forall a. Monoid a => [a] -> a
mconcat ([[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
<$>
              ((Maybe ListMarker, [Block])
 -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [(Maybe ListMarker, [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 (\(Maybe ListMarker
mbmarker, [Block]
bs) -> do
                      Int
numid <- case Maybe ListMarker
mbmarker of
                        Maybe ListMarker
Nothing -> ReaderT WriterEnv (StateT WriterState m) Int
forall (m :: * -> *). PandocMonad m => WS m Int
getNumId
                        Just ListMarker
marker -> do
                          ListMarker -> WS m ()
forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker
                          ReaderT WriterEnv (StateT WriterState m) Int
forall (m :: * -> *). PandocMonad m => WS m Int
getNumId
                      WriterOptions
-> Int
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> WS m [Content]
listItemToOpenXML WriterOptions
opts (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numid Maybe Int
exampleid) [Block]
bs)
              [(Maybe ListMarker, [Block])]
items
      WS m ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
      [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]
l
blockToOpenXML' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  [Content]
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
  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 [Content]
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
  Int
fignum <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextFigureNum
  Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt) (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
$ (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{ stNextFigureNum = fignum + 1 }
  let refid :: Text
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
  Text
figname <- Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.Figure
  Element
prop <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (ParaStyleName -> WS m Element) -> ParaStyleName -> WS m Element
forall a b. (a -> b) -> a -> b
$
    if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt
    then ParaStyleName
"Figure"
    else ParaStyleName
"Captioned Figure"
  [Element]
paraProps <- (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
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 { envParaProperties = EnvProps (Just prop) [] <>
                                       envParaProperties env })
    (Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
False)

  -- Figure contents
  let simpleImage :: Inline -> ReaderT WriterEnv (StateT WriterState m) Content
simpleImage Inline
x = do
        [Content]
imgXML <- WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts Inline
x
        Content -> ReaderT WriterEnv (StateT WriterState m) Content
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Content -> ReaderT WriterEnv (StateT WriterState m) Content)
-> Content -> ReaderT WriterEnv (StateT WriterState m) Content
forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem (Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
imgXML))
  Content
contentsNode <- case [Block]
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 :: [Block] -> WS m [Content]
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] -> Block
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
  [Content]
captionNode <- case [Block]
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
  Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ Content
contentsNode Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
captionNode

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 (Line -> Text) -> Line -> Text
forall a b. (a -> b) -> a -> b
$ Double -> Line
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
  Maybe Element
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 :: Element
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
        )
  (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 = False }
  Content -> WS m Content
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> WS m Content) -> Content -> WS m Content
forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem Element
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
  [Content]
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)
  [Content]
defs' <- 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")
           (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [[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` ([Block] -> WS 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] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts) [[Block]]
defs
  [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
term' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
defs'

addList :: (PandocMonad m) => ListMarker -> WS m ()
addList :: forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker = do
  [ListMarker]
lists <- (WriterState -> [ListMarker])
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [ListMarker]
stLists
  Maybe Int
lastExampleId <- (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
  (WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \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
  Bool
oldInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
  (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{ stInList = True }
  let isListBlock :: Block -> Bool
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' :: [Block]
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
  (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{ stNumIdUsed = False }
  [Content]
contents <- Int -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
withNumId Int
numid (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]
blocksToOpenXML WriterOptions
opts [Block]
bs'
  (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{ stInList = oldInList }
  [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
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
  EnvProps
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envTextProperties
  Maybe Text
mblang <- (WriterEnv -> Maybe Text)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe Text
envLang
  let langnode :: EnvProps
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 :: [Element]
squashed = EnvProps -> [Element]
squashProps (EnvProps
props EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> EnvProps
langnode)
  [Element] -> WS m [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" [] [Element]
squashed | (Bool -> Bool
not (Bool -> Bool) -> ([Element] -> Bool) -> [Element] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Element]
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
  Element
d <- WS m Element
md
  Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp Element
d WS m a
p

getParaProps :: PandocMonad m => Bool -> WS m [Element]
getParaProps :: forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
displayMathPara = do
  EnvProps
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
  Int
listLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListLevel
  Int
numid <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListNumId
  Bool
numIdUsed <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stNumIdUsed
  -- clear numId after first use to support multiple paragraphs in the same bullet
  -- baseListId is the code for no list marker
  let numid' :: Int
numid' = if Bool
numIdUsed then Int
baseListId else Int
numid
  (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{ stNumIdUsed = True }
  let listPr :: [Element]
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]
  [Element] -> WS m [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
forall a b. (a -> b) -> a -> b
$ case EnvProps -> [Element]
squashProps (Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing [Element]
listPr EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> EnvProps
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
         Element
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" [] ()]
         [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
sh] ([[Element]] -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
-> WS m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> WS 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 -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' [Text]
ws

formattedString' :: PandocMonad m => Text -> WS m [Element]
formattedString' :: forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' Text
str = do
  Bool
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 -> WS m Element
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 ]
  (Text -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [Text] -> WS 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
mkrun ([Text] -> WS m [Element]) -> [Text] -> WS m [Element]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakIntoChunks (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripInvalidChars Text
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
  [Element]
props <- WS m [Element]
forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps
  Element -> WS m Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m 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
$ [Element]
props [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
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
  ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
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 ([Char] -> CharStyleName
forall a. IsString a => [Char] -> a
fromString ([Char] -> CharStyleName)
-> (Text -> [Char]) -> Text -> CharStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
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 :: ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
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 -> WS m a -> WS m a
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 :: WS m a -> WS m a
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 :: ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
getChangeAuthorDate = do
        Text
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
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 :: Maybe Text
mdate = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"date" [(Text, Text)]
kvs
        [(Text, Text)]
-> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Text)]
 -> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)])
-> [(Text, Text)]
-> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Text
"w:author", Text
author) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
                   [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
date -> [(Text
"w:date", Text
date)]) Maybe Text
mdate
  ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
insmod <- if Text
"insertion" 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 do
                 [(Text, Text)]
changeAuthorDate <- ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
getChangeAuthorDate
                 Int
insId <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stInsId
                 (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{stInsId = insId + 1}
                 (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
$ \ReaderT WriterEnv (StateT WriterState m) [Content]
f -> do
                   [Content]
x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
                   [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:ins"
                             ((Text
"w:id", Int -> Text
forall a. Show a => a -> Text
tshow Int
insId) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
changeAuthorDate) [Content]
x]
               else (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
  ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
delmod <- if Text
"deletion" 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 do
                 [(Text, Text)]
changeAuthorDate <- ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
getChangeAuthorDate
                 Int
delId <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stDelId
                 (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{stDelId = delId + 1}
                 (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
$ \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
                   [Content]
x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
                   [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:del"
                             ((Text
"w:id", Int -> Text
forall a. Show a => a -> Text
tshow Int
delId) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
changeAuthorDate) [Content]
x]
               else (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 langmod :: ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
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})
  [Content]
contents <- ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
insmod (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
$ ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
delmod (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
$ ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {a}.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
dirmod (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
$ ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
stylemod (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
$ ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {a}.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
pmod (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
$
              ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {a}.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
langmod (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
  Text
-> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident [Content]
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 Line -> CData
CData CDataKind
CDataRaw Text
str Maybe Line
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
  Either Inline Element
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 Either Inline Element
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 ..]
  [(TokenType, Element)]
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 ([Char] -> CharStyleName
forall a. IsString a => [Char] -> a
fromString ([Char] -> CharStyleName) -> [Char] -> CharStyleName
forall a b. (a -> b) -> a -> b
$ TokenType -> [Char]
forall a. Show a => a -> [Char]
show TokenType
tt)) [TokenType]
alltoktypes
  let unhighlighted :: ReaderT WriterEnv (StateT WriterState m) [Content]
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 -> [[(TokenType, t)]] -> [Element]
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, t) -> Element
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 ]
  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
"Verbatim Char")
    (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
$ if Maybe Style -> Bool
forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
          then ReaderT WriterEnv (StateT WriterState m) [Content]
unhighlighted
          else case SyntaxMap
-> (FormatOptions -> [SourceLine] -> [Element])
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text [Element]
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
                      FormatOptions -> [SourceLine] -> [Element]
forall {t} {p}. Node t => p -> [[(TokenType, t)]] -> [Element]
formatOpenXML (Text, [Text], [(Text, Text)])
attrs Text
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
  [Element]
notes <- (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Element]
stFootnotes
  Text
notenum <- ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
  Element
footnoteStyle <- CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Footnote Reference"
  let notemarker :: Element
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 :: Inline
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 :: [Block] -> [Block]
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

  [Content]
contents <- (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{ envListLevel = -1
                                , envParaProperties = mempty
                                , envTextProperties = mempty
                                , envInNote = True })
              (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
"Footnote Text") (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
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts ([Block] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
insertNoteRef [Block]
bs)
  let newnote :: Element
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
  (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{ stFootnotes = newnote : notes }
  [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] -> 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:footnoteReference" [(Text
"w:id", Text
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
  [Content]
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
  [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:hyperlink" [(Text
"w:anchor", Text -> Text
toBookmarkName Text
xs)] [Content]
contents ]
-- external link:
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src,Text
_)) = do
  [Content]
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
  Map Text Text
extlinks <- (WriterState -> Map Text Text)
-> ReaderT WriterEnv (StateT WriterState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text Text
stExternalLinks
  Text
id' <- case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
src Map Text Text
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
              Text
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
              (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{ stExternalLinks =
                        M.insert src i extlinks }
              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
  [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)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:hyperlink" [(Text
"r:id",Text
id')] [Content]
contents ]
inlineToOpenXML' WriterOptions
opts (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
imgident, [Text]
_, [(Text, Text)]
_) [Inline]
alt (Text
src, Text
title)) = do
  Line
pageWidth <- (WriterEnv -> Line)
-> ReaderT WriterEnv (StateT WriterState m) Line
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Line
envPrintWidth
  Map [Char] ([Char], [Char], Maybe Text, ByteString)
imgs <- (WriterState
 -> Map [Char] ([Char], [Char], Maybe Text, ByteString))
-> ReaderT
     WriterEnv
     (StateT WriterState m)
     (Map [Char] ([Char], [Char], Maybe Text, ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map [Char] ([Char], [Char], Maybe Text, ByteString)
stImages
  let
    stImage :: Maybe ([Char], [Char], Maybe Text, ByteString)
stImage = [Char]
-> Map [Char] ([Char], [Char], Maybe Text, ByteString)
-> Maybe ([Char], [Char], Maybe Text, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> [Char]
T.unpack Text
src) Map [Char] ([Char], [Char], Maybe Text, ByteString)
imgs
    generateImgElt :: ([Char], b, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
generateImgElt ([Char]
ident, b
_fp, Maybe Text
mt, ByteString
img) = do
      Text
docprid <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
      Text
nvpicprid <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
      ([(Text, Text)]
blipAttrs, [Element]
blipContents) <-
        case (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
';') (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mt of
          Just Text
"image/svg+xml" -> do
            -- get fallback png
            MediaBag
mediabag <- ReaderT WriterEnv (StateT WriterState m) MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
            Maybe [Char]
mbFallback <-
              case [Char] -> MediaBag -> Maybe MediaItem
lookupMedia (Text -> [Char]
T.unpack (Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".png")) MediaBag
mediabag of
                Just MediaItem
item -> do
                  [Char]
id' <- Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> [Char])
-> WS m Text -> ReaderT WriterEnv (StateT WriterState m) [Char]
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' :: [Char]
fp' = [Char]
"media/" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
id' [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".png"
                  let imgdata :: ([Char], [Char], Maybe Text, ByteString)
imgdata = ([Char]
id',
                                 [Char]
fp',
                                 Text -> Maybe Text
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item),
                                 ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MediaItem -> ByteString
mediaContents MediaItem
item)
                  (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 { stImages =
                            M.insert fp' imgdata $ stImages st }
                  Maybe [Char]
-> ReaderT WriterEnv (StateT WriterState m) (Maybe [Char])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char]
 -> ReaderT WriterEnv (StateT WriterState m) (Maybe [Char]))
-> Maybe [Char]
-> ReaderT WriterEnv (StateT WriterState m) (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
id'
                Maybe MediaItem
Nothing -> Maybe [Char]
-> ReaderT WriterEnv (StateT WriterState m) (Maybe [Char])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
            let extLst :: Element
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",[Char] -> Text
T.pack [Char]
ident)] () ]
                            ]
            ([(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, Text)]
-> ([Char] -> [(Text, Text)]) -> Maybe [Char] -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
id'' -> [(Text
"r:embed", [Char] -> Text
T.pack [Char]
id'')]) Maybe [Char]
mbFallback,
                    [Element
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", [Char] -> Text
T.pack [Char]
ident)], [])
      let
        (Double
xpt,Double
ypt) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts (Text, [Text], [(Text, Text)])
attr
               ((Text -> ImageSize)
-> (ImageSize -> ImageSize) -> Either Text ImageSize -> ImageSize
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ImageSize -> Text -> ImageSize
forall a b. a -> b -> a
const ImageSize
forall a. Default a => a
def) ImageSize -> ImageSize
forall a. a -> a
id (WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
img))
        -- 12700 emu = 1 pt
        pageWidthPt :: Line
pageWidthPt = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
                        Just (Percent Double
a) -> Line
pageWidth Line -> Line -> Line
forall a. Num a => a -> a -> a
* Double -> Line
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
_                -> Line
pageWidth Line -> Line -> Line
forall a. Num a => a -> a -> a
* Line
12700
        (Line
xemu,Line
yemu) = (Double, Double) -> Line -> (Line, Line)
fitToPage (Double
xpt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
12700, Double
ypt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
12700) Line
pageWidthPt
        cNvPicPr :: Element
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 :: Element
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 :: Element
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 :: Element
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",Line -> Text
forall a. Show a => a -> Text
tshow Line
xemu)
                                         ,(Text
"cy",Line -> Text
forall a. Show a => a -> Text
tshow Line
yemu)] () ]
        prstGeom :: Element
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 :: Element
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 :: Element
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 :: Element
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 :: Element
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",Line -> Text
forall a. Show a => a -> Text
tshow Line
xemu),(Text
"cy",Line -> Text
forall a. Show a => a -> Text
tshow Line
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
              ]
      [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
imgElt]

  Text
-> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
imgident ([Content] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Maybe ([Char], [Char], Maybe Text, ByteString)
stImage of
    Just ([Char], [Char], Maybe Text, ByteString)
imgData -> ([Char], [Char], Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {m :: * -> *} {b}.
PandocMonad m =>
([Char], b, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
generateImgElt ([Char], [Char], Maybe Text, ByteString)
imgData
    Maybe ([Char], [Char], Maybe Text, ByteString)
Nothing -> ( do --try
      (ByteString
img, Maybe Text
mt) <- Text
-> ReaderT
     WriterEnv (StateT WriterState m) (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
src
      Text
ident <- (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

      let
        imgext :: Text
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"
            Maybe ImageType
Nothing   -> Text
""
        imgpath :: 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
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
<|> [Char] -> Maybe Text
getMimeType (Text -> [Char]
T.unpack Text
imgpath)

        imgData :: ([Char], [Char], Maybe Text, ByteString)
imgData = (Text -> [Char]
T.unpack Text
ident, Text -> [Char]
T.unpack Text
imgpath, Maybe Text
mbMimeType, ByteString
img)

      if Text -> Bool
T.null Text
imgext
         then -- without an extension there is no rule for content type
           WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
alt -- return alt to avoid corrupted docx
         else do
           -- insert mime type to use in constructing [Content_Types].xml
           (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 { stImages = M.insert (T.unpack src) imgData $ stImages st }
           ([Char], [Char], Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {m :: * -> *} {b}.
PandocMonad m =>
([Char], b, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
generateImgElt ([Char], [Char], Maybe Text, ByteString)
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
$ [Char] -> Text
T.pack (PandocError -> [Char]
forall a. Show a => a -> [Char]
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
  Bool
isRTL <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envRTL
  EnvProps
paraProps <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
  EnvProps
textProps <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
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]
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]
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 :: Maybe Element
paraStyle = EnvProps -> Maybe Element
styleElement EnvProps
paraProps
      textStyle :: Maybe Element
textStyle = EnvProps -> Maybe Element
styleElement EnvProps
textProps
  if Bool
isRTL
    -- if we are going right-to-left, we (re?)add the properties.
    then ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 WS m a
x ((WriterEnv -> WriterEnv) -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a
forall a b. (a -> b) -> a -> b
$
         \WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
                     , envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
                     }
    else ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 WS m a
x ((WriterEnv -> WriterEnv) -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a
forall a b. (a -> b) -> a -> b
$ \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
  Text
id' <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
  let bookmarkStart :: Element
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 :: Element
bookmarkEnd = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bookmarkEnd" [(Text
"w:id", Text
id')] ()
  [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])
-> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem Element
bookmarkStart Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
contents [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
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 = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Char
'X' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 (Digest SHA1State -> [Char]
forall t. Digest t -> [Char]
showDigest (ByteString -> Digest SHA1State
sha1 (Text -> ByteString
fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict 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 []                           = []