{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.Docx ( writeDocx ) where
import Codec.Archive.Zip
import Control.Applicative ((<|>))
import Control.Monad.Except (catchError, throwError)
import Control.Monad.Reader
import Control.Monad.State.Strict
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (isSpace, isLetter)
import Data.List (intercalate, isPrefixOf, isSuffixOf)
import Data.String (fromString)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time.Clock.POSIX
import Data.Digest.Pure.SHA (sha1, showDigest)
import Skylighting
import System.Random (randomRs, mkStdGen)
import Text.Pandoc.BCP47 (getLang, renderLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
import qualified Text.Pandoc.Class.PandocMonad as P
import Data.Time
import Text.Pandoc.UTF8 (fromTextLazy)
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Highlighting (highlight)
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
getMimeTypeDef)
import Text.Pandoc.Options
import Text.Pandoc.Writers.Docx.StyleMap
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import Text.TeXMath
import Text.XML.Light as XML
import Text.XML.Light.Cursor as XMLC
import Text.Pandoc.Writers.OOXML
data ListMarker = NoMarker
| BulletMarker
| NumberMarker ListNumberStyle ListNumberDelim Int
deriving (Int -> ListMarker -> ShowS
[ListMarker] -> ShowS
ListMarker -> String
(Int -> ListMarker -> ShowS)
-> (ListMarker -> String)
-> ([ListMarker] -> ShowS)
-> Show ListMarker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMarker] -> ShowS
$cshowList :: [ListMarker] -> ShowS
show :: ListMarker -> String
$cshow :: ListMarker -> String
showsPrec :: Int -> ListMarker -> ShowS
$cshowsPrec :: Int -> ListMarker -> ShowS
Show, ReadPrec [ListMarker]
ReadPrec ListMarker
Int -> ReadS ListMarker
ReadS [ListMarker]
(Int -> ReadS ListMarker)
-> ReadS [ListMarker]
-> ReadPrec ListMarker
-> ReadPrec [ListMarker]
-> Read ListMarker
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMarker]
$creadListPrec :: ReadPrec [ListMarker]
readPrec :: ReadPrec ListMarker
$creadPrec :: ReadPrec ListMarker
readList :: ReadS [ListMarker]
$creadList :: ReadS [ListMarker]
readsPrec :: Int -> ReadS ListMarker
$creadsPrec :: Int -> ReadS ListMarker
Read, ListMarker -> ListMarker -> Bool
(ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> Bool) -> Eq ListMarker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMarker -> ListMarker -> Bool
$c/= :: ListMarker -> ListMarker -> Bool
== :: ListMarker -> ListMarker -> Bool
$c== :: ListMarker -> ListMarker -> Bool
Eq, Eq ListMarker
Eq ListMarker
-> (ListMarker -> ListMarker -> Ordering)
-> (ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> ListMarker)
-> (ListMarker -> ListMarker -> ListMarker)
-> Ord ListMarker
ListMarker -> ListMarker -> Bool
ListMarker -> ListMarker -> Ordering
ListMarker -> ListMarker -> ListMarker
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListMarker -> ListMarker -> ListMarker
$cmin :: ListMarker -> ListMarker -> ListMarker
max :: ListMarker -> ListMarker -> ListMarker
$cmax :: ListMarker -> ListMarker -> ListMarker
>= :: ListMarker -> ListMarker -> Bool
$c>= :: ListMarker -> ListMarker -> Bool
> :: ListMarker -> ListMarker -> Bool
$c> :: ListMarker -> ListMarker -> Bool
<= :: ListMarker -> ListMarker -> Bool
$c<= :: ListMarker -> ListMarker -> Bool
< :: ListMarker -> ListMarker -> Bool
$c< :: ListMarker -> ListMarker -> Bool
compare :: ListMarker -> ListMarker -> Ordering
$ccompare :: ListMarker -> ListMarker -> Ordering
$cp1Ord :: Eq ListMarker
Ord)
listMarkerToId :: ListMarker -> String
listMarkerToId :: ListMarker -> String
listMarkerToId ListMarker
NoMarker = String
"990"
listMarkerToId ListMarker
BulletMarker = String
"991"
listMarkerToId (NumberMarker ListNumberStyle
sty ListNumberDelim
delim Int
n) =
Char
'9' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'9' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
styNum Char -> ShowS
forall a. a -> [a] -> [a]
: Char
delimNum Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n
where styNum :: Char
styNum = case ListNumberStyle
sty of
ListNumberStyle
DefaultStyle -> Char
'2'
ListNumberStyle
Example -> Char
'3'
ListNumberStyle
Decimal -> Char
'4'
ListNumberStyle
LowerRoman -> Char
'5'
ListNumberStyle
UpperRoman -> Char
'6'
ListNumberStyle
LowerAlpha -> Char
'7'
ListNumberStyle
UpperAlpha -> Char
'8'
delimNum :: Char
delimNum = case ListNumberDelim
delim of
ListNumberDelim
DefaultDelim -> Char
'0'
ListNumberDelim
Period -> Char
'1'
ListNumberDelim
OneParen -> Char
'2'
ListNumberDelim
TwoParens -> Char
'3'
data EnvProps = EnvProps{ EnvProps -> Maybe Element
styleElement :: Maybe Element
, EnvProps -> [Element]
otherElements :: [Element]
}
instance Semigroup EnvProps where
EnvProps Maybe Element
s [Element]
es <> :: EnvProps -> EnvProps -> EnvProps
<> EnvProps Maybe Element
s' [Element]
es' = Maybe Element -> [Element] -> EnvProps
EnvProps (Maybe Element
s Maybe Element -> Maybe Element -> Maybe Element
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Element
s') ([Element]
es [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
es')
instance Monoid EnvProps where
mempty :: EnvProps
mempty = Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
forall a. Maybe a
Nothing []
mappend :: EnvProps -> EnvProps -> EnvProps
mappend = EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
(<>)
squashProps :: EnvProps -> [Element]
squashProps :: EnvProps -> [Element]
squashProps (EnvProps Maybe Element
Nothing [Element]
es) = [Element]
es
squashProps (EnvProps (Just Element
e) [Element]
es) = Element
e Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
es
data WriterEnv = WriterEnv{ WriterEnv -> EnvProps
envTextProperties :: EnvProps
, WriterEnv -> EnvProps
envParaProperties :: EnvProps
, WriterEnv -> Bool
envRTL :: Bool
, WriterEnv -> Int
envListLevel :: Int
, WriterEnv -> Int
envListNumId :: Int
, WriterEnv -> Bool
envInDel :: Bool
, WriterEnv -> Text
envChangesAuthor :: T.Text
, WriterEnv -> Text
envChangesDate :: T.Text
, WriterEnv -> Integer
envPrintWidth :: Integer
}
defaultWriterEnv :: WriterEnv
defaultWriterEnv :: WriterEnv
defaultWriterEnv = WriterEnv :: EnvProps
-> EnvProps
-> Bool
-> Int
-> Int
-> Bool
-> Text
-> Text
-> Integer
-> WriterEnv
WriterEnv{ envTextProperties :: EnvProps
envTextProperties = EnvProps
forall a. Monoid a => a
mempty
, envParaProperties :: EnvProps
envParaProperties = EnvProps
forall a. Monoid a => a
mempty
, envRTL :: Bool
envRTL = Bool
False
, envListLevel :: Int
envListLevel = -Int
1
, envListNumId :: Int
envListNumId = Int
1
, envInDel :: Bool
envInDel = Bool
False
, envChangesAuthor :: Text
envChangesAuthor = Text
"unknown"
, envChangesDate :: Text
envChangesDate = Text
"1969-12-31T19:00:00Z"
, envPrintWidth :: Integer
envPrintWidth = Integer
1
}
data WriterState = WriterState{
:: [Element]
, :: [([(T.Text, T.Text)], [Inline])]
, WriterState -> Set Text
stSectionIds :: Set.Set T.Text
, WriterState -> Map String String
stExternalLinks :: M.Map String String
, WriterState -> Map String (String, String, Maybe Text, ByteString)
stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
, WriterState -> [ListMarker]
stLists :: [ListMarker]
, WriterState -> Int
stInsId :: Int
, WriterState -> Int
stDelId :: Int
, WriterState -> StyleMaps
stStyleMaps :: StyleMaps
, WriterState -> Bool
stFirstPara :: Bool
, WriterState -> Bool
stInTable :: Bool
, WriterState -> Bool
stInList :: Bool
, WriterState -> [Inline]
stTocTitle :: [Inline]
, WriterState -> Set ParaStyleName
stDynamicParaProps :: Set.Set ParaStyleName
, WriterState -> Set CharStyleName
stDynamicTextProps :: Set.Set CharStyleName
, WriterState -> Int
stCurId :: Int
}
defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState :: [Element]
-> [([(Text, Text)], [Inline])]
-> Set Text
-> Map String String
-> Map String (String, String, Maybe Text, ByteString)
-> [ListMarker]
-> Int
-> Int
-> StyleMaps
-> Bool
-> Bool
-> Bool
-> [Inline]
-> Set ParaStyleName
-> Set CharStyleName
-> Int
-> WriterState
WriterState{
stFootnotes :: [Element]
stFootnotes = [Element]
defaultFootnotes
, stComments :: [([(Text, Text)], [Inline])]
stComments = []
, stSectionIds :: Set Text
stSectionIds = Set Text
forall a. Set a
Set.empty
, stExternalLinks :: Map String String
stExternalLinks = Map String String
forall k a. Map k a
M.empty
, stImages :: Map String (String, String, Maybe Text, ByteString)
stImages = Map String (String, String, Maybe Text, ByteString)
forall k a. Map k a
M.empty
, stLists :: [ListMarker]
stLists = [ListMarker
NoMarker]
, stInsId :: Int
stInsId = Int
1
, stDelId :: Int
stDelId = Int
1
, stStyleMaps :: StyleMaps
stStyleMaps = CharStyleNameMap -> ParaStyleNameMap -> StyleMaps
StyleMaps CharStyleNameMap
forall k a. Map k a
M.empty ParaStyleNameMap
forall k a. Map k a
M.empty
, stFirstPara :: Bool
stFirstPara = Bool
False
, stInTable :: Bool
stInTable = Bool
False
, stInList :: Bool
stInList = Bool
False
, stTocTitle :: [Inline]
stTocTitle = [Text -> Inline
Str Text
"Table of Contents"]
, stDynamicParaProps :: Set ParaStyleName
stDynamicParaProps = Set ParaStyleName
forall a. Set a
Set.empty
, stDynamicTextProps :: Set CharStyleName
stDynamicTextProps = Set CharStyleName
forall a. Set a
Set.empty
, stCurId :: Int
stCurId = Int
20
}
type WS m = ReaderT WriterEnv (StateT WriterState m)
renumIdMap :: Int -> [Element] -> M.Map String String
renumIdMap :: Int -> [Element] -> Map String String
renumIdMap Int
_ [] = Map String String
forall k a. Map k a
M.empty
renumIdMap Int
n (Element
e:[Element]
es)
| Just String
oldId <- QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"Id" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e =
String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
oldId (String
"rId" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (Int -> [Element] -> Map String String
renumIdMap (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Element]
es)
| Bool
otherwise = Int -> [Element] -> Map String String
renumIdMap Int
n [Element]
es
replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr]
replaceAttr :: (QName -> Bool) -> String -> [Attr] -> [Attr]
replaceAttr QName -> Bool
f String
val = (Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map ((Attr -> Attr) -> [Attr] -> [Attr])
-> (Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> a -> b
$
\Attr
a -> if QName -> Bool
f (Attr -> QName
attrKey Attr
a) then QName -> String -> Attr
XML.Attr (Attr -> QName
attrKey Attr
a) String
val else Attr
a
renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element
renumId :: (QName -> Bool) -> Map String String -> Element -> Element
renumId QName -> Bool
f Map String String
renumMap Element
e
| Just String
oldId <- (QName -> Bool) -> Element -> Maybe String
findAttrBy QName -> Bool
f Element
e
, Just String
newId <- String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
oldId Map String String
renumMap =
let attrs' :: [Attr]
attrs' = (QName -> Bool) -> String -> [Attr] -> [Attr]
replaceAttr QName -> Bool
f String
newId (Element -> [Attr]
elAttribs Element
e)
in
Element
e { elAttribs :: [Attr]
elAttribs = [Attr]
attrs' }
| Bool
otherwise = Element
e
renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element]
renumIds :: (QName -> Bool) -> Map String String -> [Element] -> [Element]
renumIds QName -> Bool
f Map String String
renumMap = (Element -> Element) -> [Element] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((QName -> Bool) -> Map String String -> Element -> Element
renumId QName -> Bool
f Map String String
renumMap)
findAttrTextBy :: (QName -> Bool) -> Element -> Maybe T.Text
findAttrTextBy :: (QName -> Bool) -> Element -> Maybe Text
findAttrTextBy QName -> Bool
x = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Element -> Maybe String) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Bool) -> Element -> Maybe String
findAttrBy QName -> Bool
x
lookupAttrTextBy :: (QName -> Bool) -> [XML.Attr] -> Maybe T.Text
lookupAttrTextBy :: (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrTextBy QName -> Bool
x = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> ([Attr] -> Maybe String) -> [Attr] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Bool) -> [Attr] -> Maybe String
lookupAttrBy QName -> Bool
x
stripInvalidChars :: T.Text -> T.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)
writeDocx :: (PandocMonad m)
=> WriterOptions
-> Pandoc
-> m BL.ByteString
writeDocx :: WriterOptions -> Pandoc -> m ByteString
writeDocx WriterOptions
opts Pandoc
doc = do
let Pandoc Meta
meta [Block]
blocks = (Block -> Block) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
fixDisplayMath Pandoc
doc
let blocks' :: [Block]
blocks' = Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
True Maybe Int
forall a. Maybe a
Nothing [Block]
blocks
let doc' :: Pandoc
doc' = Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks'
Maybe Text
username <- Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
P.lookupEnv Text
"USERNAME"
UTCTime
utctime <- m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getCurrentTime
Maybe String
oldUserDataDir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
P.getUserDataDir
Maybe String -> m ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
P.setUserDataDir Maybe String
forall a. Maybe a
Nothing
ByteString
res <- String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readDefaultDataFile String
"reference.docx"
Maybe String -> m ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
P.setUserDataDir Maybe String
oldUserDataDir
let distArchive :: Archive
distArchive = ByteString -> Archive
toArchive (ByteString -> Archive) -> ByteString -> Archive
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
res
Archive
refArchive <- case WriterOptions -> Maybe String
writerReferenceDoc WriterOptions
opts of
Just String
f -> ByteString -> Archive
toArchive (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
f
Maybe String
Nothing -> ByteString -> Archive
toArchive (ByteString -> Archive)
-> (ByteString -> ByteString) -> ByteString -> Archive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readDataFile String
"reference.docx"
Element
parsedDoc <- Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
refArchive Archive
distArchive String
"word/document.xml"
let wname :: (String -> Bool) -> QName -> Bool
wname String -> Bool
f QName
qn = QName -> Maybe String
qPrefix QName
qn Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"w" Bool -> Bool -> Bool
&& String -> Bool
f (QName -> String
qName QName
qn)
let mbsectpr :: Maybe Element
mbsectpr = (QName -> Bool) -> Element -> Maybe Element
filterElementName ((String -> Bool) -> QName -> Bool
wname (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"sectPr")) Element
parsedDoc
let mbpgsz :: Maybe Element
mbpgsz = Maybe Element
mbsectpr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Bool) -> Element -> Maybe Element
filterElementName ((String -> Bool) -> QName -> Bool
wname (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"pgSz"))
let mbAttrSzWidth :: Maybe Text
mbAttrSzWidth = Maybe Element
mbpgsz Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrTextBy ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"w") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName) ([Attr] -> Maybe Text)
-> (Element -> [Attr]) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Attr]
elAttribs
let mbpgmar :: Maybe Element
mbpgmar = Maybe Element
mbsectpr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Bool) -> Element -> Maybe Element
filterElementName ((String -> Bool) -> QName -> Bool
wname (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"pgMar"))
let mbAttrMarLeft :: Maybe Text
mbAttrMarLeft = Maybe Element
mbpgmar Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrTextBy ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"left") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName) ([Attr] -> Maybe Text)
-> (Element -> [Attr]) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Attr]
elAttribs
let mbAttrMarRight :: Maybe Text
mbAttrMarRight = Maybe Element
mbpgmar Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrTextBy ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"right") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName) ([Attr] -> Maybe Text)
-> (Element -> [Attr]) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Attr]
elAttribs
let pgContentWidth :: Maybe Integer
pgContentWidth = do
Integer
w <- Maybe Text
mbAttrSzWidth Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
Integer
r <- Maybe Text
mbAttrMarRight Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
Integer
l <- Maybe Text
mbAttrMarLeft Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
l
Maybe Lang
mblang <- Maybe Text -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> m (Maybe Lang)) -> Maybe Text -> m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
opts Meta
meta
let addLang :: Element -> Element
addLang :: Element -> Element
addLang Element
e = case (\Lang
l -> Cursor -> Content
XMLC.toTree (Cursor -> Content) -> (Cursor -> Cursor) -> Cursor -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Cursor -> Cursor
go (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Lang -> Text
renderLang Lang
l) (Cursor -> Content) -> Cursor -> Content
forall a b. (a -> b) -> a -> b
$
Element -> Cursor
XMLC.fromElement Element
e) (Lang -> Content) -> Maybe Lang -> Maybe Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Lang
mblang of
Just (Elem Element
e') -> Element
e'
Maybe Content
_ -> Element
e
where go :: String -> Cursor -> Cursor
go :: String -> Cursor -> Cursor
go String
l Cursor
cursor = case (Cursor -> Bool) -> Cursor -> Maybe Cursor
XMLC.findRec (Content -> Bool
isLangElt (Content -> Bool) -> (Cursor -> Content) -> Cursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Content
current) Cursor
cursor of
Maybe Cursor
Nothing -> Cursor
cursor
Just Cursor
t -> (Content -> Content) -> Cursor -> Cursor
XMLC.modifyContent (String -> Content -> Content
setval String
l) Cursor
t
setval :: String -> Content -> Content
setval :: String -> Content -> Content
setval String
l (Elem Element
e') = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element
e'{ elAttribs :: [Attr]
elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Attr -> Attr
setvalattr String
l) ([Attr] -> [Attr]) -> [Attr] -> [Attr]
forall a b. (a -> b) -> a -> b
$
Element -> [Attr]
elAttribs Element
e' }
setval String
_ Content
x = Content
x
setvalattr :: String -> XML.Attr -> XML.Attr
setvalattr :: String -> Attr -> Attr
setvalattr String
l (XML.Attr qn :: QName
qn@(QName String
"val" Maybe String
_ Maybe String
_) String
_) = QName -> String -> Attr
XML.Attr QName
qn String
l
setvalattr String
_ Attr
x = Attr
x
isLangElt :: Content -> Bool
isLangElt (Elem Element
e') = QName -> String
qName (Element -> QName
elName Element
e') String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"lang"
isLangElt Content
_ = Bool
False
let stylepath :: String
stylepath = String
"word/styles.xml"
Element
styledoc <- Element -> Element
addLang (Element -> Element) -> m Element -> m Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
refArchive Archive
distArchive String
stylepath
let styleMaps :: StyleMaps
styleMaps = Archive -> StyleMaps
getStyleMaps Archive
refArchive
let tocTitle :: [Inline]
tocTitle = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"toc-title" Meta
meta of
[] -> WriterState -> [Inline]
stTocTitle WriterState
defaultWriterState
[Inline]
ls -> [Inline]
ls
let initialSt :: WriterState
initialSt = WriterState
defaultWriterState {
stStyleMaps :: StyleMaps
stStyleMaps = StyleMaps
styleMaps
, stTocTitle :: [Inline]
stTocTitle = [Inline]
tocTitle
}
let isRTLmeta :: Bool
isRTLmeta = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"dir" Meta
meta of
Just (MetaString Text
"rtl") -> Bool
True
Just (MetaInlines [Str Text
"rtl"]) -> Bool
True
Maybe MetaValue
_ -> Bool
False
let env :: WriterEnv
env = WriterEnv
defaultWriterEnv {
envRTL :: Bool
envRTL = Bool
isRTLmeta
, envChangesAuthor :: Text
envChangesAuthor = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"unknown" Maybe Text
username
, envChangesDate :: Text
envChangesDate = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%XZ" UTCTime
utctime
, envPrintWidth :: Integer
envPrintWidth = Integer -> (Integer -> Integer) -> Maybe Integer -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
420 (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
20) Maybe Integer
pgContentWidth
}
(([Content]
contents, [Element]
footnotes, [Element]
comments), WriterState
st) <- StateT WriterState m ([Content], [Element], [Element])
-> WriterState
-> m (([Content], [Element], [Element]), WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
(ReaderT
WriterEnv (StateT WriterState m) ([Content], [Element], [Element])
-> WriterEnv
-> StateT WriterState m ([Content], [Element], [Element])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
(WriterOptions
-> Pandoc
-> ReaderT
WriterEnv (StateT WriterState m) ([Content], [Element], [Element])
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> WS m ([Content], [Element], [Element])
writeOpenXML WriterOptions
opts{writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapNone} Pandoc
doc')
WriterEnv
env)
WriterState
initialSt
let epochtime :: Integer
epochtime = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utctime
let imgs :: [(String, String, Maybe Text, ByteString)]
imgs = Map String (String, String, Maybe Text, ByteString)
-> [(String, String, Maybe Text, ByteString)]
forall k a. Map k a -> [a]
M.elems (Map String (String, String, Maybe Text, ByteString)
-> [(String, String, Maybe Text, ByteString)])
-> Map String (String, String, Maybe Text, ByteString)
-> [(String, String, Maybe Text, ByteString)]
forall a b. (a -> b) -> a -> b
$ WriterState -> Map String (String, String, Maybe Text, ByteString)
stImages WriterState
st
let toImageEntry :: (a, String, c, ByteString) -> Entry
toImageEntry (a
_,String
path,c
_,ByteString
img) = String -> Integer -> ByteString -> Entry
toEntry (String
"word/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path) Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toLazy ByteString
img
let imageEntries :: [Entry]
imageEntries = ((String, String, Maybe Text, ByteString) -> Entry)
-> [(String, String, Maybe Text, ByteString)] -> [Entry]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Maybe Text, ByteString) -> Entry
forall a c. (a, String, c, ByteString) -> Entry
toImageEntry [(String, String, Maybe Text, ByteString)]
imgs
let stdAttributes :: [(String, String)]
stdAttributes =
[(String
"xmlns:w",String
"http://schemas.openxmlformats.org/wordprocessingml/2006/main")
,(String
"xmlns:m",String
"http://schemas.openxmlformats.org/officeDocument/2006/math")
,(String
"xmlns:r",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships")
,(String
"xmlns:o",String
"urn:schemas-microsoft-com:office:office")
,(String
"xmlns:v",String
"urn:schemas-microsoft-com:vml")
,(String
"xmlns:w10",String
"urn:schemas-microsoft-com:office:word")
,(String
"xmlns:a",String
"http://schemas.openxmlformats.org/drawingml/2006/main")
,(String
"xmlns:pic",String
"http://schemas.openxmlformats.org/drawingml/2006/picture")
,(String
"xmlns:wp",String
"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
Element
parsedRels <- Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
refArchive Archive
distArchive String
"word/_rels/document.xml.rels"
let isHeaderNode :: Element -> Bool
isHeaderNode Element
e = QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"Type" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"
let isFooterNode :: Element -> Bool
isFooterNode Element
e = QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"Type" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) Element
e Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer"
let headers :: [Element]
headers = (Element -> Bool) -> Element -> [Element]
filterElements Element -> Bool
isHeaderNode Element
parsedRels
let footers :: [Element]
footers = (Element -> Bool) -> Element -> [Element]
filterElements Element -> Bool
isFooterNode Element
parsedRels
let extractTarget :: Element -> Maybe String
extractTarget = QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"Target" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
let mkOverrideNode :: (String, String) -> Element
mkOverrideNode (String
part', String
contentType') = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Override"
[(String
"PartName",String
part'),(String
"ContentType",String
contentType')] ()
let mkImageOverride :: (a, String, Maybe Text, d) -> Element
mkImageOverride (a
_, String
imgpath, Maybe Text
mbMimeType, d
_) =
(String, String) -> Element
mkOverrideNode (String
"/word/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
imgpath,
String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"application/octet-stream" Text -> String
T.unpack Maybe Text
mbMimeType)
let mkMediaOverride :: String -> Element
mkMediaOverride String
imgpath =
(String, String) -> Element
mkOverrideNode (Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
imgpath, Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ String -> Text
getMimeTypeDef String
imgpath)
let overrides :: [Element]
overrides = ((String, String) -> Element) -> [(String, String)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Element
mkOverrideNode (
[(String
"/word/webSettings.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")
,(String
"/word/numbering.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.numbering+xml")
,(String
"/word/settings.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.settings+xml")
,(String
"/word/theme/theme1.xml",
String
"application/vnd.openxmlformats-officedocument.theme+xml")
,(String
"/word/fontTable.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.fontTable+xml")
,(String
"/docProps/app.xml",
String
"application/vnd.openxmlformats-officedocument.extended-properties+xml")
,(String
"/docProps/core.xml",
String
"application/vnd.openxmlformats-package.core-properties+xml")
,(String
"/docProps/custom.xml",
String
"application/vnd.openxmlformats-officedocument.custom-properties+xml")
,(String
"/word/styles.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml")
,(String
"/word/document.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")
,(String
"/word/comments.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml")
,(String
"/word/footnotes.xml",
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
(Element -> (String, String)) -> [Element] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Element
x -> (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"/word/" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Element -> Maybe String
extractTarget Element
x,
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) [Element]
headers [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
(Element -> (String, String)) -> [Element] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Element
x -> (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"/word/" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Element -> Maybe String
extractTarget Element
x,
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) [Element]
footers) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
((String, String, Maybe Text, ByteString) -> Element)
-> [(String, String, Maybe Text, ByteString)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Maybe Text, ByteString) -> Element
forall a d. (a, String, Maybe Text, d) -> Element
mkImageOverride [(String, String, Maybe Text, ByteString)]
imgs [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> Element
mkMediaOverride (Entry -> String
eRelativePath Entry
e) | Entry
e <- Archive -> [Entry]
zEntries Archive
refArchive
, String
"word/media/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Entry -> String
eRelativePath Entry
e ]
let defaultnodes :: [Element]
defaultnodes = [String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Default"
[(String
"Extension",String
"xml"),(String
"ContentType",String
"application/xml")] (),
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Default"
[(String
"Extension",String
"rels"),(String
"ContentType",String
"application/vnd.openxmlformats-package.relationships+xml")] ()]
let contentTypesDoc :: Element
contentTypesDoc = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Types" [(String
"xmlns",String
"http://schemas.openxmlformats.org/package/2006/content-types")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
defaultnodes [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
overrides
let contentTypesEntry :: Entry
contentTypesEntry = String -> Integer -> ByteString -> Entry
toEntry String
"[Content_Types].xml" Integer
epochtime
(ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
contentTypesDoc
let toBaseRel :: (String, String, String) -> Element
toBaseRel (String
url', String
id', String
target') = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationship"
[(String
"Type",String
url')
,(String
"Id",String
id')
,(String
"Target",String
target')] ()
let baserels' :: [Element]
baserels' = ((String, String, String) -> Element)
-> [(String, String, String)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, String) -> Element
toBaseRel
[(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/numbering",
String
"rId1",
String
"numbering.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles",
String
"rId2",
String
"styles.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/settings",
String
"rId3",
String
"settings.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/webSettings",
String
"rId4",
String
"webSettings.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/fontTable",
String
"rId5",
String
"fontTable.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/theme",
String
"rId6",
String
"theme/theme1.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
String
"rId7",
String
"footnotes.xml")
,(String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
String
"rId8",
String
"comments.xml")
]
let idMap :: Map String String
idMap = Int -> [Element] -> Map String String
renumIdMap ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
baserels' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Element]
headers [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
footers)
let renumHeaders :: [Element]
renumHeaders = (QName -> Bool) -> Map String String -> [Element] -> [Element]
renumIds (\QName
q -> QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Id") Map String String
idMap [Element]
headers
let renumFooters :: [Element]
renumFooters = (QName -> Bool) -> Map String String -> [Element] -> [Element]
renumIds (\QName
q -> QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Id") Map String String
idMap [Element]
footers
let baserels :: [Element]
baserels = [Element]
baserels' [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
renumHeaders [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
renumFooters
let toImgRel :: (String, String, c, d) -> Element
toImgRel (String
ident,String
path,c
_,d
_) = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationship" [(String
"Type",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),(String
"Id",String
ident),(String
"Target",String
path)] ()
let imgrels :: [Element]
imgrels = ((String, String, Maybe Text, ByteString) -> Element)
-> [(String, String, Maybe Text, ByteString)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Maybe Text, ByteString) -> Element
forall c d. (String, String, c, d) -> Element
toImgRel [(String, String, Maybe Text, ByteString)]
imgs
let toLinkRel :: (String, String) -> Element
toLinkRel (String
src,String
ident) = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationship" [(String
"Type",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),(String
"Id",String
ident),(String
"Target",String
src),(String
"TargetMode",String
"External") ] ()
let linkrels :: [Element]
linkrels = ((String, String) -> Element) -> [(String, String)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Element
toLinkRel ([(String, String)] -> [Element])
-> [(String, String)] -> [Element]
forall a b. (a -> b) -> a -> b
$ Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String String -> [(String, String)])
-> Map String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ WriterState -> Map String String
stExternalLinks WriterState
st
let reldoc :: Element
reldoc = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationships" [(String
"xmlns",String
"http://schemas.openxmlformats.org/package/2006/relationships")] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
baserels [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
imgrels [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
linkrels
let relEntry :: Entry
relEntry = String -> Integer -> ByteString -> Entry
toEntry String
"word/_rels/document.xml.rels" Integer
epochtime
(ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
reldoc
let sectpr :: Element
sectpr = case Maybe Element
mbsectpr of
Just Element
sectpr' -> let cs :: [Element]
cs = (QName -> Bool) -> Map String String -> [Element] -> [Element]
renumIds
(\QName
q -> QName -> String
qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"id" Bool -> Bool -> Bool
&& QName -> Maybe String
qPrefix QName
q Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"r")
Map String String
idMap
(Element -> [Element]
elChildren Element
sectpr')
in
[Attr] -> Element -> Element
add_attrs (Element -> [Attr]
elAttribs Element
sectpr') (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:sectPr" [] [Element]
cs
Maybe Element
Nothing -> String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:sectPr" [] ()
let contents' :: [Content]
contents' = [Content]
contents [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
sectpr]
let docContents :: Element
docContents = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:document" [(String, String)]
stdAttributes
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:body" [] [Content]
contents'
let contentEntry :: Entry
contentEntry = String -> Integer -> ByteString -> Entry
toEntry String
"word/document.xml" Integer
epochtime
(ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
docContents
let notes :: Element
notes = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnotes" [(String, String)]
stdAttributes [Element]
footnotes
let footnotesEntry :: Entry
footnotesEntry = String -> Integer -> ByteString -> Entry
toEntry String
"word/footnotes.xml" Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
notes
let footnoteRelEntry :: Entry
footnoteRelEntry = String -> Integer -> ByteString -> Entry
toEntry String
"word/_rels/footnotes.xml.rels" Integer
epochtime
(ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationships" [(String
"xmlns",String
"http://schemas.openxmlformats.org/package/2006/relationships")]
[Element]
linkrels
let commentsEntry :: Entry
commentsEntry = String -> Integer -> ByteString -> Entry
toEntry String
"word/comments.xml" Integer
epochtime
(ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:comments" [(String, String)]
stdAttributes [Element]
comments
let newDynamicParaProps :: [ParaStyleName]
newDynamicParaProps = (ParaStyleName -> Bool) -> [ParaStyleName] -> [ParaStyleName]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\ParaStyleName
sty -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ParaStyleName -> ParaStyleNameMap -> Bool
forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
hasStyleName ParaStyleName
sty (ParaStyleNameMap -> Bool) -> ParaStyleNameMap -> Bool
forall a b. (a -> b) -> a -> b
$ StyleMaps -> ParaStyleNameMap
smParaStyle StyleMaps
styleMaps)
(Set ParaStyleName -> [ParaStyleName]
forall a. Set a -> [a]
Set.toList (Set ParaStyleName -> [ParaStyleName])
-> Set ParaStyleName -> [ParaStyleName]
forall a b. (a -> b) -> a -> b
$ WriterState -> Set ParaStyleName
stDynamicParaProps WriterState
st)
newDynamicTextProps :: [CharStyleName]
newDynamicTextProps = (CharStyleName -> Bool) -> [CharStyleName] -> [CharStyleName]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\CharStyleName
sty -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CharStyleName -> CharStyleNameMap -> Bool
forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
hasStyleName CharStyleName
sty (CharStyleNameMap -> Bool) -> CharStyleNameMap -> Bool
forall a b. (a -> b) -> a -> b
$ StyleMaps -> CharStyleNameMap
smCharStyle StyleMaps
styleMaps)
(Set CharStyleName -> [CharStyleName]
forall a. Set a -> [a]
Set.toList (Set CharStyleName -> [CharStyleName])
-> Set CharStyleName -> [CharStyleName]
forall a b. (a -> b) -> a -> b
$ WriterState -> Set CharStyleName
stDynamicTextProps WriterState
st)
let newstyles :: [Element]
newstyles = (ParaStyleName -> Element) -> [ParaStyleName] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ParaStyleName -> Element
newParaPropToOpenXml [ParaStyleName]
newDynamicParaProps [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(CharStyleName -> Element) -> [CharStyleName] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map CharStyleName -> Element
newTextPropToOpenXml [CharStyleName]
newDynamicTextProps [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[Element] -> (Style -> [Element]) -> Maybe Style -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (StyleMaps -> Style -> [Element]
styleToOpenXml StyleMaps
styleMaps) (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
let styledoc' :: Element
styledoc' = Element
styledoc{ elContent :: [Content]
elContent = Element -> [Content]
elContent Element
styledoc [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++
(Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
newstyles }
let styleEntry :: Entry
styleEntry = String -> Integer -> ByteString -> Entry
toEntry String
stylepath Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
styledoc'
let numpath :: String
numpath = String
"word/numbering.xml"
Element
numbering <- Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
refArchive Archive
distArchive String
numpath
let newNumElts :: [Element]
newNumElts = [ListMarker] -> [Element]
mkNumbering (WriterState -> [ListMarker]
stLists WriterState
st)
let pandocAdded :: Element -> Bool
pandocAdded Element
e =
case (QName -> Bool) -> Element -> Maybe Text
findAttrTextBy ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"abstractNumId") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName) Element
e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
Just Int
numid -> Int
numid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
990 :: Int)
Maybe Int
Nothing ->
case (QName -> Bool) -> Element -> Maybe Text
findAttrTextBy ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"numId") (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName) Element
e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
Just Int
numid -> Int
numid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1000 :: Int)
Maybe Int
Nothing -> Bool
False
let oldElts :: [Element]
oldElts = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Element -> Bool) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Bool
pandocAdded) ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ [Content] -> [Element]
onlyElems (Element -> [Content]
elContent Element
numbering)
let allElts :: [Element]
allElts = [Element]
oldElts [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
newNumElts
let numEntry :: Entry
numEntry = String -> Integer -> ByteString -> Entry
toEntry String
numpath Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
numbering{ elContent :: [Content]
elContent =
[Element -> Content
Elem Element
e | Element
e <- [Element]
allElts
, QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"abstractNum" ] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++
[Element -> Content
Elem Element
e | Element
e <- [Element]
allElts
, QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"num" ] }
let keywords :: [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"keywords" Meta
meta of
Just (MetaList [MetaValue]
xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
forall a. Walkable Inline a => a -> Text
stringify [MetaValue]
xs
Maybe MetaValue
_ -> []
let docPropsPath :: String
docPropsPath = String
"docProps/core.xml"
let extraCoreProps :: [Text]
extraCoreProps = [Text
"subject",Text
"lang",Text
"category",Text
"description"]
let extraCorePropsMap :: Map Text String
extraCorePropsMap = [(Text, String)] -> Map Text String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, String)] -> Map Text String)
-> [(Text, String)] -> Map Text String
forall a b. (a -> b) -> a -> b
$ [Text] -> [String] -> [(Text, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
extraCoreProps
[String
"dc:subject",String
"dc:language",String
"cp:category",String
"dc:description"]
let lookupMetaString' :: T.Text -> Meta -> T.Text
lookupMetaString' :: Text -> Meta -> Text
lookupMetaString' Text
key' Meta
meta' =
case Text
key' of
Text
"description" -> Text -> [Text] -> Text
T.intercalate Text
"_x000d_\n" ((Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta')
Text
key'' -> Text -> Meta -> Text
lookupMetaString Text
key'' Meta
meta'
let docProps :: Element
docProps = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"cp:coreProperties"
[(String
"xmlns:cp",String
"http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
,(String
"xmlns:dc",String
"http://purl.org/dc/elements/1.1/")
,(String
"xmlns:dcterms",String
"http://purl.org/dc/terms/")
,(String
"xmlns:dcmitype",String
"http://purl.org/dc/dcmitype/")
,(String
"xmlns:xsi",String
"http://www.w3.org/2001/XMLSchema-instance")]
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Text -> Element
mktnode String
"dc:title" [] ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta)
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [(String, String)] -> Text -> Element
mktnode String
"dc:creator" [] (Text -> [Text] -> Text
T.intercalate Text
"; " (([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta))
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [ String -> [(String, String)] -> Text -> Element
mktnode (String -> Text -> Map Text String -> String
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault String
"" Text
k Map Text String
extraCorePropsMap) [] (Text -> Meta -> Text
lookupMetaString' Text
k Meta
meta)
| Text
k <- Map Text MetaValue -> [Text]
forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta), Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
extraCoreProps]
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"cp:keywords" [] (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
", " [Text]
keywords)
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: (\String
x -> [ String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"dcterms:created" [(String
"xsi:type",String
"dcterms:W3CDTF")] String
x
, String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"dcterms:modified" [(String
"xsi:type",String
"dcterms:W3CDTF")] String
x
]) (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%XZ" UTCTime
utctime)
let docPropsEntry :: Entry
docPropsEntry = String -> Integer -> ByteString -> Entry
toEntry String
docPropsPath Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
docProps
let customProperties :: [(String, String)]
customProperties :: [(String, String)]
customProperties = [ (Text -> String
T.unpack Text
k, Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
lookupMetaString Text
k Meta
meta)
| Text
k <- Map Text MetaValue -> [Text]
forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Text
"title", Text
"author", Text
"keywords"]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
extraCoreProps)]
let mkCustomProp :: (String, t) -> a -> Element
mkCustomProp (String
k, t
v) a
pid = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"property"
[(String
"fmtid",String
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
,(String
"pid", a -> String
forall a. Show a => a -> String
show a
pid)
,(String
"name", String
k)] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> t -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"vt:lpwstr" [] t
v
let customPropsPath :: String
customPropsPath = String
"docProps/custom.xml"
let customProps :: Element
customProps = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Properties"
[(String
"xmlns",String
"http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
,(String
"xmlns:vt",String
"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Int -> Element)
-> [(String, String)] -> [Int] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, String) -> Int -> Element
forall a t. (Show a, Node t) => (String, t) -> a -> Element
mkCustomProp [(String, String)]
customProperties [(Int
2 :: Int)..]
let customPropsEntry :: Entry
customPropsEntry = String -> Integer -> ByteString -> Entry
toEntry String
customPropsPath Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
customProps
let relsPath :: String
relsPath = String
"_rels/.rels"
let rels :: Element
rels = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationships" [(String
"xmlns", String
"http://schemas.openxmlformats.org/package/2006/relationships")]
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ ([(String, String)] -> Element)
-> [[(String, String)]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\[(String, String)]
attrs -> String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"Relationship" [(String, String)]
attrs ())
[ [(String
"Id",String
"rId1")
,(String
"Type",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")
,(String
"Target",String
"word/document.xml")]
, [(String
"Id",String
"rId4")
,(String
"Type",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties")
,(String
"Target",String
"docProps/app.xml")]
, [(String
"Id",String
"rId3")
,(String
"Type",String
"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties")
,(String
"Target",String
"docProps/core.xml")]
, [(String
"Id",String
"rId5")
,(String
"Type",String
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties")
,(String
"Target",String
"docProps/custom.xml")]
]
let relsEntry :: Entry
relsEntry = String -> Integer -> ByteString -> Entry
toEntry String
relsPath Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
rels
let settingsPath :: String
settingsPath = String
"word/settings.xml"
settingsList :: [String]
settingsList = [ String
"w:autoHyphenation"
, String
"w:consecutiveHyphenLimit"
, String
"w:hyphenationZone"
, String
"w:doNotHyphenateCap"
, String
"w:evenAndOddHeaders"
, String
"w:proofState"
]
Entry
settingsEntry <- Archive -> Archive -> String -> Integer -> [String] -> m Entry
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> Integer -> [String] -> m Entry
copyChildren Archive
refArchive Archive
distArchive String
settingsPath Integer
epochtime [String]
settingsList
let entryFromArchive :: Archive -> String -> m Entry
entryFromArchive Archive
arch String
path =
m Entry -> (Entry -> m Entry) -> Maybe Entry -> m Entry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PandocError -> m Entry
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Entry) -> PandocError -> m Entry
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
(Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" missing in reference docx")
Entry -> m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return
(String -> Archive -> Maybe Entry
findEntryByPath String
path Archive
arch Maybe Entry -> Maybe Entry -> Maybe Entry
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> Archive -> Maybe Entry
findEntryByPath String
path Archive
distArchive)
Entry
docPropsAppEntry <- Archive -> String -> m Entry
forall (m :: * -> *).
MonadError PandocError m =>
Archive -> String -> m Entry
entryFromArchive Archive
refArchive String
"docProps/app.xml"
Entry
themeEntry <- Archive -> String -> m Entry
forall (m :: * -> *).
MonadError PandocError m =>
Archive -> String -> m Entry
entryFromArchive Archive
refArchive String
"word/theme/theme1.xml"
Entry
fontTableEntry <- Archive -> String -> m Entry
forall (m :: * -> *).
MonadError PandocError m =>
Archive -> String -> m Entry
entryFromArchive Archive
refArchive String
"word/fontTable.xml"
Entry
webSettingsEntry <- Archive -> String -> m Entry
forall (m :: * -> *).
MonadError PandocError m =>
Archive -> String -> m Entry
entryFromArchive Archive
refArchive String
"word/webSettings.xml"
[Entry]
headerFooterEntries <- (String -> m Entry) -> [String] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Archive -> String -> m Entry
forall (m :: * -> *).
MonadError PandocError m =>
Archive -> String -> m Entry
entryFromArchive Archive
refArchive (String -> m Entry) -> ShowS -> String -> m Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"word/" String -> ShowS
forall a. [a] -> [a] -> [a]
++)) ([String] -> m [Entry]) -> [String] -> m [Entry]
forall a b. (a -> b) -> a -> b
$
(Element -> Maybe String) -> [Element] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe String
extractTarget ([Element]
headers [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
footers)
let miscRelEntries :: [Entry]
miscRelEntries = [ Entry
e | Entry
e <- Archive -> [Entry]
zEntries Archive
refArchive
, String
"word/_rels/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Entry -> String
eRelativePath Entry
e
, String
".xml.rels" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Entry -> String
eRelativePath Entry
e
, Entry -> String
eRelativePath Entry
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"word/_rels/document.xml.rels"
, Entry -> String
eRelativePath Entry
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"word/_rels/footnotes.xml.rels" ]
let otherMediaEntries :: [Entry]
otherMediaEntries = [ Entry
e | Entry
e <- Archive -> [Entry]
zEntries Archive
refArchive
, String
"word/media/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Entry -> String
eRelativePath Entry
e ]
let archive :: Archive
archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> [Entry] -> Archive
forall a b. (a -> b) -> a -> b
$
Entry
contentTypesEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
relsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
contentEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
relEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
Entry
footnoteRelEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
numEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
styleEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
footnotesEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
Entry
commentsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
Entry
docPropsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
docPropsAppEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
customPropsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
Entry
themeEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
Entry
fontTableEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
settingsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: Entry
webSettingsEntry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
[Entry]
imageEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
headerFooterEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++
[Entry]
miscRelEntries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
otherMediaEntries
ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive
newParaPropToOpenXml :: ParaStyleName -> Element
newParaPropToOpenXml :: ParaStyleName -> Element
newParaPropToOpenXml (ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
fromStyleName -> Text
s) =
let styleId :: Text
styleId = (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
s
in String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:style" [ (String
"w:type", String
"paragraph")
, (String
"w:customStyle", String
"1")
, (String
"w:styleId", Text -> String
T.unpack Text
styleId)]
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:name" [(String
"w:val", Text -> String
T.unpack Text
s)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:basedOn" [(String
"w:val",String
"BodyText")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:qFormat" [] ()
]
newTextPropToOpenXml :: CharStyleName -> Element
newTextPropToOpenXml :: CharStyleName -> Element
newTextPropToOpenXml (CharStyleName -> Text
forall a. FromStyleName a => a -> Text
fromStyleName -> Text
s) =
let styleId :: Text
styleId = (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
s
in String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:style" [ (String
"w:type", String
"character")
, (String
"w:customStyle", String
"1")
, (String
"w:styleId", Text -> String
T.unpack Text
styleId)]
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:name" [(String
"w:val", Text -> String
T.unpack Text
s)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:basedOn" [(String
"w:val",String
"BodyTextChar")] ()
]
styleToOpenXml :: StyleMaps -> Style -> [Element]
styleToOpenXml :: StyleMaps -> Style -> [Element]
styleToOpenXml StyleMaps
sm Style
style =
Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList Maybe Element
parStyle [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ (TokenType -> Maybe Element) -> [TokenType] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TokenType -> Maybe Element
toStyle [TokenType]
alltoktypes
where alltoktypes :: [TokenType]
alltoktypes = TokenType -> TokenType -> [TokenType]
forall a. Enum a => a -> a -> [a]
enumFromTo TokenType
KeywordTok TokenType
NormalTok
toStyle :: TokenType -> Maybe Element
toStyle TokenType
toktype | CharStyleName -> CharStyleNameMap -> Bool
forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
hasStyleName (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
toktype) (StyleMaps -> CharStyleNameMap
smCharStyle StyleMaps
sm) = Maybe Element
forall a. Maybe a
Nothing
| Bool
otherwise = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:style" [(String
"w:type",String
"character"),
(String
"w:customStyle",String
"1"),(String
"w:styleId",TokenType -> String
forall a. Show a => a -> String
show TokenType
toktype)]
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:name" [(String
"w:val",TokenType -> String
forall a. Show a => a -> String
show TokenType
toktype)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:basedOn" [(String
"w:val",String
"VerbatimChar")] ()
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:color" [(String
"w:val",TokenType -> String
tokCol TokenType
toktype)] ()
| TokenType -> String
tokCol TokenType
toktype String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"auto" ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:shd" [(String
"w:val",String
"clear"),(String
"w:fill",TokenType -> String
tokBg TokenType
toktype)] ()
| TokenType -> String
tokBg TokenType
toktype String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"auto" ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:b" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
tokFeature TokenStyle -> Bool
tokenBold TokenType
toktype ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:i" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
tokFeature TokenStyle -> Bool
tokenItalic TokenType
toktype ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:u" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
tokFeature TokenStyle -> Bool
tokenUnderline TokenType
toktype ]
]
tokStyles :: Map TokenType TokenStyle
tokStyles = Style -> Map TokenType TokenStyle
tokenStyles Style
style
tokFeature :: (TokenStyle -> Bool) -> TokenType -> Bool
tokFeature TokenStyle -> Bool
f TokenType
toktype = Bool -> (TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TokenStyle -> Bool
f (Maybe TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
forall a b. (a -> b) -> a -> b
$ TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
toktype Map TokenType TokenStyle
tokStyles
tokCol :: TokenType -> String
tokCol TokenType
toktype = String -> (Color -> String) -> Maybe Color -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"auto" (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> (Color -> String) -> Color -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> String
forall a. FromColor a => Color -> a
fromColor)
(Maybe Color -> String) -> Maybe Color -> String
forall a b. (a -> b) -> a -> b
$ (TokenStyle -> Maybe Color
tokenColor (TokenStyle -> Maybe Color) -> Maybe TokenStyle -> Maybe Color
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
toktype Map TokenType TokenStyle
tokStyles)
Maybe Color -> Maybe Color -> Maybe Color
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Style -> Maybe Color
defaultColor Style
style
tokBg :: TokenType -> String
tokBg TokenType
toktype = String -> (Color -> String) -> Maybe Color -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"auto" (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> (Color -> String) -> Color -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> String
forall a. FromColor a => Color -> a
fromColor)
(Maybe Color -> String) -> Maybe Color -> String
forall a b. (a -> b) -> a -> b
$ (TokenStyle -> Maybe Color
tokenBackground (TokenStyle -> Maybe Color) -> Maybe TokenStyle -> Maybe Color
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
toktype Map TokenType TokenStyle
tokStyles)
Maybe Color -> Maybe Color -> Maybe Color
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Style -> Maybe Color
backgroundColor Style
style
parStyle :: Maybe Element
parStyle | ParaStyleName -> ParaStyleNameMap -> Bool
forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
hasStyleName ParaStyleName
"Source Code" (StyleMaps -> ParaStyleNameMap
smParaStyle StyleMaps
sm) = Maybe Element
forall a. Maybe a
Nothing
| Bool
otherwise = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:style" [(String
"w:type",String
"paragraph"),
(String
"w:customStyle",String
"1"),(String
"w:styleId",String
"SourceCode")]
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:name" [(String
"w:val",String
"Source Code")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:basedOn" [(String
"w:val",String
"Normal")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:link" [(String
"w:val",String
"VerbatimChar")] ()
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" []
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:wordWrap" [(String
"w:val",String
"off")] ()
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[Element] -> (Color -> [Element]) -> Maybe Color -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Color
col -> [String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:shd" [(String
"w:val",String
"clear"),(String
"w:fill",Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Color -> String
forall a. FromColor a => Color -> a
fromColor Color
col)] ()]) (Style -> Maybe Color
backgroundColor Style
style)
]
copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry
copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> m Entry
copyChildren Archive
refArchive Archive
distArchive String
path Integer
timestamp [String]
elNames = do
Element
ref <- Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
refArchive Archive
distArchive String
path
Element
dist <- Archive -> Archive -> String -> m Element
forall (m :: * -> *).
PandocMonad m =>
Archive -> Archive -> String -> m Element
parseXml Archive
distArchive Archive
distArchive String
path
Entry -> m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> m Entry) -> Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
timestamp (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ Element -> ByteString
renderXml Element
dist{
elContent :: [Content]
elContent = Element -> [Content]
elContent Element
dist [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ Element -> [Content]
copyContent Element
ref
}
where
strName :: QName -> String
strName QName{qName :: QName -> String
qName=String
name, qPrefix :: QName -> Maybe String
qPrefix=Maybe String
prefix}
| Just String
p <- Maybe String
prefix = String
pString -> ShowS
forall a. [a] -> [a] -> [a]
++String
":"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
name
| Bool
otherwise = String
name
shouldCopy :: QName -> Bool
shouldCopy = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
elNames) (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
strName
cleanElem :: Element -> Content
cleanElem el :: Element
el@Element{elName :: Element -> QName
elName=QName
name} = Element -> Content
Elem Element
el{elName :: QName
elName=QName
name{qURI :: Maybe String
qURI=Maybe String
forall a. Maybe a
Nothing}}
copyContent :: Element -> [Content]
copyContent = (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
cleanElem ([Element] -> [Content])
-> (Element -> [Element]) -> Element -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Bool) -> Element -> [Element]
filterChildrenName QName -> Bool
shouldCopy
baseListId :: Int
baseListId :: Int
baseListId = Int
1000
mkNumbering :: [ListMarker] -> [Element]
mkNumbering :: [ListMarker] -> [Element]
mkNumbering [ListMarker]
lists =
[Element]
elts [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ (ListMarker -> Int -> Element)
-> [ListMarker] -> [Int] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ListMarker -> Int -> Element
mkNum [ListMarker]
lists [Int
baseListId..(Int
baseListId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ListMarker] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ListMarker]
lists Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
where elts :: [Element]
elts = (ListMarker -> Integer -> Element)
-> [ListMarker] -> [Integer] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ListMarker -> Integer -> Element
mkAbstractNum ([ListMarker] -> [ListMarker]
forall a. Ord a => [a] -> [a]
ordNub [ListMarker]
lists) ([Integer] -> [Element]) -> [Integer] -> [Element]
forall a b. (a -> b) -> a -> b
$
(Integer, Integer) -> StdGen -> [Integer]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Integer
0x10000000, Integer
0xFFFFFFFF) (StdGen -> [Integer]) -> StdGen -> [Integer]
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
1848
maxListLevel :: Int
maxListLevel :: Int
maxListLevel = Int
8
mkNum :: ListMarker -> Int -> Element
mkNum :: ListMarker -> Int -> Element
mkNum ListMarker
marker Int
numid =
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:num" [(String
"w:numId",Int -> String
forall a. Show a => a -> String
show Int
numid)]
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:abstractNumId" [(String
"w:val",ListMarker -> String
listMarkerToId ListMarker
marker)] ()
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: case ListMarker
marker of
ListMarker
NoMarker -> []
ListMarker
BulletMarker -> []
NumberMarker ListNumberStyle
_ ListNumberDelim
_ Int
start ->
(Int -> Element) -> [Int] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
lvl -> String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:lvlOverride" [(String
"w:ilvl",Int -> String
forall a. Show a => a -> String
show (Int
lvl :: Int))]
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:startOverride" [(String
"w:val",Int -> String
forall a. Show a => a -> String
show Int
start)] ())
[Int
0..Int
maxListLevel]
mkAbstractNum :: ListMarker -> Integer -> Element
mkAbstractNum :: ListMarker -> Integer -> Element
mkAbstractNum ListMarker
marker Integer
nsid =
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:abstractNum" [(String
"w:abstractNumId",ListMarker -> String
listMarkerToId ListMarker
marker)]
([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:nsid" [(String
"w:val", String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%8x" Integer
nsid)] ()
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:multiLevelType" [(String
"w:val",String
"multilevel")] ()
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: (Int -> Element) -> [Int] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (ListMarker -> Int -> Element
mkLvl ListMarker
marker)
[Int
0..Int
maxListLevel]
mkLvl :: ListMarker -> Int -> Element
mkLvl :: ListMarker -> Int -> Element
mkLvl ListMarker
marker Int
lvl =
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:lvl" [(String
"w:ilvl",Int -> String
forall a. Show a => a -> String
show Int
lvl)] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:start" [(String
"w:val",String
start)] ()
| ListMarker
marker ListMarker -> ListMarker -> Bool
forall a. Eq a => a -> a -> Bool
/= ListMarker
NoMarker Bool -> Bool -> Bool
&& ListMarker
marker ListMarker -> ListMarker -> Bool
forall a. Eq a => a -> a -> Bool
/= ListMarker
BulletMarker ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:numFmt" [(String
"w:val",String
fmt)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:lvlText" [(String
"w:val",String
lvltxt)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:lvlJc" [(String
"w:val",String
"left")] ()
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:ind" [ (String
"w:left",Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
, (String
"w:hanging",Int -> String
forall a. Show a => a -> String
show (Int
hang :: Int))
] ()
]
]
where (String
fmt, String
lvltxt, String
start) =
case ListMarker
marker of
ListMarker
NoMarker -> (String
"bullet",String
" ",String
"1")
ListMarker
BulletMarker -> (String
"bullet",Int -> String
forall t p. (IsString p, Integral t) => t -> p
bulletFor Int
lvl,String
"1")
NumberMarker ListNumberStyle
st ListNumberDelim
de Int
n -> (ListNumberStyle -> Int -> String
forall p t. (IsString p, Integral t) => ListNumberStyle -> t -> p
styleFor ListNumberStyle
st Int
lvl
,ListNumberDelim -> ShowS
patternFor ListNumberDelim
de (String
"%" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
,Int -> String
forall a. Show a => a -> String
show Int
n)
step :: Int
step = Int
720
hang :: Int
hang = Int
480
bulletFor :: t -> p
bulletFor t
0 = p
"\x2022"
bulletFor t
1 = p
"\x2013"
bulletFor t
2 = p
"\x2022"
bulletFor t
3 = p
"\x2013"
bulletFor t
4 = p
"\x2022"
bulletFor t
5 = p
"\x2013"
bulletFor t
x = t -> p
bulletFor (t
x t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
6)
styleFor :: ListNumberStyle -> t -> p
styleFor ListNumberStyle
UpperAlpha t
_ = p
"upperLetter"
styleFor ListNumberStyle
LowerAlpha t
_ = p
"lowerLetter"
styleFor ListNumberStyle
UpperRoman t
_ = p
"upperRoman"
styleFor ListNumberStyle
LowerRoman t
_ = p
"lowerRoman"
styleFor ListNumberStyle
Decimal t
_ = p
"decimal"
styleFor ListNumberStyle
DefaultStyle t
0 = p
"decimal"
styleFor ListNumberStyle
DefaultStyle t
1 = p
"lowerLetter"
styleFor ListNumberStyle
DefaultStyle t
2 = p
"lowerRoman"
styleFor ListNumberStyle
DefaultStyle t
3 = p
"decimal"
styleFor ListNumberStyle
DefaultStyle t
4 = p
"lowerLetter"
styleFor ListNumberStyle
DefaultStyle t
5 = p
"lowerRoman"
styleFor ListNumberStyle
DefaultStyle t
x = ListNumberStyle -> t -> p
styleFor ListNumberStyle
DefaultStyle (t
x t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
6)
styleFor ListNumberStyle
_ t
_ = p
"decimal"
patternFor :: ListNumberDelim -> ShowS
patternFor ListNumberDelim
OneParen String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
patternFor ListNumberDelim
TwoParens String
s = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
patternFor ListNumberDelim
_ String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
getNumId :: (PandocMonad m) => WS m Int
getNumId :: WS m Int
getNumId = (((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) -> ([ListMarker] -> Int) -> [ListMarker] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListMarker] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([ListMarker] -> Int)
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
-> WS m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (WriterState -> [ListMarker])
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [ListMarker]
stLists
makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
makeTOC :: WriterOptions -> WS m [Element]
makeTOC WriterOptions
opts = do
let depth :: String
depth = String
"1-"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
let tocCmd :: String
tocCmd = String
"TOC \\o \""String -> ShowS
forall a. [a] -> [a] -> [a]
++String
depthString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\" \\h \\z \\u"
[Inline]
tocTitle <- (WriterState -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Inline]
stTocTitle
[Content]
title <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"TOC Heading") (WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [[Inline] -> Block
Para [Inline]
tocTitle])
[Element] -> WS m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return
[String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:sdt" [] [
String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:sdtPr" [] (
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:docPartObj" []
[String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:docPartGallery" [(String
"w:val",String
"Table of Contents")] (),
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:docPartUnique" [] ()]
),
String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:sdtContent" [] ([Content]
title [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] (
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] [
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:fldChar" [(String
"w:fldCharType",String
"begin"),(String
"w:dirty",String
"true")] (),
String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:instrText" [(String
"xml:space",String
"preserve")] String
tocCmd,
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:fldChar" [(String
"w:fldCharType",String
"separate")] (),
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:fldChar" [(String
"w:fldCharType",String
"end")] ()
]
)
])
]]
writeOpenXML :: (PandocMonad m)
=> WriterOptions -> Pandoc
-> WS m ([Content], [Element], [Element])
writeOpenXML :: WriterOptions -> Pandoc -> WS m ([Content], [Element], [Element])
writeOpenXML WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let tit :: [Inline]
tit = Meta -> [Inline]
docTitle Meta
meta
let auths :: [[Inline]]
auths = Meta -> [[Inline]]
docAuthors Meta
meta
let dat :: [Inline]
dat = Meta -> [Inline]
docDate Meta
meta
let abstract' :: [Block]
abstract' = Text -> Meta -> [Block]
lookupMetaBlocks Text
"abstract" Meta
meta
let subtitle' :: [Inline]
subtitle' = Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
let includeTOC :: Bool
includeTOC = WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
|| Text -> Meta -> Bool
lookupMetaBool Text
"toc" Meta
meta
[Content]
title <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Title") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [[Inline] -> Block
Para [Inline]
tit | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
tit)]
[Content]
subtitle <- 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
"Subtitle") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [[Inline] -> Block
Para [Inline]
subtitle' | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
subtitle')]
[Content]
authors <- 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
"Author") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts ([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
([Inline] -> Block) -> [[Inline]] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Block
Para [[Inline]]
auths
[Content]
date <- 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
"Date") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [[Inline] -> Block
Para [Inline]
dat | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
dat)]
[Content]
abstract <- if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
abstract'
then [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else 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
"Abstract") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
abstract'
let convertSpace :: [Inline] -> [Inline]
convertSpace (Str Text
x : Inline
Space : Str Text
y : [Inline]
xs) = 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) = 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]
xs = [Inline]
xs
let blocks' :: [Block]
blocks' = ([Inline] -> [Inline]) -> [Block] -> [Block]
forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Inline] -> [Inline]
convertSpace [Block]
blocks
[Content]
doc' <- WS m ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara WS m () -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
blocks'
[Element]
notes' <- [Element] -> [Element]
forall a. [a] -> [a]
reverse ([Element] -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Element]
stFootnotes
[([(Text, Text)], [Inline])]
comments <- [([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])]
forall a. [a] -> [a]
reverse ([([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])])
-> ReaderT
WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
-> ReaderT
WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [([(Text, Text)], [Inline])])
-> ReaderT
WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [([(Text, Text)], [Inline])]
stComments
let toComment :: ([(Text, Text)], [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Element
toComment ([(Text, Text)]
kvs, [Inline]
ils) = do
[Content]
annotation <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
-> Element -> ReaderT WriterEnv (StateT WriterState m) Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:comment" [(Char
'w'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:Text -> String
T.unpack Text
k,Text -> String
T.unpack Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs]
[ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$
(Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pStyle" [(String
"w:val", String
"CommentText")] () ]
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rStyle" [(String
"w:val", String
"CommentReference")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:annotationRef" [] ()
]
]
] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
annotation
]
[Element]
comments' <- (([(Text, Text)], [Inline]) -> WS m Element)
-> [([(Text, Text)], [Inline])]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(Text, Text)], [Inline]) -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
([(Text, Text)], [Inline])
-> ReaderT WriterEnv (StateT WriterState m) Element
toComment [([(Text, Text)], [Inline])]
comments
[Element]
toc <- if Bool
includeTOC
then WriterOptions -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> WS m [Element]
makeTOC WriterOptions
opts
else [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return []
let meta' :: [Content]
meta' = [Content]
title [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
subtitle [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
authors [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
date [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
abstract [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
toc
([Content], [Element], [Element])
-> WS m ([Content], [Element], [Element])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content]
meta' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
doc', [Element]
notes', [Element]
comments')
blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML :: WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts = ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
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]]
-> WS m [Content])
-> ([Block]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]])
-> [Block]
-> WS m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> WS m [Content])
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> WS 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
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
pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
pStyleM :: ParaStyleName -> WS m Element
pStyleM ParaStyleName
styleName = do
ParaStyleNameMap
pStyleMap <- (WriterState -> ParaStyleNameMap)
-> ReaderT WriterEnv (StateT WriterState m) ParaStyleNameMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StyleMaps -> ParaStyleNameMap
smParaStyle (StyleMaps -> ParaStyleNameMap)
-> (WriterState -> StyleMaps) -> WriterState -> ParaStyleNameMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> StyleMaps
stStyleMaps)
let sty' :: StyleId ParStyle
sty' = ParaStyleName -> ParaStyleNameMap -> StyleId ParStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName ParaStyleName
styleName ParaStyleNameMap
pStyleMap
Element -> WS m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pStyle" [(String
"w:val", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ParaStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId ParaStyleId
sty')] ()
rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
rStyleM :: CharStyleName -> WS m Element
rStyleM CharStyleName
styleName = do
CharStyleNameMap
cStyleMap <- (WriterState -> CharStyleNameMap)
-> ReaderT WriterEnv (StateT WriterState m) CharStyleNameMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StyleMaps -> CharStyleNameMap
smCharStyle (StyleMaps -> CharStyleNameMap)
-> (WriterState -> StyleMaps) -> WriterState -> CharStyleNameMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> StyleMaps
stStyleMaps)
let sty' :: StyleId CharStyle
sty' = CharStyleName -> CharStyleNameMap -> StyleId CharStyle
forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName CharStyleName
styleName CharStyleNameMap
cStyleMap
Element -> WS m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rStyle" [(String
"w:val", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ CharStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId CharStyleId
sty')] ()
getUniqueId :: (PandocMonad m) => WS m String
getUniqueId :: WS m String
getUniqueId = do
Int
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCurId
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stCurId :: Int
stCurId = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
String -> WS m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> WS m String) -> String -> WS m String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n
dynamicStyleKey :: T.Text
dynamicStyleKey :: Text
dynamicStyleKey = Text
"custom-style"
blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Content]
blockToOpenXML :: 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' :: WriterOptions -> Block -> WS m [Content]
blockToOpenXML' WriterOptions
_ Block
Null = [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToOpenXML' WriterOptions
opts (Div (Text
ident,[Text]
_classes,[(Text, Text)]
kvs) [Block]
bs) = do
WS m [Content] -> WS m [Content]
stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
Just (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 ParaStyleName
stDynamicParaProps = ParaStyleName -> Set ParaStyleName -> Set ParaStyleName
forall a. Ord a => a -> Set a -> Set a
Set.insert ParaStyleName
sty
(WriterState -> Set ParaStyleName
stDynamicParaProps WriterState
s)}
(WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
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 (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
WS m [Content] -> WS m [Content]
dirmod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
Just Text
"rtl" -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall (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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL :: Bool
envRTL = Bool
True })
Just Text
"ltr" -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL :: Bool
envRTL = Bool
False })
Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
let ([Block]
hs, [Block]
bs') = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs"
then (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isHeaderBlock [Block]
bs
else ([], [Block]
bs)
let bibmod :: WS m a -> WS m a
bibmod = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs"
then WS m Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Bibliography")
else WS m a -> WS m a
forall a. a -> a
id
[Content]
header <- WS m [Content] -> WS m [Content]
dirmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
stylemod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
hs
[Content]
contents <- WS m [Content] -> WS m [Content]
dirmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
forall a. WS m a -> WS m a
bibmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
stylemod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
bs'
Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
header [Content] -> [Content] -> [Content]
forall a. Semigroup a => a -> a -> a
<> [Content]
contents
blockToOpenXML' WriterOptions
opts (Header Int
lev (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
lst) = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Element]
paraProps <- WS m Element -> WS m [Element] -> WS m [Element]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (String -> ParaStyleName
forall a. IsString a => String -> a
fromString (String -> ParaStyleName) -> String -> ParaStyleName
forall a b. (a -> b) -> a -> b
$ String
"Heading "String -> ShowS
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
[Content]
number <-
if WriterOptions -> Bool
writerNumberSections WriterOptions
opts
then
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
Just Text
n -> do
[Content]
num <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"SectionNumber")
(WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
n))
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
num [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] [String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tab" [] ()]]
Maybe Text
Nothing -> [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Content]
contents <- ([Content]
number [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++) ([Content] -> [Content]) -> WS m [Content] -> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
if Text -> Bool
T.null Text
ident
then [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
contents)]
else do
let bookmarkName :: Text
bookmarkName = Text
ident
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stSectionIds :: Set Text
stSectionIds = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
bookmarkName
(Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
stSectionIds WriterState
s }
[Content]
bookmarkedContents <- Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
bookmarkName [Content]
contents
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
bookmarkedContents)]
blockToOpenXML' WriterOptions
opts (Plain [Inline]
lst) = do
Bool
isInTable <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
Bool
isInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
let block :: WS m [Content]
block = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
Element
prop <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Compact"
if Bool
isInTable Bool -> Bool -> Bool
|| Bool
isInList
then Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp Element
prop WS m [Content]
block
else WS m [Content]
block
blockToOpenXML' WriterOptions
opts (Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
tit)]) = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
Element
prop <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (ParaStyleName -> WS m Element) -> ParaStyleName -> WS m Element
forall a b. (a -> b) -> a -> b
$
if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt
then ParaStyleName
"Figure"
else ParaStyleName
"Captioned Figure"
[Element]
paraProps <- (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envParaProperties :: EnvProps
envParaProperties = Maybe Element -> [Element] -> EnvProps
EnvProps (Element -> Maybe Element
forall a. a -> Maybe a
Just Element
prop) [] EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> WriterEnv -> EnvProps
envParaProperties WriterEnv
env }) (Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
False)
[Content]
contents <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [(Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,Text
tit)]
[Content]
captionNode <- 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])
-> 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]
alt)
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
Element -> Content
Elem (String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
contents))
Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
captionNode
blockToOpenXML' WriterOptions
opts (Para [Inline]
lst)
| [Inline] -> 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 (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
Bool
isFirstPara <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
let displayMathPara :: Bool
displayMathPara = case [Inline]
lst of
[Inline
x] -> Inline -> Bool
isDisplayMath Inline
x
[Inline]
_ -> Bool
False
[Element]
paraProps <- Bool -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
getParaProps Bool
displayMathPara
Element
bodyTextStyle <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM (ParaStyleName -> WS m Element) -> ParaStyleName -> WS m Element
forall a b. (a -> b) -> a -> b
$ if Bool
isFirstPara
then ParaStyleName
"First Paragraph"
else ParaStyleName
"Body Text"
let paraProps' :: [Element]
paraProps' = case [Element]
paraProps of
[] -> [String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" [] [Element
bodyTextStyle]]
[Element]
ps -> [Element]
ps
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stFirstPara :: Bool
stFirstPara = Bool
False }
[Content]
contents <- WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem [Element]
paraProps' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
contents)]
blockToOpenXML' WriterOptions
opts (LineBlock [[Inline]]
lns) = WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToOpenXML' WriterOptions
_ b :: Block
b@(RawBlock Format
format Text
str)
| Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"openxml" = [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [
CData -> Content
Text (CDataKind -> String -> Maybe Integer -> CData
CData CDataKind
CDataRaw (Text -> String
T.unpack 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 (m :: * -> *) a. Monad m => a -> m a
return []
blockToOpenXML' WriterOptions
opts (BlockQuote [Block]
blocks) = do
[Content]
p <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Block Text")
(WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
blocks
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
p
blockToOpenXML' WriterOptions
opts (CodeBlock attrs :: (Text, [Text], [(Text, Text)])
attrs@(Text
ident, [Text]
_, [(Text, Text)]
_) Text
str) = do
[Content]
p <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Source Code") (WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts (Block -> WS m [Content]) -> Block -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [(Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attrs Text
str])
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident [Content]
p
blockToOpenXML' WriterOptions
_ Block
HorizontalRule = do
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pict" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"v:rect" [(String
"style",String
"width:0;height:1.5pt"),
(String
"o:hralign",String
"center"),
(String
"o:hrstd",String
"t"),(String
"o:hr",String
"t")] () ]
blockToOpenXML' WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
(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 :: Bool
stInTable = Bool
True }
let captionStr :: Text
captionStr = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
caption
[Content]
caption' <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else 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
"Table Caption")
(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]
caption)
let alignmentFor :: Alignment -> Element
alignmentFor Alignment
al = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:jc" [(String
"w:val",Alignment -> String
alignmentToString Alignment
al)] ()
let cellToOpenXML :: (Alignment, [Block])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
cellToOpenXML (Alignment
al, [Block]
cell) = do
[Content]
es <- 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
withParaProp (Alignment -> Element
alignmentFor Alignment
al) (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
cell
[Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ if (Element -> Bool) -> [Element] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Element
e -> QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"p") ([Content] -> [Element]
onlyElems [Content]
es)
then [Content]
es
else [Content]
es [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] ()]
[[Content]]
headers' <- ((Alignment, [Block]) -> WS m [Content])
-> [(Alignment, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment, [Block]) -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
(Alignment, [Block])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
cellToOpenXML ([(Alignment, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]])
-> [(Alignment, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall a b. (a -> b) -> a -> b
$ [Alignment] -> [[Block]] -> [(Alignment, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [[Block]]
headers
[[[Content]]]
rows' <- ([[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)
mapM (((Alignment, [Block]) -> WS m [Content])
-> [(Alignment, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment, [Block]) -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
(Alignment, [Block])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
cellToOpenXML ([(Alignment, [Block])]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]])
-> ([[Block]] -> [(Alignment, [Block])])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Alignment] -> [[Block]] -> [(Alignment, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns) [[[Block]]]
rows
let borderProps :: Content
borderProps = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tcPr" []
[ String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tcBorders" []
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:bottom" [(String
"w:val",String
"single")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:vAlign" [(String
"w:val",String
"bottom")] () ]
Element
compactStyle <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Compact"
let emptyCell' :: [Content]
emptyCell' = [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" [] [String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" [] [Element
compactStyle]]]
let mkcell :: Bool -> [Content] -> Element
mkcell Bool
border [Content]
contents = String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tc" []
([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [ Content
borderProps | Bool
border ] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++
if [Content] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
contents
then [Content]
emptyCell'
else [Content]
contents
let mkrow :: Bool -> [[Content]] -> Element
mkrow Bool
border [[Content]]
cells =
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tr" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:trPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:cnfStyle" [(String
"w:firstRow",String
"1")] ()]
| Bool
border]
[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ ([Content] -> Element) -> [[Content]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Content] -> Element
mkcell Bool
border) [[Content]]
cells
let textwidth :: Double
textwidth = Double
7920
let fullrow :: Double
fullrow = Double
5000
let rowwidth :: Double
rowwidth = Double
fullrow Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
let mkgridcol :: Double -> Element
mkgridcol Double
w = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:gridCol"
[(String
"w:w", Integer -> String
forall a. Show a => a -> String
show (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
textwidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w) :: Integer))] ()
let hasHeader :: Bool
hasHeader = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
(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 :: Bool
stInTable = Bool
False }
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
[Content]
caption' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++
[Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tbl" []
( String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblPr" []
( String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblStyle" [(String
"w:val",String
"Table")] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblW" [(String
"w:type", String
"pct"), (String
"w:w", Double -> String
forall a. Show a => a -> String
show Double
rowwidth)] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblLook" [(String
"w:firstRow",if Bool
hasHeader then String
"1" else String
"0")
,(String
"w:lastRow",String
"0")
,(String
"w:firstColumn",String
"0")
,(String
"w:lastColumn",String
"0")
,(String
"w:noHBand",String
"0")
,(String
"w:noVBand",String
"0")] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblCaption" [(String
"w:val", Text -> String
T.unpack Text
captionStr)] ()
| Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption) ] )
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:tblGrid" []
(if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) [Double]
widths
then []
else (Double -> Element) -> [Double] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Element
mkgridcol [Double]
widths)
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [ Bool -> [[Content]] -> Element
mkrow Bool
True [[Content]]
headers' | Bool
hasHeader ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
([[Content]] -> Element) -> [[[Content]]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [[Content]] -> Element
mkrow Bool
False) [[[Content]]]
rows'
)]
blockToOpenXML' WriterOptions
opts Block
el
| BulletList [[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 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]
lst = do
ListMarker -> WS m ()
forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
addList ListMarker
marker
Int
numid <- WS m Int
forall (m :: * -> *). PandocMonad m => WS m Int
getNumId
[Content]
l <- ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
asList (ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall a b. (a -> b) -> a -> b
$ t [Content] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (t [Content] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) (t [Content])
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([Block] -> ReaderT WriterEnv (StateT WriterState m) [Content])
-> t [Block]
-> ReaderT WriterEnv (StateT WriterState m) (t [Content])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions
-> Int
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> WS m [Content]
listItemToOpenXML WriterOptions
opts Int
numid) t [Block]
lst
WS m ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
l
blockToOpenXML' WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
[Content]
l <- [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall (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)
mapM (WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts) [([Inline], [[Block]])]
items
ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
l
definitionListItemToOpenXML :: (PandocMonad m)
=> WriterOptions -> ([Inline],[[Block]])
-> WS m [Content]
definitionListItemToOpenXML :: WriterOptions -> ([Inline], [[Block]]) -> WS m [Content]
definitionListItemToOpenXML WriterOptions
opts ([Inline]
term,[[Block]]
defs) = do
[Content]
term' <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Definition Term")
(WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts ([Inline] -> Block
Para [Inline]
term)
[Content]
defs' <- WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Definition")
(WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
-> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([Block] -> WS m [Content])
-> [[Block]]
-> ReaderT WriterEnv (StateT WriterState m) [[Content]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts) [[Block]]
defs
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
term' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
defs'
addList :: (PandocMonad m) => ListMarker -> WS m ()
addList :: ListMarker -> WS m ()
addList ListMarker
marker = do
[ListMarker]
lists <- (WriterState -> [ListMarker])
-> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [ListMarker]
stLists
(WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stLists :: [ListMarker]
stLists = [ListMarker]
lists [ListMarker] -> [ListMarker] -> [ListMarker]
forall a. [a] -> [a] -> [a]
++ [ListMarker
marker] }
listItemToOpenXML :: (PandocMonad m)
=> WriterOptions
-> Int -> [Block]
-> WS m [Content]
listItemToOpenXML :: WriterOptions -> Int -> [Block] -> WS m [Content]
listItemToOpenXML WriterOptions
_ Int
_ [] = [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
listItemToOpenXML WriterOptions
opts Int
numid (Block
first:[Block]
rest) = do
Bool
oldInList <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInList
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInList :: Bool
stInList = Bool
True }
let isListBlock :: Block -> Bool
isListBlock = \case
BulletList{} -> Bool
True
OrderedList{} -> Bool
True
Block
_ -> Bool
False
let (Block
first', [Block]
rest') = if Block -> Bool
isListBlock Block
first
then ([Inline] -> Block
Plain [Text -> Inline
Str Text
""] , Block
firstBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
else (Block
first, [Block]
rest)
[Content]
first'' <- Int -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
withNumId Int
numid (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Block -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> WS m [Content]
blockToOpenXML WriterOptions
opts Block
first'
[Content]
rest'' <- Int -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
withNumId Int
baseListId (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts [Block]
rest'
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInList :: Bool
stInList = Bool
oldInList }
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
first'' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
rest''
alignmentToString :: Alignment -> [Char]
alignmentToString :: Alignment -> String
alignmentToString Alignment
alignment = case Alignment
alignment of
Alignment
AlignLeft -> String
"left"
Alignment
AlignRight -> String
"right"
Alignment
AlignCenter -> String
"center"
Alignment
AlignDefault -> String
"left"
inlinesToOpenXML :: PandocMonad m => WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML :: 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]]
-> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Inline -> WS 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)
mapM (WriterOptions -> Inline -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts) [Inline]
lst
withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
withNumId :: Int -> WS m a -> WS m a
withNumId Int
numid = (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListNumId :: Int
envListNumId = Int
numid }
asList :: (PandocMonad m) => WS m a -> WS m a
asList :: WS m a -> WS m a
asList = (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env{ envListLevel :: Int
envListLevel = WriterEnv -> Int
envListLevel WriterEnv
env Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
isStyle :: Element -> Bool
isStyle :: Element -> Bool
isStyle Element
e = [(String, String)] -> String -> String -> Element -> Bool
isElem [] String
"w" String
"rStyle" Element
e Bool -> Bool -> Bool
||
[(String, String)] -> String -> String -> Element -> Bool
isElem [] String
"w" String
"pStyle" Element
e
getTextProps :: (PandocMonad m) => WS m [Element]
getTextProps :: WS m [Element]
getTextProps = do
EnvProps
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envTextProperties
let squashed :: [Element]
squashed = EnvProps -> [Element]
squashProps EnvProps
props
[Element] -> WS m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" [] [Element]
squashed | (Bool -> Bool
not (Bool -> Bool) -> ([Element] -> Bool) -> [Element] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Element]
squashed]
withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
withTextProp :: Element -> WS m a -> WS m a
withTextProp Element
d WS m a
p =
(WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envTextProperties :: EnvProps
envTextProperties = EnvProps
ep EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> WriterEnv -> EnvProps
envTextProperties WriterEnv
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 :: WS m Element -> WS m a -> WS m a
withTextPropM WS m Element
md WS m a
p = do
Element
d <- WS m Element
md
Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp Element
d WS m a
p
getParaProps :: PandocMonad m => Bool -> WS m [Element]
getParaProps :: Bool -> WS m [Element]
getParaProps Bool
displayMathPara = do
EnvProps
props <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
Int
listLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListLevel
Int
numid <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListNumId
let listPr :: [Element]
listPr = [String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:numPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:ilvl" [(String
"w:val",Int -> String
forall a. Show a => a -> String
show Int
listLevel)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:numId" [(String
"w:val",Int -> String
forall a. Show a => a -> String
show Int
numid)] () ] | Int
listLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
displayMathPara]
[Element] -> WS m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
forall a b. (a -> b) -> a -> b
$ case [Element]
listPr [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ EnvProps -> [Element]
squashProps EnvProps
props of
[] -> []
[Element]
ps -> [String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:pPr" [] [Element]
ps]
withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
withParaProp :: Element -> WS m a -> WS m a
withParaProp Element
d WS m a
p =
(WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envParaProperties :: EnvProps
envParaProperties = EnvProps
ep EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> WriterEnv -> EnvProps
envParaProperties WriterEnv
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]
withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
withParaPropM :: WS m Element -> WS m a -> WS m a
withParaPropM WS m Element
md WS m a
p = do
Element
d <- WS m Element
md
Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp Element
d WS m a
p
formattedString :: PandocMonad m => T.Text -> WS m [Element]
formattedString :: 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
[Element]
sh <- [Element] -> WS m [Element]
forall (m :: * -> *). PandocMonad m => [Element] -> WS m [Element]
formattedRun [String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:softHyphen" [] ()]
[Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element]
sh ([[Element]] -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
-> WS m [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> WS m [Element])
-> [Text] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> WS m [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString' [Text]
ws
formattedString' :: PandocMonad m => T.Text -> WS m [Element]
formattedString' :: Text -> WS m [Element]
formattedString' Text
str = do
Bool
inDel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInDel
[Element] -> WS m [Element]
forall (m :: * -> *). PandocMonad m => [Element] -> WS m [Element]
formattedRun [ String -> [(String, String)] -> Text -> Element
mktnode (if Bool
inDel then String
"w:delText" else String
"w:t")
[(String
"xml:space",String
"preserve")] (Text -> Text
stripInvalidChars Text
str) ]
formattedRun :: PandocMonad m => [Element] -> WS m [Element]
formattedRun :: [Element] -> WS m [Element]
formattedRun [Element]
els = do
[Element]
props <- WS m [Element]
forall (m :: * -> *). PandocMonad m => WS m [Element]
getTextProps
[Element] -> WS m [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
props [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
els ]
setFirstPara :: PandocMonad m => WS m ()
setFirstPara :: WS m ()
setFirstPara = (WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stFirstPara :: Bool
stFirstPara = Bool
True }
inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML :: 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' :: 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]
-> WS 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 -> WS 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 -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> WS m [Content]
inlineToOpenXML WriterOptions
opts (Text -> Inline
Str Text
" ")
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-block"],[]) [Inline]
ils) =
WriterOptions -> [Inline] -> WS 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] -> WS 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
$
String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
(String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:t"
[(String
"xml:space",String
"preserve")]
(String
"\t" :: String))] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++)
([Content] -> [Content]) -> WS m [Content] -> WS m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
inlineToOpenXML' WriterOptions
opts (Span (Text
"",[Text
"csl-indent"],[]) [Inline]
ils) =
WriterOptions -> [Inline] -> WS 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 :: [([(Text, Text)], [Inline])]
stComments = ((Text
"id",Text
ident')(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs', [Inline]
ils) ([(Text, Text)], [Inline])
-> [([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])]
forall a. a -> [a] -> [a]
: WriterState -> [([(Text, Text)], [Inline])]
stComments WriterState
st }
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:commentRangeStart" [(String
"w:id", Text -> String
T.unpack 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] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content])
-> ([Element] -> [Content]) -> [Element] -> WS 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] -> WS m [Content]) -> [Element] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:commentRangeEnd" [(String
"w:id", Text -> String
T.unpack Text
ident')] ()
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rStyle" [(String
"w:val", String
"CommentReference")] () ]
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:commentReference" [(String
"w:id", Text -> String
T.unpack Text
ident')] () ]
]
inlineToOpenXML' WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
WS m [Content] -> WS m [Content]
stylemod <- case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs of
Just (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 CharStyleName
stDynamicTextProps = CharStyleName -> Set CharStyleName -> Set CharStyleName
forall a. Ord a => a -> Set a -> Set a
Set.insert CharStyleName
sty
(WriterState -> Set CharStyleName
stDynamicTextProps WriterState
s)}
(WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
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
withTextPropM (CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
sty)
Maybe Text
_ -> (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
let dirmod :: ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
dirmod = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
Just Text
"rtl" -> (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envRTL :: Bool
envRTL = Bool
True })
Just Text
"ltr" -> (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 :: Bool
envRTL = Bool
False })
Maybe Text
_ -> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall a. a -> a
id
off :: String -> WS m a -> WS m a
off String
x = Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
x [(String
"w:val",String
"0")] ())
pmod :: WS m a -> WS m a
pmod = (if Text
"csl-no-emph" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then String -> WS m a -> WS m a
forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
off String
"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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes then String -> WS m a -> WS m a
forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
off String
"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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then String -> WS m a -> WS m a
forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
off String
"w:smallCaps"
else WS m a -> WS m a
forall a. a -> a
id)
getChangeAuthorDate :: ReaderT WriterEnv (StateT WriterState m) [(String, String)]
getChangeAuthorDate = do
Text
defaultAuthor <- (WriterEnv -> Text)
-> ReaderT WriterEnv (StateT WriterState m) Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Text
envChangesAuthor
let author :: Text
author = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultAuthor (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"author" [(Text, Text)]
kvs)
let mdate :: Maybe Text
mdate = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"date" [(Text, Text)]
kvs
[(String, String)]
-> ReaderT WriterEnv (StateT WriterState m) [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)]
-> ReaderT WriterEnv (StateT WriterState m) [(String, String)])
-> [(String, String)]
-> ReaderT WriterEnv (StateT WriterState m) [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String
"w:author", Text -> String
T.unpack Text
author) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:
[(String, String)]
-> (Text -> [(String, String)]) -> Maybe Text -> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
date -> [(String
"w:date", Text -> String
T.unpack Text
date)]) Maybe Text
mdate
WS m [Content] -> WS m [Content]
insmod <- if Text
"insertion" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then do
[(String, String)]
changeAuthorDate <- ReaderT WriterEnv (StateT WriterState m) [(String, String)]
getChangeAuthorDate
Int
insId <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stInsId
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInsId :: Int
stInsId = Int
insId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
(WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
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 [Content]
f -> do
[Content]
x <- WS m [Content]
f
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:ins"
((String
"w:id", Int -> String
forall a. Show a => a -> String
show Int
insId) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
changeAuthorDate) [Content]
x]
else (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
WS m [Content] -> WS m [Content]
delmod <- if Text
"deletion" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then do
[(String, String)]
changeAuthorDate <- ReaderT WriterEnv (StateT WriterState m) [(String, String)]
getChangeAuthorDate
Int
delId <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stDelId
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stDelId :: Int
stDelId = Int
delId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
(WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
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 [Content]
f -> (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env->WriterEnv
env{envInDel :: Bool
envInDel=Bool
True}) (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ do
[Content]
x <- WS m [Content]
f
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:del"
((String
"w:id", Int -> String
forall a. Show a => a -> String
show Int
delId) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
changeAuthorDate) [Content]
x]
else (WS m [Content] -> WS m [Content])
-> ReaderT
WriterEnv (StateT WriterState m) (WS m [Content] -> WS m [Content])
forall (m :: * -> *) a. Monad m => a -> m a
return WS m [Content] -> WS m [Content]
forall a. a -> a
id
[Content]
contents <- WS m [Content] -> WS m [Content]
insmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
delmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
forall a.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
dirmod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
stylemod (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WS m [Content] -> WS m [Content]
forall a.
ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
pmod
(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]
inlinesToOpenXML WriterOptions
opts [Inline]
ils
Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
ident [Content]
contents
inlineToOpenXML' WriterOptions
opts (Strong [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:b" [] ()) (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:bCs" [] ()) (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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Emph [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:i" [] ()) (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:iCs" [] ()) (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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Underline [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:u" [(String
"w:val",String
"single")] ()) (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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Subscript [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:vertAlign" [(String
"w:val",String
"subscript")] ())
(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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Superscript [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:vertAlign" [(String
"w:val",String
"superscript")] ())
(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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (SmallCaps [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:smallCaps" [] ())
(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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Strikeout [Inline]
lst) =
Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withTextProp (String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:strike" [] ())
(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]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
_ Inline
LineBreak = [Content] -> WS m [Content]
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] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return
[CData -> Content
Text (CDataKind -> String -> Maybe Integer -> CData
CData CDataKind
CDataRaw (Text -> String
T.unpack 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] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
inlineToOpenXML' WriterOptions
opts (Quoted QuoteType
quoteType [Inline]
lst) =
WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts ([Inline] -> WS m [Content]) -> [Inline] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
close]
where (Text
open, Text
close) = case QuoteType
quoteType of
QuoteType
SingleQuote -> (Text
"\x2018", Text
"\x2019")
QuoteType
DoubleQuote -> (Text
"\x201C", Text
"\x201D")
inlineToOpenXML' WriterOptions
opts (Math MathType
mathType Text
str) = do
Bool
-> ReaderT WriterEnv (StateT WriterState m) ()
-> ReaderT WriterEnv (StateT WriterState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MathType
mathType MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath) ReaderT WriterEnv (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
Either Inline Element
res <- (StateT WriterState m (Either Inline Element)
-> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
forall (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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ((DisplayType -> [Exp] -> Element)
-> MathType -> Text -> m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeOMML MathType
mathType Text
str)
case Either Inline Element
res of
Right Element
r -> [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem Element
r]
Left Inline
il -> WriterOptions -> Inline -> WS 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] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
lst
inlineToOpenXML' WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
attrs Text
str) = do
let alltoktypes :: [TokenType]
alltoktypes = [TokenType
KeywordTok ..]
[(TokenType, Element)]
tokTypesMap <- (TokenType
-> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element))
-> [TokenType]
-> ReaderT WriterEnv (StateT WriterState m) [(TokenType, Element)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
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 :: WS m [Content]
unhighlighted = ((Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> [Content])
-> ([[Element]] -> [Element]) -> [[Element]] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br]) ([[Element]] -> [Content])
-> ReaderT WriterEnv (StateT WriterState m) [[Element]]
-> WS m [Content]
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)
mapM Text -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
formattedString (Text -> [Text]
T.lines Text
str)
formatOpenXML :: p -> [[(TokenType, Text)]] -> [Element]
formatOpenXML p
_fmtOpts = [Element] -> [[Element]] -> [Element]
forall a. [a] -> [[a]] -> [a]
intercalate [Element
br] ([[Element]] -> [Element])
-> ([[(TokenType, Text)]] -> [[Element]])
-> [[(TokenType, Text)]]
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TokenType, Text)] -> [Element])
-> [[(TokenType, Text)]] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map (((TokenType, Text) -> Element) -> [(TokenType, Text)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, Text) -> Element
toHlTok)
toHlTok :: (TokenType, Text) -> Element
toHlTok (TokenType
toktype,Text
tok) =
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"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)
, String -> [(String, String)] -> String -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:t" [(String
"xml:space",String
"preserve")] (Text -> String
T.unpack Text
tok) ]
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
"Verbatim Char")
(WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ if Maybe Style -> Bool
forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
then WS m [Content]
unhighlighted
else case SyntaxMap
-> (FormatOptions -> [[(TokenType, Text)]] -> [Element])
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text [Element]
forall a.
SyntaxMap
-> (FormatOptions -> [[(TokenType, Text)]] -> a)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
FormatOptions -> [[(TokenType, Text)]] -> [Element]
forall p. p -> [[(TokenType, Text)]] -> [Element]
formatOpenXML (Text, [Text], [(Text, Text)])
attrs Text
str of
Right [Element]
h -> [Content] -> WS m [Content]
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
WS m [Content]
unhighlighted
inlineToOpenXML' WriterOptions
opts (Note [Block]
bs) = do
[Element]
notes <- (WriterState -> [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Element]
stFootnotes
String
notenum <- WS m String
forall (m :: * -> *). PandocMonad m => WS m String
getUniqueId
Element
footnoteStyle <- CharStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
CharStyleName -> WS m Element
rStyleM CharStyleName
"Footnote Reference"
let notemarker :: Element
notemarker = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" [] Element
footnoteStyle
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnoteRef" [] () ]
let notemarkerXml :: Inline
notemarkerXml = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
ppElement Element
notemarker
let insertNoteRef :: [Block] -> [Block]
insertNoteRef (Plain [Inline]
ils : [Block]
xs) = [Inline] -> Block
Plain (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
insertNoteRef (Para [Inline]
ils : [Block]
xs) = [Inline] -> Block
Para (Inline
notemarkerXml Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
insertNoteRef [Block]
xs = [Inline] -> Block
Para [Inline
notemarkerXml] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
[Content]
contents <- (WriterEnv -> WriterEnv) -> WS m [Content] -> WS m [Content]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envListLevel :: Int
envListLevel = -Int
1
, envParaProperties :: EnvProps
envParaProperties = EnvProps
forall a. Monoid a => a
mempty
, envTextProperties :: EnvProps
envTextProperties = EnvProps
forall a. Monoid a => a
mempty })
(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
"Footnote Text") (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Block] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> WS m [Content]
blocksToOpenXML WriterOptions
opts
([Block] -> WS m [Content]) -> [Block] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
insertNoteRef [Block]
bs)
let newnote :: Element
newnote = String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnote" [(String
"w:id", String
notenum)] [Content]
contents
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stFootnotes :: [Element]
stFootnotes = Element
newnote Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
notes }
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rPr" [] Element
footnoteStyle
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnoteReference" [(String
"w:id", String
notenum)] () ] ]
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
xs),Text
_)) = do
[Content]
contents <- WS m Element -> 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
"Hyperlink") (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]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:hyperlink" [(String
"w:anchor", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
toBookmarkName Text
xs)] [Content]
contents ]
inlineToOpenXML' WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src,Text
_)) = do
[Content]
contents <- 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
"Hyperlink") (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]
inlinesToOpenXML WriterOptions
opts [Inline]
txt
Map String String
extlinks <- (WriterState -> Map String String)
-> ReaderT WriterEnv (StateT WriterState m) (Map String String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map String String
stExternalLinks
String
id' <- case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> String
T.unpack Text
src) Map String String
extlinks of
Just String
i -> String -> WS m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
i
Maybe String
Nothing -> do
String
i <- (String
"rId"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> WS m String -> WS m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WS m String
forall (m :: * -> *). PandocMonad m => WS m String
getUniqueId
(WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stExternalLinks :: Map String String
stExternalLinks =
String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> String
T.unpack Text
src) String
i Map String String
extlinks }
String -> WS m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
i
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Content] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:hyperlink" [(String
"r:id",String
id')] [Content]
contents ]
inlineToOpenXML' WriterOptions
opts (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
imgident, [Text]
_, [(Text, Text)]
_) [Inline]
alt (Text
src, Text
title)) = do
Integer
pageWidth <- (WriterEnv -> Integer)
-> ReaderT WriterEnv (StateT WriterState m) Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Integer
envPrintWidth
Map String (String, String, Maybe Text, ByteString)
imgs <- (WriterState
-> Map String (String, String, Maybe Text, ByteString))
-> ReaderT
WriterEnv
(StateT WriterState m)
(Map String (String, String, Maybe Text, ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map String (String, String, Maybe Text, ByteString)
stImages
let
stImage :: Maybe (String, String, Maybe Text, ByteString)
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, b, c, ByteString) -> Element
generateImgElt (String
ident, b
_, c
_, ByteString
img) =
let
(Double
xpt,Double
ypt) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts (Text, [Text], [(Text, Text)])
attr
((Text -> ImageSize)
-> (ImageSize -> ImageSize) -> Either Text ImageSize -> ImageSize
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ImageSize -> Text -> ImageSize
forall a b. a -> b -> a
const ImageSize
forall a. Default a => a
def) ImageSize -> ImageSize
forall a. a -> a
id (WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
img))
(Integer
xemu,Integer
yemu) = (Double, Double) -> Integer -> (Integer, Integer)
fitToPage (Double
xpt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
12700, Double
ypt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
12700)
(Integer
pageWidth Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12700)
cNvPicPr :: Element
cNvPicPr = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:cNvPicPr" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:picLocks" [(String
"noChangeArrowheads",String
"1")
,(String
"noChangeAspect",String
"1")] ()
nvPicPr :: Element
nvPicPr = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:nvPicPr" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:cNvPr"
[(String
"descr",Text -> String
T.unpack Text
src),(String
"id",String
"0"),(String
"name",String
"Picture")] ()
, Element
cNvPicPr ]
blipFill :: Element
blipFill = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:blipFill" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:blip" [(String
"r:embed",String
ident)] ()
, String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:stretch" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:fillRect" [] ()
]
xfrm :: Element
xfrm = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:xfrm" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:off" [(String
"x",String
"0"),(String
"y",String
"0")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:ext" [(String
"cx",Integer -> String
forall a. Show a => a -> String
show Integer
xemu)
,(String
"cy",Integer -> String
forall a. Show a => a -> String
show Integer
yemu)] () ]
prstGeom :: Element
prstGeom = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:prstGeom" [(String
"prst",String
"rect")] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:avLst" [] ()
ln :: Element
ln = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:ln" [(String
"w",String
"9525")]
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:noFill" [] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:headEnd" [] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:tailEnd" [] () ]
spPr :: Element
spPr = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:spPr" [(String
"bwMode",String
"auto")]
[Element
xfrm, Element
prstGeom, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:noFill" [] (), Element
ln]
graphic :: Element
graphic = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:graphic" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"a:graphicData"
[(String
"uri",String
"http://schemas.openxmlformats.org/drawingml/2006/picture")]
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"pic:pic" []
[ Element
nvPicPr
, Element
blipFill
, Element
spPr
]
]
imgElt :: Element
imgElt = String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> Element -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:drawing" [] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"wp:inline" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"wp:extent" [(String
"cx",Integer -> String
forall a. Show a => a -> String
show Integer
xemu),(String
"cy",Integer -> String
forall a. Show a => a -> String
show Integer
yemu)] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"wp:effectExtent"
[(String
"b",String
"0"),(String
"l",String
"0"),(String
"r",String
"0"),(String
"t",String
"0")] ()
, String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"wp:docPr"
[ (String
"descr", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt)
, (String
"title", Text -> String
T.unpack Text
title)
, (String
"id",String
"1")
, (String
"name",String
"Picture")
] ()
, Element
graphic
]
in
Element
imgElt
Text -> [Content] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Content] -> WS m [Content]
wrapBookmark Text
imgident ([Content] -> WS m [Content]) -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Maybe (String, String, Maybe Text, ByteString)
stImage of
Just (String, String, Maybe Text, ByteString)
imgData -> [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ (String, String, Maybe Text, ByteString) -> Element
forall b c. (String, b, c, ByteString) -> Element
generateImgElt (String, String, Maybe Text, ByteString)
imgData]
Maybe (String, String, Maybe Text, ByteString)
Nothing -> ( do
(ByteString
img, Maybe Text
mt) <- Text
-> ReaderT
WriterEnv (StateT WriterState m) (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
src
String
ident <- (String
"rId"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> WS m String -> WS m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WS m String
forall (m :: * -> *). PandocMonad m => WS m String
getUniqueId
let
imgext :: Text
imgext = case Maybe Text
mt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
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"
Maybe ImageType
Nothing -> Text
""
imgpath :: String
imgpath = String
"media/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ident String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
imgext
mbMimeType :: Maybe Text
mbMimeType = Maybe Text
mt Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe Text
getMimeType String
imgpath
imgData :: (String, String, Maybe Text, ByteString)
imgData = (String
ident, String
imgpath, Maybe Text
mbMimeType, ByteString
img)
if Text -> Bool
T.null Text
imgext
then
WriterOptions -> [Inline] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
alt
else 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
st -> WriterState
st { stImages :: Map String (String, String, Maybe Text, ByteString)
stImages = String
-> (String, String, Maybe Text, ByteString)
-> Map String (String, String, Maybe Text, ByteString)
-> Map String (String, String, Maybe Text, ByteString)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text -> String
T.unpack Text
src) (String, String, Maybe Text, ByteString)
imgData (Map String (String, String, Maybe Text, ByteString)
-> Map String (String, String, Maybe Text, ByteString))
-> Map String (String, String, Maybe Text, ByteString)
-> Map String (String, String, Maybe Text, ByteString)
forall a b. (a -> b) -> a -> b
$ WriterState -> Map String (String, String, Maybe Text, ByteString)
stImages WriterState
st }
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ (String, String, Maybe Text, ByteString) -> Element
forall b c. (String, b, c, ByteString) -> Element
generateImgElt (String, String, Maybe Text, ByteString)
imgData]
)
WS m [Content] -> (PandocError -> WS m [Content]) -> WS m [Content]
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] -> WS m [Content]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> WS m [Content]
inlinesToOpenXML WriterOptions
opts [Inline]
alt
)
br :: Element
br :: Element
br = String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" [] [String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:br" [] ()]
defaultFootnotes :: [Element]
= [ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnote"
[(String
"w:type", String
"separator"), (String
"w:id", String
"-1")]
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" []
[String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:separator" [] ()]]]
, String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:footnote"
[(String
"w:type", String
"continuationSeparator"), (String
"w:id", String
"0")]
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:p" []
[ String -> [(String, String)] -> [Element] -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:r" []
[ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:continuationSeparator" [] ()]]]]
withDirection :: PandocMonad m => WS m a -> WS m a
withDirection :: WS m a -> WS m a
withDirection WS m a
x = do
Bool
isRTL <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envRTL
EnvProps
paraProps <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envParaProperties
EnvProps
textProps <- (WriterEnv -> EnvProps)
-> ReaderT WriterEnv (StateT WriterState m) EnvProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> EnvProps
envTextProperties
let paraProps' :: [Element]
paraProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> String
qName (QName -> String) -> (Element -> QName) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"bidi") (EnvProps -> [Element]
otherElements EnvProps
paraProps)
textProps' :: [Element]
textProps' = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e -> (QName -> String
qName (QName -> String) -> (Element -> QName) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) Element
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"rtl") (EnvProps -> [Element]
otherElements EnvProps
textProps)
paraStyle :: Maybe Element
paraStyle = EnvProps -> Maybe Element
styleElement EnvProps
paraProps
textStyle :: Maybe Element
textStyle = EnvProps -> Maybe Element
styleElement EnvProps
textProps
if Bool
isRTL
then ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WS m a
x ((WriterEnv -> WriterEnv) -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a
forall a b. (a -> b) -> a -> b
$
\WriterEnv
env -> WriterEnv
env { envParaProperties :: EnvProps
envParaProperties = Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
paraStyle ([Element] -> EnvProps) -> [Element] -> EnvProps
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:bidi" [] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
paraProps'
, envTextProperties :: EnvProps
envTextProperties = Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
textStyle ([Element] -> EnvProps) -> [Element] -> EnvProps
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:rtl" [] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
textProps'
}
else ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
-> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WS m a
x ((WriterEnv -> WriterEnv) -> WS m a)
-> (WriterEnv -> WriterEnv) -> WS m a
forall a b. (a -> b) -> a -> b
$ \WriterEnv
env -> WriterEnv
env { envParaProperties :: EnvProps
envParaProperties = Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
paraStyle [Element]
paraProps'
, envTextProperties :: EnvProps
envTextProperties = Maybe Element -> [Element] -> EnvProps
EnvProps Maybe Element
textStyle [Element]
textProps'
}
wrapBookmark :: (PandocMonad m) => T.Text -> [Content] -> WS m [Content]
wrapBookmark :: Text -> [Content] -> WS m [Content]
wrapBookmark Text
"" [Content]
contents = [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
contents
wrapBookmark Text
ident [Content]
contents = do
String
id' <- WS m String
forall (m :: * -> *). PandocMonad m => WS m String
getUniqueId
let bookmarkStart :: Element
bookmarkStart = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:bookmarkStart"
[(String
"w:id", String
id')
,(String
"w:name", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
toBookmarkName Text
ident)] ()
bookmarkEnd :: Element
bookmarkEnd = String -> [(String, String)] -> () -> Element
forall t. Node t => String -> [(String, String)] -> t -> Element
mknode String
"w:bookmarkEnd" [(String
"w:id", String
id')] ()
[Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Content
Elem Element
bookmarkStart Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
contents [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
bookmarkEnd]
toBookmarkName :: T.Text -> T.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 -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (Digest SHA1State -> String
forall t. Digest t -> String
showDigest (ByteString -> Digest SHA1State
sha1 (Text -> ByteString
fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
s)))