{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Writers.Docx.OpenXML ( writeOpenXML, maxListLevel ) where
import Control.Monad (when, unless)
import Control.Applicative ((<|>))
import Control.Monad.Except (catchError)
import Crypto.Hash (hashWith, SHA1(SHA1))
import qualified Data.ByteString.Lazy as BL
import Data.Char (isLetter, isSpace)
import Text.Pandoc.Char (isCJK)
import Data.Ord (comparing)
import Data.String (fromString)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, maybeToList, isJust)
import Control.Monad.State ( gets, modify, MonadTrans(lift) )
import Control.Monad.Reader ( asks, MonadReader(local) )
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import Skylighting
import Text.DocLayout (hcat, vcat, literal, render)
import Text.Pandoc.Class (PandocMonad, report, getMediaBag)
import Text.Pandoc.Translations (Term(Abstract), translateTerm)
import Text.Pandoc.MediaBag (lookupMedia, MediaItem(..))
import qualified Text.Pandoc.Translations as Term
import qualified Text.Pandoc.Class.PandocMonad as P
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.UTF8 (fromText)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (highlight)
import Text.Pandoc.Templates (compileDefaultTemplate, renderTemplate)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
import Text.Pandoc.Options
import Text.Pandoc.Writers.Docx.StyleMap
import Text.Pandoc.Writers.Docx.Table as Table
import Text.Pandoc.Writers.Docx.Types
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import qualified Text.Pandoc.Writers.GridTable as Grid
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.TeXMath
import Text.Pandoc.Writers.OOXML
import Text.Pandoc.XML.Light as XML
import Data.List (sortBy, intercalate, groupBy)
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)
stripInvalidChars :: Text -> Text
stripInvalidChars :: Text -> Text
stripInvalidChars = (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isValidChar
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)
baseListId :: Int
baseListId :: Int
baseListId = Int
1000
getNumId :: (PandocMonad m) => WS m Int
getNumId :: forall (m :: * -> *). PandocMonad m => WS m Int
getNumId = (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int
baseListId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (WriterState -> Int) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListMarker] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ListMarker] -> Int)
-> (WriterState -> [ListMarker]) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [ListMarker]
stLists)
makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeTOC :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeTOC WriterOptions
opts = do
let depth :: Text
depth = Text
"1-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
let tocCmd :: Text
tocCmd = Text
"TOC \\o \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
depth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" \\h \\z \\u"
tocTitle <- (WriterState -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Inline]
stTocTitle
title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle])
return
[mknode "w:sdt" [] [
mknode "w:sdtPr" [] (
mknode "w:docPartObj" []
[mknode "w:docPartGallery" [("w:val","Table of Contents")] (),
mknode "w:docPartUnique" [] ()]
),
mknode "w:sdtContent" [] (title ++ [ Elem $
mknode "w:p" [] (
mknode "w:r" [] [
mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
mknode "w:instrText" [("xml:space","preserve")] tocCmd,
mknode "w:fldChar" [("w:fldCharType","separate")] (),
mknode "w:fldChar" [("w:fldCharType","end")] ()
]
)
])
]]
makeLOF :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeLOF :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeLOF WriterOptions
opts = do
let lofCmd :: Text
lofCmd = Text
"TOC \\h \\z \\t \"Image Caption\" \\c" :: Text
lofTitle <- Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> (Text -> Many Inline) -> Text -> [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Many Inline
B.text (Text -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.ListOfFigures
title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para lofTitle])
return
[mknode "w:sdt" [] [
mknode "w:sdtPr" [] (
mknode "w:docPartObj" []
[mknode "w:docPartGallery" [("w:val","List of Figures")] (),
mknode "w:docPartUnique" [] ()]
),
mknode "w:sdtContent" [] (title ++ [ Elem $
mknode "w:p" [] (
mknode "w:r" [] [
mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
mknode "w:instrText" [("xml:space","preserve")] lofCmd,
mknode "w:fldChar" [("w:fldCharType","separate")] (),
mknode "w:fldChar" [("w:fldCharType","end")] ()
]
)
])
]]
makeLOT :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeLOT :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeLOT WriterOptions
opts = do
let lotCmd :: Text
lotCmd = Text
"TOC \\h \\z \\t \"Table Caption\" \\c" :: Text
lotTitle <- Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline])
-> (Text -> Many Inline) -> Text -> [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Many Inline
B.text (Text -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.ListOfTables
title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para lotTitle])
return
[mknode "w:sdt" [] [
mknode "w:sdtPr" [] (
mknode "w:docPartObj" []
[mknode "w:docPartGallery" [("w:val","List of Tables")] (),
mknode "w:docPartUnique" [] ()]
),
mknode "w:sdtContent" [] (title ++ [ Elem $
mknode "w:p" [] (
mknode "w:r" [] [
mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
mknode "w:instrText" [("xml:space","preserve")] lotCmd,
mknode "w:fldChar" [("w:fldCharType","separate")] (),
mknode "w:fldChar" [("w:fldCharType","end")] ()
]
)
])
]]
writeOpenXML :: PandocMonad m
=> WriterOptions -> Pandoc
-> WS m (Text, [Element], [Element])
writeOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> WS m (Text, [Element], [Element])
writeOpenXML WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
Meta -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => Meta -> m ()
setupTranslations Meta
meta
let includeTOC :: Bool
includeTOC = WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"toc" Meta
meta
let includeLOF :: Bool
includeLOF = WriterOptions -> Bool
writerListOfFigures WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"lof" Meta
meta
let includeLOT :: Bool
includeLOT = WriterOptions -> Bool
writerListOfTables WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"lot" Meta
meta
abstractTitle <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"abstract-title" Meta
meta of
Just (MetaBlocks [Block]
bs) -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT WriterEnv (StateT WriterState m) Text)
-> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bs
Just (MetaInlines [Inline]
ils) -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderT WriterEnv (StateT WriterState m) Text)
-> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
Just (MetaString Text
s) -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
Maybe MetaValue
_ -> Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Abstract
abstract <-
case lookupMetaBlocks "abstract" meta of
[] -> Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
[Block]
xs -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Content] -> [Doc Text]) -> [Content] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) ([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Abstract") (WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
xs)
let toInlineMeta Text
field = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ([Content] -> [Doc Text]) -> [Content] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) ([Content] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts (Text -> Meta -> [Inline]
lookupMetaInlines Text
field Meta
meta)
title <- toInlineMeta "title"
subtitle <- toInlineMeta "subtitle"
date <- toInlineMeta "date"
author <- mapM
(fmap (hcat . map (literal . showContent)) . inlinesToOpenXML opts)
(docAuthors meta)
doc' <- setFirstPara >> blocksToOpenXML opts blocks
let body = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Content -> Doc Text) -> [Content] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Content -> Text) -> Content -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Text
showContent) [Content]
doc'
notes' <- gets (reverse . stFootnotes)
comments <- gets (reverse . stComments)
let toComment ([(Text, Text)]
kvs, [Inline]
ils) = do
annotation <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
return $
mknode "w:comment" [("w:" <> k, v) | (k,v) <- kvs]
[ mknode "w:p" [] $
map Elem
[ mknode "w:pPr" []
[ mknode "w:pStyle" [("w:val", "CommentText")] () ]
, mknode "w:r" []
[ mknode "w:rPr" []
[ mknode "w:rStyle" [("w:val", "CommentReference")] ()
]
, mknode "w:annotationRef" [] ()
]
] ++ annotation
]
comments' <- mapM toComment comments
toc <- if includeTOC
then makeTOC opts
else return []
lof <- if includeLOF
then makeLOF opts
else return []
lot <- if includeLOT
then makeLOT opts
else return []
metadata <- metaToContext opts
(fmap (vcat . map (literal . showContent)) . blocksToOpenXML opts)
(fmap (hcat . map (literal . showContent)) . inlinesToOpenXML opts)
meta
cStyleMap <- gets (smParaStyle . stStyleMaps)
let styleIdOf ParaStyleName
name = ParaStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId (ParaStyleId -> Text) -> ParaStyleId -> Text
forall a b. (a -> b) -> a -> b
$ ParaStyleName -> ParaStyleNameMap -> StyleId ParStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName ParaStyleName
name ParaStyleNameMap
cStyleMap
let context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"body" Doc Text
body
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"toc"
([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
toc))
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lof"
([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
lof))
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lot"
([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Element -> Doc Text) -> [Element] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Element -> Text) -> Element -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement) [Element]
lot))
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title" Doc Text
title
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"subtitle" Doc Text
subtitle
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Doc Text] -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"author" [Doc Text]
author
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date" Doc Text
date
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-title" Text
abstractTitle
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract" Doc Text
abstract
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Title")
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"subtitle-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Subtitle")
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"author-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Author")
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Date")
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-title-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"AbstractTitle")
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"abstract-style-id" (ParaStyleName -> Text
styleIdOf ParaStyleName
"Abstract")
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
tpl <- maybe (lift $ compileDefaultTemplate "openxml") pure $ writerTemplate opts
let rendered = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
return (rendered, notes', comments')
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
separateTables :: [Block] -> [Block]
separateTables :: [Block] -> [Block]
separateTables [] = []
separateTables (x :: Block
x@Table{}:xs :: [Block]
xs@(Table{}:[Block]
_)) =
Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"openxml") Text
"<w:p />" Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
separateTables [Block]
xs
separateTables (Block
x:[Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
separateTables [Block]
xs
rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
rStyleM :: forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
styleName = do
cStyleMap <- (WriterState -> CharStyleNameMap)
-> ReaderT WriterEnv (StateT WriterState m) CharStyleNameMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StyleMaps -> CharStyleNameMap
smCharStyle (StyleMaps -> CharStyleNameMap)
-> (WriterState -> StyleMaps) -> WriterState -> CharStyleNameMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> StyleMaps
stStyleMaps)
let sty' = CharStyleName -> CharStyleNameMap -> StyleId CharStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName CharStyleName
styleName CharStyleNameMap
cStyleMap
return $ mknode "w:rStyle" [("w:val", fromStyleId sty')] ()
getUniqueId :: (PandocMonad m) => WS m Text
getUniqueId :: forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId = do
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCurId
modify $ \WriterState
st -> WriterState
st{stCurId = n + 1}
return $ tshow n
dynamicStyleKey :: Text
dynamicStyleKey :: Text
dynamicStyleKey = Text
"custom-style"
blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Content]
blockToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts Block
blk = WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
withDirection (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML' WriterOptions
opts Block
blk
blockToOpenXML' :: (PandocMonad m) => WriterOptions -> Block -> WS m [Content]
blockToOpenXML' :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML' WriterOptions
opts (Div (Text
ident,[Text]
_classes,[(Text, Text)]
kvs) [Block]
bs) = do
stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
Just (String -> ParaStyleName
forall a. IsString a => String -> a
fromString (String -> ParaStyleName)
-> (Text -> String) -> Text -> ParaStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack -> ParaStyleName
sty) -> do
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
WriterState
s{stDynamicParaProps = Set.insert sty
(stDynamicParaProps s)}
(WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
sty)
Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
dirmod <- case lookup "dir" kvs of
Just Text
"rtl" -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = True })
Just Text
"ltr" -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(WS m [Content] -> WS m [Content]))
-> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a b. (a -> b) -> a -> b
$ (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = False })
Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
let (hs, bs') = if ident == "refs"
then span isHeaderBlock bs
else ([], bs)
let bibmod = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs"
then WS m Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Bibliography")
else WS m a -> WS m a
forall a. a -> a
id
let langmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
Maybe Text
Nothing -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
Just Text
lang -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envLang = Just lang})
header <- dirmod $ stylemod $ blocksToOpenXML opts hs
contents <- dirmod $ bibmod $ stylemod $ langmod $ blocksToOpenXML opts bs'
wrapBookmark ident $ header <> contents
blockToOpenXML' WriterOptions
opts (Header Int
lev (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
lst) = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
let isChapter :: Bool
isChapter = Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts TopLevelDivision -> TopLevelDivision -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelDivision
TopLevelChapter
paraProps <- WS m Element -> WS m [Element] -> WS m [Element]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (String -> ParaStyleName
forall a. IsString a => String -> a
fromString (String -> ParaStyleName) -> String -> ParaStyleName
forall a b. (a -> b) -> a -> b
$ String
"Heading "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
lev)) (WS m [Element] -> WS m [Element])
-> WS m [Element] -> WS m [Element]
forall a b. (a -> b) -> a -> b
$
Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
False
number <-
if writerNumberSections opts
then
case lookup "number" kvs of
Just Text
n -> do
num <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"SectionNumber")
(WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
n))
return $ num ++ [Elem $ mknode "w:r" [] [mknode "w:tab" [] ()]]
Maybe Text
Nothing -> [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else return []
contents <- (number ++) <$> inlinesToOpenXML opts lst
let addSectionBreak
| Bool
isChapter = (Element -> Content
Elem (Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" []
(Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" []
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:sectPr" [] ()])) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [Content] -> [Content]
forall a. a -> a
id
addSectionBreak <$>
if T.null ident
then return [Elem $ mknode "w:p" [] (map Elem paraProps ++ contents)]
else do
let bookmarkName = Text
ident
modify $ \WriterState
s -> WriterState
s{ stSectionIds = Set.insert bookmarkName
$ stSectionIds s }
bookmarkedContents <- wrapBookmark bookmarkName contents
return [Elem $ mknode "w:p" [] (map Elem paraProps ++ bookmarkedContents)]
blockToOpenXML' WriterOptions
opts (Plain [Inline]
lst) = do
isInTable <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
isInList <- gets stInList
let block = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
prop <- pStyleM "Compact"
if isInTable || isInList
then withParaProp prop block
else block
blockToOpenXML' WriterOptions
opts (Para [Inline]
lst)
| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst Bool -> Bool -> Bool
&& Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
opts) = [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
isFirstPara <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
let displayMathPara = case [Inline]
lst of
[Inline
x] -> Inline -> Bool
isDisplayMath Inline
x
[Inline]
_ -> Bool
False
paraProps <- getParaProps displayMathPara
bodyTextStyle <- pStyleM $ if isFirstPara
then "First Paragraph"
else "Body Text"
let paraProps' = case [Element]
paraProps of
[] -> [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element
bodyTextStyle]]
[Element]
ps -> [Element]
ps
modify $ \WriterState
s -> WriterState
s { stFirstPara = False }
contents <- inlinesToOpenXML opts lst
return [Elem $ mknode "w:p" [] (map Elem paraProps' ++ contents)]
blockToOpenXML' WriterOptions
opts (LineBlock [[Inline]]
lns) = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToOpenXML' WriterOptions
_ b :: Block
b@(RawBlock Format
format Text
str)
| Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"openxml" = [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [
CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing)
]
| Bool
otherwise = do
LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
[Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToOpenXML' WriterOptions
opts (BlockQuote [Block]
blocks) = do
inNote <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInNote
p <- withParaPropM (pStyleM
(if inNote
then "Footnote Block Text"
else "Block Text"))
$ blocksToOpenXML opts blocks
setFirstPara
return p
blockToOpenXML' WriterOptions
opts (CodeBlock attrs :: (Text, [Text], [(Text, Text)])
attrs@(Text
ident, [Text]
_, [(Text, Text)]
_) Text
str) = do
p <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Source Code") (WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [(Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attrs Text
str])
setFirstPara
wrapBookmark ident p
blockToOpenXML' WriterOptions
_ Block
HorizontalRule = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pict" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"v:rect" [(Text
"style",Text
"width:0;height:1.5pt"),
(Text
"o:hralign",Text
"center"),
(Text
"o:hrstd",Text
"t"),(Text
"o:hr",Text
"t")] () ]
blockToOpenXML' WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
content <- WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
tableToOpenXML WriterOptions
opts
((WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envListLevel = -1 }) (WS m [Content] -> WS m [Content])
-> ([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts)
((Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Grid.toTable (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot)
let (tableId, _, _) = attr
wrapBookmark tableId content
blockToOpenXML' WriterOptions
opts Block
el
| BulletList [[Block]]
lst <- Block
el
= case ([Block] -> Maybe (Bool, [Block]))
-> [[Block]] -> Maybe [(Bool, [Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Maybe (Bool, [Block])
forall (m :: * -> *). MonadPlus m => [Block] -> m (Bool, [Block])
toTaskListItem [[Block]]
lst of
Just [(Bool, [Block])]
items -> [[Content]] -> [Content]
forall a. Monoid a => [a] -> a
mconcat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
((Bool, [Block]) -> WS m [Content])
-> [(Bool, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Bool
checked, [Block]
bs) -> ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList (Bool -> ListMarker
CheckboxMarker Bool
checked) [[Block]
bs]) [(Bool, [Block])]
items
Maybe [(Bool, [Block])]
Nothing -> ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ListMarker
BulletMarker [[Block]]
lst
| OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) [[Block]]
lst <- Block
el
= ListMarker -> [[Block]] -> WS m [Content]
forall {m :: * -> *} {t :: * -> *}.
(PandocMonad m, Traversable t) =>
ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList (ListNumberStyle -> ListNumberDelim -> Int -> ListMarker
NumberMarker ListNumberStyle
numstyle ListNumberDelim
numdelim Int
start) [[Block]]
lst
where
addOpenXMLList :: ListMarker
-> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
addOpenXMLList ListMarker
marker t [Block]
items = do
ListMarker -> WS m ()
forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker
numid <- WS m Int
forall (m :: * -> *). PandocMonad m => WS m Int
getNumId
exampleid <- case marker of
NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ -> (WriterState -> Maybe Int)
-> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe Int
stExampleId
ListMarker
_ -> Maybe Int -> ReaderT WriterEnv (StateT WriterState m) (Maybe Int)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
l <- asList $ concat <$>
mapM (listItemToOpenXML opts $ fromMaybe numid exampleid) items
setFirstPara
return l
blockToOpenXML' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
l <- [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([Inline], [[Block]]) -> WS m [Content])
-> [([Inline], [[Block]])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts) [([Inline], [[Block]])]
items
setFirstPara
return l
blockToOpenXML' WriterOptions
opts (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
_ [Block]
longcapt) [Block]
body) = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
fignum <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextFigureNum
unless (null longcapt) $ modify $ \WriterState
st -> WriterState
st{ stNextFigureNum = fignum + 1 }
let refid = if Text -> Bool
T.null Text
ident
then Text
"ref_fig" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
fignum
else Text
"ref_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
figname <- translateTerm Term.Figure
prop <- pStyleM $
if null longcapt
then "Figure"
else "Captioned Figure"
paraProps <- local
(\WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps (Just prop) [] <>
envParaProperties env })
(getParaProps False)
let simpleImage Inline
x = do
imgXML <- WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts Inline
x
pure $ Elem (mknode "w:p" [] (map Elem paraProps ++ imgXML))
contentsNode <- case body of
[Plain [img :: Inline
img@Image {}]] -> Inline -> ReaderT WriterEnv (StateT WriterState m) Content
forall {m :: * -> *}.
PandocMonad m =>
Inline -> ReaderT WriterEnv (StateT WriterState m) Content
simpleImage Inline
img
[Para [img :: Inline
img@Image {}]] -> Inline -> ReaderT WriterEnv (StateT WriterState m) Content
forall {m :: * -> *}.
PandocMonad m =>
Inline -> ReaderT WriterEnv (StateT WriterState m) Content
simpleImage Inline
img
[Block]
_ -> WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) Content
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m Content
toFigureTable WriterOptions
opts [Block]
body
let imageCaption = WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Image Caption")
(WS m [Content] -> WS m [Content])
-> ([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts
let fstCaptionPara [Inline]
inlns = [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
opts
then [Inline]
inlns
else let rawfld :: Inline
rawfld = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"<w:fldSimple w:instr=\"SEQ Figure"
, Text
" \\* ARABIC \"><w:r><w:t>"
, Int -> Text
forall a. Show a => a -> Text
tshow Int
fignum
, Text
"</w:t></w:r></w:fldSimple>"
]
in (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
refid,[],[]) [Text -> Inline
Str (Text
figname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\160") , Inline
rawfld]
Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
": " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
inlns
captionNode <- case longcapt of
[] -> [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
(Para [Inline]
xs : [Block]
bs) -> [Block] -> WS m [Content]
imageCaption ([Inline] -> Block
fstCaptionPara [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs)
(Plain [Inline]
xs : [Block]
bs) -> [Block] -> WS m [Content]
imageCaption ([Inline] -> Block
fstCaptionPara [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs)
[Block]
_ -> [Block] -> WS m [Content]
imageCaption [Block]
longcapt
wrapBookmark ident $
case writerFigureCaptionPosition opts of
CaptionPosition
CaptionBelow -> Content
contentsNode Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
captionNode
CaptionPosition
CaptionAbove -> [Content]
captionNode [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content
contentsNode]
toFigureTable :: PandocMonad m
=> WriterOptions -> [Block] -> WS m Content
toFigureTable :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m Content
toFigureTable WriterOptions
opts [Block]
blks = do
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable = True }
let ncols :: Int
ncols = [Block] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
blks
let textwidth :: Double
textwidth = Double
7920
let cellfrac :: Double
cellfrac = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols
let colwidth :: Text
colwidth = forall a. Show a => a -> Text
tshow @Integer (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
textwidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellfrac)
let gridCols :: [Element]
gridCols = Int -> Element -> [Element]
forall a. Int -> a -> [a]
replicate Int
ncols (Element -> [Element]) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridCol" [(Text
"w:w", Text
colwidth)] ()
let scaleImage :: Inline -> Inline
scaleImage = \case
Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
ident, [Text]
classes, [(Text, Text)]
attribs) [Inline]
alt (Text, Text)
tgt ->
let dimWidth :: Dimension
dimWidth = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
Maybe Dimension
Nothing -> Double -> Dimension
Percent (Double
cellfrac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
Just Dimension
d -> Double -> Dimension -> Dimension
scaleDimension Double
cellfrac Dimension
d
dimHeight :: Maybe Dimension
dimHeight = Double -> Dimension -> Dimension
scaleDimension Double
cellfrac (Dimension -> Dimension) -> Maybe Dimension -> Maybe Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr
attribs' :: [(Text, Text)]
attribs' = (Direction -> Text
forall a. Show a => a -> Text
tshow Direction
Width, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
dimWidth) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
(case Maybe Dimension
dimHeight of
Maybe Dimension
Nothing -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id
Just Dimension
h -> ((Direction -> Text
forall a. Show a => a -> Text
tshow Direction
Height, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
h) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:))
[ (Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
attribs
, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"width", Text
"height"]
]
in (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text
ident, [Text]
classes, [(Text, Text)]
attribs') [Inline]
alt (Text, Text)
tgt
Inline
x -> Inline
x
let blockToCell :: Block -> OOXMLCell
blockToCell = (Text, [Text], [(Text, Text)])
-> Alignment -> RowSpan -> ColSpan -> [Block] -> OOXMLCell
Table.OOXMLCell (Text, [Text], [(Text, Text)])
nullAttr Alignment
AlignCenter RowSpan
1 ColSpan
1 ([Block] -> OOXMLCell) -> (Block -> [Block]) -> Block -> OOXMLCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[])
(Block -> [Block]) -> (Block -> Block) -> Block -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> Block -> Block
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
scaleImage
tblBody <- ([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe Element)
forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe Element)
Table.rowToOpenXML (WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts) (OOXMLRow -> WS m (Maybe Element))
-> ([OOXMLCell] -> OOXMLRow) -> [OOXMLCell] -> WS m (Maybe Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
RowType
-> (Text, [Text], [(Text, Text)]) -> [OOXMLCell] -> OOXMLRow
Table.OOXMLRow RowType
Table.BodyRow (Text, [Text], [(Text, Text)])
nullAttr ([OOXMLCell] -> WS m (Maybe Element))
-> [OOXMLCell] -> WS m (Maybe Element)
forall a b. (a -> b) -> a -> b
$
(Block -> OOXMLCell) -> [Block] -> [OOXMLCell]
forall a b. (a -> b) -> [a] -> [b]
map Block -> OOXMLCell
blockToCell [Block]
blks
let tbl = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tbl" []
( Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblStyle" [(Text
"w:val",Text
"FigureTable")] (),
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblW" [ (Text
"w:type", Text
"auto"), (Text
"w:w", Text
"0") ] (),
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:jc" [(Text
"w:val",Text
"center")] (),
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblLook" [ (Text
"w:firstRow", Text
"0")
, (Text
"w:lastRow", Text
"0")
, (Text
"w:firstColumn", Text
"0")
, (Text
"w:lastColumn", Text
"0")
] ()
]
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblGrid" [] [Element]
gridCols
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList Maybe Element
tblBody
)
modify $ \WriterState
s -> WriterState
s { stInTable = False }
return $ Elem tbl
definitionListItemToOpenXML :: (PandocMonad m)
=> WriterOptions -> ([Inline],[[Block]])
-> WS m [Content]
definitionListItemToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts ([Inline]
term,[[Block]]
defs) = do
term' <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Definition Term")
(WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
term)
defs' <- withParaPropM (pStyleM "Definition")
$ concat `fmap` mapM (blocksToOpenXML opts) defs
return $ term' ++ defs'
addList :: (PandocMonad m) => ListMarker -> WS m ()
addList :: forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker = do
lists <- (WriterState -> [ListMarker])
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [ListMarker]
stLists
lastExampleId <- gets stExampleId
modify $ \WriterState
st -> WriterState
st{ stLists = lists ++ case marker of
NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
lastExampleId -> []
ListMarker
_ -> [ListMarker
marker]
, stExampleId = case marker of
NumberMarker ListNumberStyle
Example ListNumberDelim
_ Int
_ -> Maybe Int
lastExampleId Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
baseListId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ListMarker] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ListMarker]
lists)
ListMarker
_ -> Maybe Int
lastExampleId
}
listItemToOpenXML :: (PandocMonad m)
=> WriterOptions
-> Int -> [Block]
-> WS m [Content]
listItemToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> WS m [Content]
listItemToOpenXML WriterOptions
opts Int
numid [Block]
bs = do
oldInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
modify $ \WriterState
st -> WriterState
st{ stInList = True }
let isListBlock = \case
BulletList{} -> Bool
True
OrderedList{} -> Bool
True
Block
_ -> Bool
False
let bs' = case [Block]
bs of
[] -> []
Block
x:[Block]
xs -> if Block -> Bool
isListBlock Block
x
then [Inline] -> Block
Plain [Text -> Inline
Str Text
""]Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs
else Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs
modify $ \WriterState
st -> WriterState
st{ stNumIdUsed = False }
contents <- withNumId numid $ blocksToOpenXML opts bs'
modify $ \WriterState
st -> WriterState
st{ stInList = oldInList }
return contents
inlinesToOpenXML :: PandocMonad m => WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst = [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Inline -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts) ([Inline] -> [Inline]
convertSpace [Inline]
lst)
withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
withNumId :: forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
withNumId Int
numid = (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a)
-> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListNumId = numid }
asList :: (PandocMonad m) => WS m a -> WS m a
asList :: forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
asList = (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a)
-> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListLevel = envListLevel env + 1 }
getTextProps :: (PandocMonad m) => WS m [Element]
getTextProps :: forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps = do
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envTextProperties
mblang <- asks envLang
let langnode = case Maybe Text
mblang of
Maybe Text
Nothing -> EnvProps
forall a. Monoid a => a
mempty
Just Text
l -> Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing
[Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:lang" [(Text
"w:val", Text
l)] ()]
let squashed = EnvProps -> [Element]
squashProps (EnvProps
props EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> EnvProps
langnode)
return [mknode "w:rPr" [] squashed | (not . null) squashed]
withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
withTextProp :: forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp Element
d WS m a
p =
(WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envTextProperties = ep <> envTextProperties env}) WS m a
p
where ep :: EnvProps
ep = if Element -> Bool
isStyle Element
d then Maybe Element -> [Element] -> EnvProps
EnvProps (Element -> Maybe Element
forall a. a -> Maybe a
Just Element
d) [] else Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing [Element
d]
withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
withTextPropM :: forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM WS m Element
md WS m a
p = do
d <- WS m Element
md
withTextProp d p
getParaProps :: PandocMonad m => Bool -> WS m [Element]
getParaProps :: forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
displayMathPara = do
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
listLevel <- asks envListLevel
numid <- asks envListNumId
numIdUsed <- gets stNumIdUsed
let numid' = if Bool
numIdUsed then Int
baseListId else Int
numid
modify $ \WriterState
st -> WriterState
st{ stNumIdUsed = True }
let listPr = [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:numPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:ilvl" [(Text
"w:val",Int -> Text
forall a. Show a => a -> Text
tshow Int
listLevel)] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:numId" [(Text
"w:val",Int -> Text
forall a. Show a => a -> Text
tshow Int
numid')] () ] | Int
listLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
displayMathPara]
return $ case squashProps (EnvProps Nothing listPr <> props) of
[] -> []
[Element]
ps -> [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element]
ps]
formattedString :: PandocMonad m => Text -> WS m [Element]
formattedString :: forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString Text
str =
case (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\173') Text
str of
[Text
w] -> Text -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' Text
w
[Text]
ws -> do
sh <- [Element] -> WS m Element
forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:softHyphen" [] ()]
intercalate [sh] <$> mapM formattedString' ws
formattedString' :: PandocMonad m => Text -> WS m [Element]
formattedString' :: forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' Text
str = do
inDel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInDel
let mkrun Text
s =
(if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
s
then Element -> WS m Element -> WS m Element
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rFonts" [(Text
"w:hint",Text
"eastAsia")] ())
else WS m Element -> WS m Element
forall a. a -> a
id) (WS m Element -> WS m Element) -> WS m Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ [Element] -> WS m Element
forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun
[ Text -> [(Text, Text)] -> Text -> Element
mktnode (if Bool
inDel then Text
"w:delText" else Text
"w:t")
[(Text
"xml:space",Text
"preserve")] (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ Text
s ]
mapM mkrun $ breakIntoChunks $ stripInvalidChars str
breakIntoChunks :: Text -> [Text]
breakIntoChunks :: Text -> [Text]
breakIntoChunks Text
t
| Text -> Bool
T.null Text
t = []
| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
t
= let cs :: [Text]
cs = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
c Char
d -> (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
d) Bool -> Bool -> Bool
||
Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
d)) Text
t
css :: [[Text]]
css = (Text -> Text -> Bool) -> [Text] -> [[Text]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Text
x Text
y -> Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
x Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
y)
Bool -> Bool -> Bool
|| ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
x Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
y))
Bool -> Bool -> Bool
|| ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
y Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isCJK Text
x)))
[Text]
cs
in ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [[Text]]
css
| Bool
otherwise = [Text
t]
formattedRun :: PandocMonad m => [Element] -> WS m Element
formattedRun :: forall (m :: * -> *). PandocMonad m => [Element] -> WS m Element
formattedRun [Element]
els = do
props <- WS m [Element]
forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps
return $ mknode "w:r" [] $ props ++ els
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
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]
_) =
let ident' :: Text
ident' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ident (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
kvs)
in [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ([Element] -> [Content])
-> [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:commentRangeEnd" [(Text
"w:id", Text
ident')] ()
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rStyle" [(Text
"w:val", Text
"CommentReference")] () ]
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:commentReference" [(Text
"w:id", Text
ident')] () ]
]
inlineToOpenXML' WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
Just (String -> CharStyleName
forall a. IsString a => String -> a
fromString (String -> CharStyleName)
-> (Text -> String) -> Text -> CharStyleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack -> CharStyleName
sty) -> do
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
WriterState
s{stDynamicTextProps = Set.insert sty
(stDynamicTextProps s)}
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]))
-> (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a b. (a -> b) -> a -> b
$ WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
sty)
Maybe Text
_ -> (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT
WriterEnv
(StateT WriterState m)
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> a
id
let dirmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
Just Text
"rtl" -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = True })
Just Text
"ltr" -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL = False })
Maybe Text
_ -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
off Text
x = Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
x [(Text
"w:val",Text
"0")] ())
pmod = (if Text
"csl-no-emph" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:i" else WS m a -> WS m a
forall a. a -> a
id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Text
"csl-no-strong" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:b" else WS m a -> WS m a
forall a. a -> a
id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Text
"csl-no-smallcaps" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then Text -> WS m a -> WS m a
forall {m :: * -> *} {a}. PandocMonad m => Text -> WS m a -> WS m a
off Text
"w:smallCaps"
else WS m a -> WS m a
forall a. a -> a
id)
getChangeAuthorDate = do
defaultAuthor <- (WriterEnv -> Text)
-> ReaderT WriterEnv (StateT WriterState m) Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Text
envChangesAuthor
let author = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultAuthor (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"author" [(Text, Text)]
kvs)
let mdate = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"date" [(Text, Text)]
kvs
return $ ("w:author", author) :
maybe [] (\Text
date -> [(Text
"w:date", Text
date)]) mdate
insmod <- if "insertion" `elem` classes
then do
changeAuthorDate <- getChangeAuthorDate
insId <- gets stInsId
modify $ \WriterState
s -> WriterState
s{stInsId = insId + 1}
return $ \ReaderT WriterEnv (StateT WriterState m) [Content]
f -> do
x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
return [Elem $
mknode "w:ins"
(("w:id", tshow insId) : changeAuthorDate) x]
else return id
delmod <- if "deletion" `elem` classes
then do
changeAuthorDate <- getChangeAuthorDate
delId <- gets stDelId
modify $ \WriterState
s -> WriterState
s{stDelId = delId + 1}
return $ \ReaderT WriterEnv (StateT WriterState m) [Content]
f -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env->WriterEnv
env{envInDel=True}) (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ do
x <- ReaderT WriterEnv (StateT WriterState m) [Content]
f
return [Elem $ mknode "w:del"
(("w:id", tshow delId) : changeAuthorDate) x]
else return id
let langmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
Maybe Text
Nothing -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
Just Text
lang -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envLang = Just lang})
contents <- insmod $ delmod $ dirmod $ stylemod $ pmod $
langmod $ inlinesToOpenXML opts ils
wrapBookmark ident contents
inlineToOpenXML' WriterOptions
opts (Strong [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bCs" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
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
$
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:i" [] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Underline [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:u" [(Text
"w:val",Text
"single")] ()) (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$
WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Subscript [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vertAlign" [(Text
"w:val",Text
"subscript")] ())
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Superscript [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vertAlign" [(Text
"w:val",Text
"superscript")] ())
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (SmallCaps [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:smallCaps" [] ())
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Strikeout [Inline]
lst) =
Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:strike" [] ())
(ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
_ Inline
LineBreak = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem Element
br]
inlineToOpenXML' WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"openxml" = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return
[CData -> Content
Text (CDataKind -> Text -> Maybe Integer -> CData
CData CDataKind
CDataRaw Text
str Maybe Integer
forall a. Maybe a
Nothing)]
| Bool
otherwise = do
LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
[Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
inlineToOpenXML' WriterOptions
opts (Quoted QuoteType
quoteType [Inline]
lst) =
WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts ([Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
close]
where (Text
open, Text
close) = case QuoteType
quoteType of
QuoteType
SingleQuote -> (Text
"\x2018", Text
"\x2019")
QuoteType
DoubleQuote -> (Text
"\x201C", Text
"\x201D")
inlineToOpenXML' WriterOptions
opts (Math MathType
mathType Text
str) = do
Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MathType
mathType MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath) ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
res <- (StateT WriterState m (Either Inline Element)
-> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
forall (m :: * -> *) a. Monad m => m a -> ReaderT WriterEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT WriterState m (Either Inline Element)
-> ReaderT
WriterEnv (StateT WriterState m) (Either Inline Element))
-> (m (Either Inline Element)
-> StateT WriterState m (Either Inline Element))
-> m (Either Inline Element)
-> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either Inline Element)
-> StateT WriterState m (Either Inline Element)
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ((DisplayType -> [Exp] -> Element)
-> MathType -> Text -> m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeOMML MathType
mathType Text
str)
case res of
Right Element
r -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element -> Element
fromXLElement Element
r]
Left Inline
il -> WriterOptions
-> Inline -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML' WriterOptions
opts Inline
il
inlineToOpenXML' WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
attrs Text
str) = do
let alltoktypes :: [TokenType]
alltoktypes = [TokenType
KeywordTok ..]
tokTypesMap <- (TokenType
-> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element))
-> [TokenType]
-> ReaderT WriterEnv (StateT WriterState m) [(TokenType, Element)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\TokenType
tt -> (,) TokenType
tt (Element -> (TokenType, Element))
-> WS m Element
-> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM (String -> CharStyleName
forall a. IsString a => String -> a
fromString (String -> CharStyleName) -> String -> CharStyleName
forall a b. (a -> b) -> a -> b
$ TokenType -> String
forall a. Show a => a -> String
show TokenType
tt)) [TokenType]
alltoktypes
let unhighlighted = ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> [Content])
-> ([[Element]] -> [Element]) -> [[Element]] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br]) ([[Element]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
(Text -> ReaderT WriterEnv (StateT WriterState m) [Element])
-> [Text] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString (Text -> [Text]
T.lines Text
str)
formatOpenXML p
_fmtOpts = [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br] ([[Element]] -> [Element])
-> ([[(TokenType, t)]] -> [[Element]])
-> [[(TokenType, t)]]
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TokenType, t)] -> [Element])
-> [[(TokenType, t)]] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map (((TokenType, t) -> Element) -> [(TokenType, t)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, t) -> Element
forall {t}. Node t => (TokenType, t) -> Element
toHlTok)
toHlTok (TokenType
toktype,t
tok) =
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList (TokenType -> [(TokenType, Element)] -> Maybe Element
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TokenType
toktype [(TokenType, Element)]
tokTypesMap)
, Text -> [(Text, Text)] -> t -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:t" [(Text
"xml:space",Text
"preserve")] t
tok ]
withTextPropM (rStyleM "Verbatim Char")
$ if isNothing (writerHighlightStyle opts)
then unhighlighted
else case highlight (writerSyntaxMap opts)
formatOpenXML attrs str of
Right [Element]
h -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
h)
Left Text
msg -> do
Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ())
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
ReaderT WriterEnv (StateT WriterState m) [Content]
unhighlighted
inlineToOpenXML' WriterOptions
opts (Note [Block]
bs) = do
notes <- (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Element]
stFootnotes
notenum <- getUniqueId
footnoteStyle <- rStyleM "Footnote Reference"
let notemarker = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" []
[ Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:rPr" [] Element
footnoteStyle
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:footnoteRef" [] () ]
let notemarkerXml = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
ppElement Element
notemarker
let insertNoteRef (Plain [Inline]
ils : [Block]
xs) = [Inline] -> Block
Plain (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
insertNoteRef (Para [Inline]
ils : [Block]
xs) = [Inline] -> Block
Para (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
insertNoteRef [Block]
xs = [Inline] -> Block
Para [Inline
notemarkerXml] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
contents <- local (\WriterEnv
env -> WriterEnv
env{ envListLevel = -1
, envParaProperties = mempty
, envTextProperties = mempty
, envInNote = True })
(withParaPropM (pStyleM "Footnote Text") $
blocksToOpenXML opts $ insertNoteRef bs)
let newnote = Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:footnote" [(Text
"w:id", Text
notenum)] [Content]
contents
modify $ \WriterState
s -> WriterState
s{ stFootnotes = newnote : notes }
return [ Elem $ mknode "w:r" []
[ mknode "w:rPr" [] footnoteStyle
, mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
xs),Text
_)) = do
contents <- WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Hyperlink") (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
return
[ Elem $ mknode "w:hyperlink" [("w:anchor", toBookmarkName xs)] contents ]
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src,Text
_)) = do
contents <- WS m Element
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Hyperlink") (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
extlinks <- gets stExternalLinks
id' <- case M.lookup src extlinks of
Just Text
i -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
i
Maybe Text
Nothing -> do
i <- (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> ReaderT WriterEnv (StateT WriterState m) Text
-> ReaderT WriterEnv (StateT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
modify $ \WriterState
st -> WriterState
st{ stExternalLinks =
M.insert src i extlinks }
return i
return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ]
inlineToOpenXML' WriterOptions
opts (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
imgident, [Text]
_, [(Text, Text)]
_) [Inline]
alt (Text
src, Text
title)) = do
pageWidth <- (WriterEnv -> Integer)
-> ReaderT WriterEnv (StateT WriterState m) Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Integer
envPrintWidth
imgs <- gets stImages
let
stImage = String
-> Map String (String, String, Maybe Text, ByteString)
-> Maybe (String, String, Maybe Text, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> String
T.unpack Text
src) Map String (String, String, Maybe Text, ByteString)
imgs
generateImgElt (String
ident, b
_fp, Maybe Text
mt, ByteString
img) = do
docprid <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
nvpicprid <- getUniqueId
(blipAttrs, blipContents) <-
case T.takeWhile (/=';') <$> mt of
Just Text
"image/svg+xml" -> do
mediabag <- ReaderT WriterEnv (StateT WriterState m) MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
mbFallback <-
case lookupMedia (T.unpack (src <> ".png")) mediabag of
Just MediaItem
item -> do
id' <- Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> String)
-> WS m Text -> ReaderT WriterEnv (StateT WriterState m) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
let fp' = String
"media/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
id' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".png"
let imgdata = (String
id',
String
fp',
Text -> Maybe Text
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item),
LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MediaItem -> LazyByteString
mediaContents MediaItem
item)
modify $ \WriterState
st -> WriterState
st { stImages =
M.insert fp' imgdata $ stImages st }
return $ Just id'
Maybe MediaItem
Nothing -> Maybe String
-> ReaderT WriterEnv (StateT WriterState m) (Maybe String)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
let extLst = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:extLst" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext"
[(Text
"uri",Text
"{28A0092B-C50C-407E-A947-70E740481C1C}")]
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a14:useLocalDpi"
[(Text
"xmlns:a14",Text
"http://schemas.microsoft.com/office/drawing/2010/main"),
(Text
"val",Text
"0")] () ]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext"
[(Text
"uri",Text
"{96DAC541-7B7A-43D3-8B79-37D633B846F1}")]
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"asvg:svgBlip"
[(Text
"xmlns:asvg", Text
"http://schemas.microsoft.com/office/drawing/2016/SVG/main"),
(Text
"r:embed",String -> Text
T.pack String
ident)] () ]
]
return (maybe [] (\String
id'' -> [(Text
"r:embed", String -> Text
T.pack String
id'')]) mbFallback,
[extLst])
Maybe Text
_ -> ([(Text, Text)], [Element])
-> ReaderT
WriterEnv (StateT WriterState m) ([(Text, Text)], [Element])
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text
"r:embed", String -> Text
T.pack String
ident)], [])
let
(xpt,ypt) = desiredSizeInPoints opts attr
(either (const def) id (imageSize opts img))
pageWidthPt = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
Just (Percent Double
a) -> Integer
pageWidth Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
127)
Maybe Dimension
_ -> Integer
pageWidth Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12700
(xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
cNvPicPr = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:cNvPicPr" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:picLocks" [(Text
"noChangeArrowheads",Text
"1")
,(Text
"noChangeAspect",Text
"1")] ()
nvPicPr = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:nvPicPr" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:cNvPr"
[(Text
"descr",Text
src)
,(Text
"id", Text
nvpicprid)
,(Text
"name",Text
"Picture")] ()
, Element
cNvPicPr ]
blipFill = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:blipFill" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:blip" [(Text, Text)]
blipAttrs [Element]
blipContents
, Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:stretch" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:fillRect" [] ()
]
xfrm = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:xfrm" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:off" [(Text
"x",Text
"0"),(Text
"y",Text
"0")] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ext" [(Text
"cx",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xemu)
,(Text
"cy",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
yemu)] () ]
prstGeom = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:prstGeom" [(Text
"prst",Text
"rect")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:avLst" [] ()
ln = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:ln" [(Text
"w",Text
"9525")]
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:headEnd" [] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:tailEnd" [] () ]
spPr = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:spPr" [(Text
"bwMode",Text
"auto")]
[Element
xfrm, Element
prstGeom, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:noFill" [] (), Element
ln]
graphic = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphic" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"a:graphicData"
[(Text
"uri",Text
"http://schemas.openxmlformats.org/drawingml/2006/picture")]
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"pic:pic" []
[ Element
nvPicPr
, Element
blipFill
, Element
spPr
]
]
imgElt = Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Element -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:drawing" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:inline" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:extent" [(Text
"cx",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xemu),(Text
"cy",Integer -> Text
forall a. Show a => a -> Text
tshow Integer
yemu)] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:effectExtent"
[(Text
"b",Text
"0"),(Text
"l",Text
"0"),(Text
"r",Text
"0"),(Text
"t",Text
"0")] ()
, Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"wp:docPr"
[ (Text
"descr", [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt)
, (Text
"title", Text
title)
, (Text
"id", Text
docprid)
, (Text
"name",Text
"Picture")
] ()
, Element
graphic
]
return [Elem imgElt]
wrapBookmark imgident =<< case stImage of
Just (String, String, Maybe Text, ByteString)
imgData -> (String, String, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall {m :: * -> *} {b}.
PandocMonad m =>
(String, b, Maybe Text, ByteString)
-> ReaderT WriterEnv (StateT WriterState m) [Content]
generateImgElt (String, String, Maybe Text, ByteString)
imgData
Maybe (String, String, Maybe Text, ByteString)
Nothing -> ( do
(img, mt) <- Text
-> ReaderT
WriterEnv (StateT WriterState m) (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
src
ident <- ("rId" <>) <$> getUniqueId
let
imgext = case Maybe Text
mt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType of
Just Text
x -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
Maybe Text
Nothing -> case ByteString -> Maybe ImageType
imageType ByteString
img of
Just ImageType
Png -> Text
".png"
Just ImageType
Jpeg -> Text
".jpeg"
Just ImageType
Gif -> Text
".gif"
Just ImageType
Pdf -> Text
".pdf"
Just ImageType
Eps -> Text
".eps"
Just ImageType
Svg -> Text
".svg"
Just ImageType
Emf -> Text
".emf"
Just ImageType
Tiff -> Text
".tiff"
Just ImageType
Webp -> Text
".webp"
Maybe ImageType
Nothing -> Text
""
imgpath = Text
"media/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
imgext
mbMimeType = Maybe Text
mt Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
imgpath)
imgData = (Text -> String
T.unpack Text
ident, Text -> String
T.unpack Text
imgpath, Maybe Text
mbMimeType, ByteString
img)
if T.null imgext
then
inlinesToOpenXML opts alt
else do
modify $ \WriterState
st -> WriterState
st { stImages = M.insert (T.unpack src) imgData $ stImages st }
generateImgElt imgData
)
ReaderT WriterEnv (StateT WriterState m) [Content]
-> (PandocError
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a.
ReaderT WriterEnv (StateT WriterState m) a
-> (PandocError -> ReaderT WriterEnv (StateT WriterState m) a)
-> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ( \PandocError
e -> do
LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
-> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (PandocError -> String
forall a. Show a => a -> String
show PandocError
e)
WriterOptions
-> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
alt
)
br :: Element
br :: Element
br = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:r" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:br" [] ()]
withDirection :: PandocMonad m => WS m a -> WS m a
withDirection :: forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
withDirection WS m a
x = do
isRTL <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envRTL
paraProps <- asks envParaProperties
textProps <- asks envTextProperties
let paraProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"bidi") (EnvProps -> [Element]
otherElements EnvProps
paraProps)
textProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"rtl") (EnvProps -> [Element]
otherElements EnvProps
textProps)
paraStyle = EnvProps -> Maybe Element
styleElement EnvProps
paraProps
textStyle = EnvProps -> Maybe Element
styleElement EnvProps
textProps
if isRTL
then flip local x $
\WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
, envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
}
else flip local x $ \WriterEnv
env -> WriterEnv
env { envParaProperties = EnvProps paraStyle paraProps'
, envTextProperties = EnvProps textStyle textProps'
}
wrapBookmark :: (PandocMonad m) => Text -> [Content] -> WS m [Content]
wrapBookmark :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
"" [Content]
contents = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
contents
wrapBookmark Text
ident [Content]
contents = do
id' <- WS m Text
forall (m :: * -> *). PandocMonad m => WS m Text
getUniqueId
let bookmarkStart = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bookmarkStart"
[(Text
"w:id", Text
id')
,(Text
"w:name", Text -> Text
toBookmarkName Text
ident)] ()
bookmarkEnd = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:bookmarkEnd" [(Text
"w:id", Text
id')] ()
return $ Elem bookmarkStart : contents ++ [Elem bookmarkEnd]
toBookmarkName :: Text -> Text
toBookmarkName :: Text -> Text
toBookmarkName Text
s
| Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s
, Char -> Bool
isLetter Char
c
, Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
40 = Text
s
| Bool
otherwise = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'X' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Digest SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 (Text -> ByteString
fromText Text
s)))
maxListLevel :: Int
maxListLevel :: Int
maxListLevel = Int
8
convertSpace :: [Inline] -> [Inline]
convertSpace :: [Inline] -> [Inline]
convertSpace (Str Text
x : Inline
Space : Str Text
y : [Inline]
xs) = [Inline] -> [Inline]
convertSpace (Text -> Inline
Str (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)
convertSpace (Str Text
x : Str Text
y : [Inline]
xs) = [Inline] -> [Inline]
convertSpace (Text -> Inline
Str (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)
convertSpace (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
convertSpace [Inline]
xs
convertSpace [] = []