{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Readers.Docx
( readDocx
) where
import Codec.Archive.Zip
import Control.Monad ( liftM, unless )
import Control.Monad.Reader
( asks,
MonadReader(local),
MonadTrans(lift),
ReaderT(runReaderT) )
import Control.Monad.State.Strict
( StateT,
gets,
modify,
evalStateT )
import Data.Bifunctor (bimap, first)
import qualified Data.ByteString.Lazy as B
import Data.Default (Default)
import Data.List (delete, intersect, foldl')
import Data.Char (isSpace)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Maybe (isJust, fromMaybe, mapMaybe)
import Data.Sequence (ViewL (..), viewl)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Citeproc (ItemId(..), Reference(..), CitationItem(..))
import qualified Citeproc
import Text.Pandoc.Builder as Pandoc
import Text.Pandoc.MediaBag (MediaBag)
import Text.Pandoc.Options
import Text.Pandoc.Readers.Docx.Combine
import Text.Pandoc.Readers.Docx.Lists
import Text.Pandoc.Readers.Docx.Parse as Docx
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import Text.TeXMath (writeTeX)
import Control.Monad.Except (throwError, catchError)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import qualified Text.Pandoc.Class.PandocMonad as P
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Data.List.NonEmpty (nonEmpty)
import Data.Aeson (eitherDecode)
import qualified Data.Text.Lazy as TL
import Text.Pandoc.UTF8 (fromTextLazy)
import Text.Pandoc.Citeproc.MetaValue (referenceToMetaValue)
import Text.Pandoc.Readers.EndNote (readEndNoteXMLCitation)
readDocx :: PandocMonad m
=> ReaderOptions
-> B.ByteString
-> m Pandoc
readDocx :: forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> ByteString -> m Pandoc
readDocx ReaderOptions
opts ByteString
bytes =
case ByteString -> Either String Archive
toArchiveOrFail ByteString
bytes of
Right Archive
archive ->
case Archive -> Either DocxError (Docx, [Text])
archiveToDocxWithWarnings Archive
archive of
Right (Docx
docx, [Text]
parserWarnings) -> do
(Text -> m ()) -> [Text] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (LogMessage -> m ()) -> (Text -> LogMessage) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogMessage
DocxParserWarning) [Text]
parserWarnings
(meta, blks) <- ReaderOptions -> Docx -> m (Meta, [Block])
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Docx -> m (Meta, [Block])
docxToOutput ReaderOptions
opts Docx
docx
return $ Pandoc meta blks
Left DocxError
docxerr -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
Text
"couldn't parse docx file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (DocxError -> String
forall a. Show a => a -> String
show DocxError
docxerr)
Left String
err -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
Text
"couldn't unpack docx container: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
data DState = DState { DState -> Map Text Text
docxAnchorMap :: M.Map T.Text T.Text
, DState -> Set Text
docxAnchorSet :: Set.Set T.Text
, DState -> Maybe Text
docxImmedPrevAnchor :: Maybe T.Text
, DState -> MediaBag
docxMediaBag :: MediaBag
, DState -> Bool
docxNumberedHeadings :: Bool
, DState -> Inlines
docxDropCap :: Inlines
, DState -> Map (Text, Text) Integer
docxListState :: M.Map (T.Text, T.Text) Integer
, DState -> Inlines
docxPrevPara :: Inlines
, DState -> Map ItemId (Reference Inlines)
docxReferences :: M.Map ItemId (Reference Inlines)
}
instance Default DState where
def :: DState
def = DState { docxAnchorMap :: Map Text Text
docxAnchorMap = Map Text Text
forall k a. Map k a
M.empty
, docxAnchorSet :: Set Text
docxAnchorSet = Set Text
forall a. Monoid a => a
mempty
, docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = Maybe Text
forall a. Maybe a
Nothing
, docxMediaBag :: MediaBag
docxMediaBag = MediaBag
forall a. Monoid a => a
mempty
, docxNumberedHeadings :: Bool
docxNumberedHeadings = Bool
False
, docxDropCap :: Inlines
docxDropCap = Inlines
forall a. Monoid a => a
mempty
, docxListState :: Map (Text, Text) Integer
docxListState = Map (Text, Text) Integer
forall k a. Map k a
M.empty
, docxPrevPara :: Inlines
docxPrevPara = Inlines
forall a. Monoid a => a
mempty
, docxReferences :: Map ItemId (Reference Inlines)
docxReferences = Map ItemId (Reference Inlines)
forall a. Monoid a => a
mempty
}
data DEnv = DEnv { DEnv -> ReaderOptions
docxOptions :: ReaderOptions
, :: Bool
, DEnv -> Bool
docxInBidi :: Bool
}
instance Default DEnv where
def :: DEnv
def = ReaderOptions -> Bool -> Bool -> DEnv
DEnv ReaderOptions
forall a. Default a => a
def Bool
False Bool
False
type DocxContext m = ReaderT DEnv (StateT DState m)
evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a
evalDocxContext :: forall (m :: * -> *) a.
PandocMonad m =>
DocxContext m a -> DEnv -> DState -> m a
evalDocxContext DocxContext m a
ctx DEnv
env DState
st = (StateT DState m a -> DState -> m a)
-> DState -> StateT DState m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT DState m a -> DState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT DState
st (StateT DState m a -> m a) -> StateT DState m a -> m a
forall a b. (a -> b) -> a -> b
$ DocxContext m a -> DEnv -> StateT DState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DocxContext m a
ctx DEnv
env
spansToKeep :: [CharStyleName]
spansToKeep :: [CharStyleName]
spansToKeep = []
divsToKeep :: [ParaStyleName]
divsToKeep :: [ParaStyleName]
divsToKeep = [ParaStyleName
"Definition", ParaStyleName
"Definition Term"]
metaStyles :: M.Map ParaStyleName T.Text
metaStyles :: Map ParaStyleName Text
metaStyles = [(ParaStyleName, Text)] -> Map ParaStyleName Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ParaStyleName
"Title", Text
"title")
, (ParaStyleName
"Subtitle", Text
"subtitle")
, (ParaStyleName
"Author", Text
"author")
, (ParaStyleName
"Date", Text
"date")
, (ParaStyleName
"Abstract", Text
"abstract")]
sepBodyParts :: [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts :: [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts = (BodyPart -> Bool) -> [BodyPart] -> ([BodyPart], [BodyPart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\BodyPart
bp -> BodyPart -> Bool
isMetaPar BodyPart
bp Bool -> Bool -> Bool
|| BodyPart -> Bool
isEmptyPar BodyPart
bp)
isMetaPar :: BodyPart -> Bool
isMetaPar :: BodyPart -> Bool
isMetaPar (Paragraph ParagraphStyle
pPr [ParPart]
_) =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ParaStyleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ParaStyleName] -> Bool) -> [ParaStyleName] -> Bool
forall a b. (a -> b) -> a -> b
$ [ParaStyleName] -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => [a] -> [a] -> [a]
intersect ([ParStyle] -> [StyleName ParStyle]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames ([ParStyle] -> [StyleName ParStyle])
-> [ParStyle] -> [StyleName ParStyle]
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) (Map ParaStyleName Text -> [ParaStyleName]
forall k a. Map k a -> [k]
M.keys Map ParaStyleName Text
metaStyles)
isMetaPar BodyPart
_ = Bool
False
isEmptyPar :: BodyPart -> Bool
isEmptyPar :: BodyPart -> Bool
isEmptyPar (Paragraph ParagraphStyle
_ [ParPart]
parParts) =
(ParPart -> Bool) -> [ParPart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParPart -> Bool
isEmptyParPart [ParPart]
parParts
where
isEmptyParPart :: ParPart -> Bool
isEmptyParPart (PlainRun (Run RunStyle
_ [RunElem]
runElems)) = (RunElem -> Bool) -> [RunElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RunElem -> Bool
isEmptyElem [RunElem]
runElems
isEmptyParPart ParPart
_ = Bool
False
isEmptyElem :: RunElem -> Bool
isEmptyElem (TextRun Text
s) = Text -> Text
trim Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
isEmptyElem RunElem
_ = Bool
True
isEmptyPar BodyPart
_ = Bool
False
bodyPartsToMeta' :: PandocMonad m => [BodyPart] -> DocxContext m (M.Map T.Text MetaValue)
bodyPartsToMeta' :: forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [] = Map Text MetaValue
-> ReaderT DEnv (StateT DState m) (Map Text MetaValue)
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text MetaValue
forall k a. Map k a
M.empty
bodyPartsToMeta' (BodyPart
bp : [BodyPart]
bps)
| (Paragraph ParagraphStyle
pPr [ParPart]
parParts) <- BodyPart
bp
, (ParaStyleName
c : [ParaStyleName]
_)<- [ParStyle] -> [StyleName ParStyle]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) [ParaStyleName] -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Map ParaStyleName Text -> [ParaStyleName]
forall k a. Map k a -> [k]
M.keys Map ParaStyleName Text
metaStyles
, (Just Text
metaField) <- ParaStyleName -> Map ParaStyleName Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ParaStyleName
c Map ParaStyleName Text
metaStyles = do
inlines <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parParts
remaining <- bodyPartsToMeta' bps
let
f MetaValue
_ MetaValue
x | Text
metaField Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"title" Bool -> Bool -> Bool
|| Text
metaField Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"subtitle" = MetaValue
x
f (MetaInlines [Inline]
ils) (MetaInlines [Inline]
ils') = [Block] -> MetaValue
MetaBlocks [[Inline] -> Block
Para [Inline]
ils, [Inline] -> Block
Para [Inline]
ils']
f (MetaInlines [Inline]
ils) (MetaBlocks [Block]
blks) = [Block] -> MetaValue
MetaBlocks ([Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
f MetaValue
m (MetaList [MetaValue]
mv) = [MetaValue] -> MetaValue
MetaList (MetaValue
m MetaValue -> [MetaValue] -> [MetaValue]
forall a. a -> [a] -> [a]
: [MetaValue]
mv)
f MetaValue
m MetaValue
n = [MetaValue] -> MetaValue
MetaList [MetaValue
m, MetaValue
n]
return $ M.insertWith f metaField (MetaInlines (toList inlines)) remaining
bodyPartsToMeta' (BodyPart
_ : [BodyPart]
bps) = [BodyPart] -> ReaderT DEnv (StateT DState m) (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
bodyPartsToMeta :: PandocMonad m => [BodyPart] -> DocxContext m Meta
bodyPartsToMeta :: forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m Meta
bodyPartsToMeta [BodyPart]
bps = do
mp <- [BodyPart] -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
let mp' =
case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"author" Map Text MetaValue
mp of
Just MetaValue
mv -> Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"author" (MetaValue -> MetaValue
fixAuthors MetaValue
mv) Map Text MetaValue
mp
Maybe MetaValue
Nothing -> Map Text MetaValue
mp
return $ Meta mp'
fixAuthors :: MetaValue -> MetaValue
fixAuthors :: MetaValue -> MetaValue
fixAuthors (MetaBlocks [Block]
blks) = [MetaValue] -> MetaValue
MetaList [[Inline] -> MetaValue
MetaInlines [Inline]
ils | Para [Inline]
ils <- [Block]
blks]
fixAuthors MetaValue
mv = MetaValue
mv
isInheritedFromStyles :: (Eq (StyleName s), HasStyleName s, HasParentStyle s) => [StyleName s] -> s -> Bool
isInheritedFromStyles :: forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName s]
names s
sty
| s -> StyleName s
forall a. HasStyleName a => a -> StyleName a
getStyleName s
sty StyleName s -> [StyleName s] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StyleName s]
names = Bool
True
| Just s
psty <- s -> Maybe s
forall a. HasParentStyle a => a -> Maybe a
getParentStyle s
sty = [StyleName s] -> s -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName s]
names s
psty
| Bool
otherwise = Bool
False
hasStylesInheritedFrom :: [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom :: [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom [ParaStyleName]
ns ParagraphStyle
s = (ParStyle -> Bool) -> [ParStyle] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([StyleName ParStyle] -> ParStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName ParStyle]
[ParaStyleName]
ns) ([ParStyle] -> Bool) -> [ParStyle] -> Bool
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
s
removeStyleNamed :: ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed :: ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed ParaStyleName
sn ParagraphStyle
ps = ParagraphStyle
ps{pStyle = filter (\ParStyle
psd -> ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
psd ParaStyleName -> ParaStyleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ParaStyleName
sn) $ pStyle ps}
isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle = [StyleName CharStyle] -> CharStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName CharStyle
CharStyleName
"Verbatim Char"]
isCodeDiv :: ParagraphStyle -> Bool
isCodeDiv :: ParagraphStyle -> Bool
isCodeDiv = [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom [ParaStyleName
"Source Code", ParaStyleName
"SourceCode", ParaStyleName
"source_code"]
isBlockQuote :: ParStyle -> Bool
isBlockQuote :: ParStyle -> Bool
isBlockQuote =
[StyleName ParStyle] -> ParStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [
StyleName ParStyle
ParaStyleName
"Quote", StyleName ParStyle
ParaStyleName
"Block Text", StyleName ParStyle
ParaStyleName
"Block Quote", StyleName ParStyle
ParaStyleName
"Block Quotation", StyleName ParStyle
ParaStyleName
"Intense Quote"
]
runElemToInlines :: RunElem -> Inlines
runElemToInlines :: RunElem -> Inlines
runElemToInlines (TextRun Text
s) = Text -> Inlines
text Text
s
runElemToInlines RunElem
LnBrk = Inlines
linebreak
runElemToInlines RunElem
Tab = Inlines
space
runElemToInlines RunElem
SoftHyphen = Text -> Inlines
text Text
"\xad"
runElemToInlines RunElem
NoBreakHyphen = Text -> Inlines
text Text
"\x2011"
runElemToText :: RunElem -> T.Text
runElemToText :: RunElem -> Text
runElemToText (TextRun Text
s) = Text
s
runElemToText RunElem
LnBrk = Char -> Text
T.singleton Char
'\n'
runElemToText RunElem
Tab = Char -> Text
T.singleton Char
'\t'
runElemToText RunElem
SoftHyphen = Char -> Text
T.singleton Char
'\xad'
runElemToText RunElem
NoBreakHyphen = Char -> Text
T.singleton Char
'\x2011'
runToText :: Run -> T.Text
runToText :: Run -> Text
runToText (Run RunStyle
_ [RunElem]
runElems) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RunElem -> Text) -> [RunElem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Text
runElemToText [RunElem]
runElems
runToText Run
_ = Text
""
parPartToText :: ParPart -> T.Text
parPartToText :: ParPart -> Text
parPartToText (PlainRun Run
run) = Run -> Text
runToText Run
run
parPartToText (InternalHyperLink Text
_ [ParPart]
children) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ParPart -> Text) -> [ParPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParPart -> Text
parPartToText [ParPart]
children
parPartToText (ExternalHyperLink Text
_ [ParPart]
children) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ParPart -> Text) -> [ParPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParPart -> Text
parPartToText [ParPart]
children
parPartToText ParPart
_ = Text
""
blacklistedCharStyles :: [CharStyleName]
blacklistedCharStyles :: [CharStyleName]
blacklistedCharStyles = [CharStyleName
"Hyperlink"]
resolveDependentRunStyle :: PandocMonad m => RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle :: forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rPr
| Just CharStyle
s <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr
, CharStyle -> StyleName CharStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName CharStyle
s CharStyleName -> [CharStyleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CharStyleName]
blacklistedCharStyles = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
if isEnabled Ext_styles opts
then return rPr
else leftBiasedMergeRunStyle rPr <$> resolveDependentRunStyle (cStyleData s)
| Bool
otherwise = RunStyle -> ReaderT DEnv (StateT DState m) RunStyle
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
rPr
runStyleToTransform :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform :: forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr' = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
inBidi <- asks docxInBidi
let styles = Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles ReaderOptions
opts
ctl = (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== RunStyle -> Maybe Bool
isRTL RunStyle
rPr') Bool -> Bool -> Bool
|| (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== RunStyle -> Maybe Bool
isForceCTL RunStyle
rPr')
italic RunStyle
rPr | Bool
ctl = RunStyle -> Maybe Bool
isItalicCTL RunStyle
rPr
| Bool
otherwise = RunStyle -> Maybe Bool
isItalic RunStyle
rPr
bold RunStyle
rPr | Bool
ctl = RunStyle -> Maybe Bool
isBoldCTL RunStyle
rPr
| Bool
otherwise = RunStyle -> Maybe Bool
isBold RunStyle
rPr
go RunStyle
rPr
| Just CharStyleName
sn <- CharStyle -> StyleName CharStyle
CharStyle -> CharStyleName
forall a. HasStyleName a => a -> StyleName a
getStyleName (CharStyle -> CharStyleName)
-> Maybe CharStyle -> Maybe CharStyleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr
, CharStyleName
sn CharStyleName -> [CharStyleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CharStyleName]
spansToKeep =
Attr -> Inlines -> Inlines
spanWith (Text
"", [CharStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName CharStyleName
sn], [])
(Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rParentStyle = Nothing}
| Bool
styles, Just CharStyle
s <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr =
Attr -> Inlines -> Inlines
spanWith (CharStyle -> Attr
forall a. (Eq (StyleName a), HasStyleName a) => a -> Attr
extraAttr CharStyle
s) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rParentStyle = Nothing}
| Just Bool
True <- RunStyle -> Maybe Bool
italic RunStyle
rPr =
Inlines -> Inlines
emph (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isItalic = Nothing, isItalicCTL = Nothing}
| Just Bool
True <- RunStyle -> Maybe Bool
bold RunStyle
rPr =
Inlines -> Inlines
strong (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isBold = Nothing, isBoldCTL = Nothing}
| Just Text
_ <- RunStyle -> Maybe Text
rHighlight RunStyle
rPr =
Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"mark"],[]) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rHighlight = Nothing}
| Just Bool
True <- RunStyle -> Maybe Bool
isSmallCaps RunStyle
rPr =
Inlines -> Inlines
smallcaps (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isSmallCaps = Nothing}
| Just Bool
True <- RunStyle -> Maybe Bool
isStrike RunStyle
rPr =
Inlines -> Inlines
strikeout (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isStrike = Nothing}
| Just Bool
True <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr =
Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"dir",Text
"rtl")]) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isRTL = Nothing}
| Bool
inBidi, Just Bool
False <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr =
Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"dir",Text
"ltr")]) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isRTL = Nothing}
| Just VertAlign
SupScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr =
Inlines -> Inlines
superscript (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rVertAlign = Nothing}
| Just VertAlign
SubScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr =
Inlines -> Inlines
subscript (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rVertAlign = Nothing}
| Just Text
"single" <- RunStyle -> Maybe Text
rUnderline RunStyle
rPr =
Inlines -> Inlines
Pandoc.underline (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rUnderline = Nothing}
| Bool
otherwise = Inlines -> Inlines
forall a. a -> a
id
return $ go rPr'
runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
runToInlines :: forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines (Run RunStyle
rs [RunElem]
runElems)
| Bool -> (CharStyle -> Bool) -> Maybe CharStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False CharStyle -> Bool
isCodeCharStyle (Maybe CharStyle -> Bool) -> Maybe CharStyle -> Bool
forall a b. (a -> b) -> a -> b
$ RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rs = do
rPr <- RunStyle -> DocxContext m RunStyle
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
let codeString = Text -> Inlines
code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RunElem -> Text) -> [RunElem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Text
runElemToText [RunElem]
runElems
return $ case rVertAlign rPr of
Just VertAlign
SupScrpt -> Inlines -> Inlines
superscript Inlines
codeString
Just VertAlign
SubScrpt -> Inlines -> Inlines
subscript Inlines
codeString
Maybe VertAlign
_ -> Inlines
codeString
| Bool
otherwise = do
rPr <- RunStyle -> DocxContext m RunStyle
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
let ils = [Inlines] -> Inlines
smushInlines ((RunElem -> Inlines) -> [RunElem] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Inlines
runElemToInlines [RunElem]
runElems)
transform <- runStyleToTransform rPr
return $ transform ils
runToInlines (Footnote [BodyPart]
bps) = Blocks -> Inlines
note (Blocks -> Inlines) -> ([Blocks] -> Blocks) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
smushBlocks ([Blocks] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
runToInlines (Endnote [BodyPart]
bps) = Blocks -> Inlines
note (Blocks -> Inlines) -> ([Blocks] -> Blocks) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
smushBlocks ([Blocks] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
runToInlines (InlineDrawing String
fp Text
title Text
alt ByteString
bs Extent
ext) = do
(StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT DEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> (m () -> StateT DState m ())
-> m ()
-> ReaderT DEnv (StateT DState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT DState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT DState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (m () -> ReaderT DEnv (StateT DState m) ())
-> m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp Maybe Text
forall a. Maybe a
Nothing ByteString
bs
Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ReaderT DEnv (StateT DState m) Inlines)
-> Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Extent -> Attr
extentToAttr Extent
ext) (String -> Text
T.pack String
fp) Text
title (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
runToInlines Run
InlineChart = Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ReaderT DEnv (StateT DState m) Inlines)
-> Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"chart"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[CHART]"
runToInlines Run
InlineDiagram = Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ReaderT DEnv (StateT DState m) Inlines)
-> Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"diagram"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[DIAGRAM]"
extentToAttr :: Extent -> Attr
extentToAttr :: Extent -> Attr
extentToAttr (Just (Double
w, Double
h)) =
(Text
"", [], [(Text
"width", Double -> Text
forall {a}. (Show a, Fractional a) => a -> Text
showDim Double
w), (Text
"height", Double -> Text
forall {a}. (Show a, Fractional a) => a -> Text
showDim Double
h)] )
where
showDim :: a -> Text
showDim a
d = a -> Text
forall a. Show a => a -> Text
tshow (a
d a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
914400) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in"
extentToAttr Extent
_ = Attr
nullAttr
blocksToInlinesWarn :: PandocMonad m => T.Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn :: forall (m :: * -> *).
PandocMonad m =>
Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn Text
cmtId Blocks
blks = do
let paraOrPlain :: Block -> Bool
paraOrPlain :: Block -> Bool
paraOrPlain (Para [Inline]
_) = Bool
True
paraOrPlain (Plain [Inline]
_) = Bool
True
paraOrPlain Block
_ = Bool
False
Bool
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Block -> Bool) -> Blocks -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
paraOrPlain Blocks
blks) (ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ())
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$
StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT DEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> StateT DState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (LogMessage -> StateT DState m ())
-> LogMessage -> StateT DState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
DocxParserWarning (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$
Text
"Docx comment " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmtId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" will not retain formatting"
Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ReaderT DEnv (StateT DState m) Inlines)
-> Inlines -> ReaderT DEnv (StateT DState m) Inlines
forall a b. (a -> b) -> a -> b
$ [Block] -> Inlines
blocksToInlines' (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blks)
parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines
parPartToInlines :: forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines ParPart
parPart =
case ParPart
parPart of
(BookMark Text
_ Text
anchor) | Text
anchor Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dummyAnchors -> do
inHdrBool <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
ils <- parPartToInlines' parPart
immedPrevAnchor <- gets docxImmedPrevAnchor
unless (isJust immedPrevAnchor || inHdrBool)
(modify $ \DState
s -> DState
s{ docxImmedPrevAnchor = Just anchor})
return ils
ParPart
_ -> do
ils <- ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' ParPart
parPart
modify $ \DState
s -> DState
s{ docxImmedPrevAnchor = Nothing}
return ils
parPartToInlines' :: PandocMonad m => ParPart -> DocxContext m Inlines
parPartToInlines' :: forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' (PlainRun Run
r) = Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines Run
r
parPartToInlines' (ChangedRuns (TrackedChange ChangeType
Insertion (ChangeInfo Text
_ Text
author Maybe Text
date)) [ParPart]
pparts) = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
case readerTrackChanges opts of
TrackChanges
AcceptChanges -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
pparts
TrackChanges
RejectChanges -> Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
TrackChanges
AllChanges -> do
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
pparts
let attr = (Text
"", [Text
"insertion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
return $ spanWith attr ils
parPartToInlines' (ChangedRuns (TrackedChange ChangeType
Deletion (ChangeInfo Text
_ Text
author Maybe Text
date)) [ParPart]
pparts) = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
case readerTrackChanges opts of
TrackChanges
AcceptChanges -> Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
TrackChanges
RejectChanges -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
pparts
TrackChanges
AllChanges -> do
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
pparts
let attr = (Text
"", [Text
"deletion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
return $ spanWith attr ils
parPartToInlines' (CommentStart Text
cmtId Text
author Maybe Text
date [BodyPart]
bodyParts) = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
case readerTrackChanges opts of
TrackChanges
AllChanges -> do
blks <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bodyParts
ils <- blocksToInlinesWarn cmtId blks
let attr = (Text
"", [Text
"comment-start"], (Text
"id", Text
cmtId) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
return $ spanWith attr ils
TrackChanges
_ -> Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (CommentEnd Text
cmtId) = do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
case readerTrackChanges opts of
TrackChanges
AllChanges -> do
let attr :: Attr
attr = (Text
"", [Text
"comment-end"], [(Text
"id", Text
cmtId)])
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
TrackChanges
_ -> Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (BookMark Text
_ Text
anchor) | Text
anchor Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dummyAnchors =
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (BookMark Text
_ Text
anchor) =
do
inHdrBool <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
anchorMap <- gets docxAnchorMap
immedPrevAnchor <- gets docxImmedPrevAnchor
case immedPrevAnchor of
Just Text
prevAnchor | Bool -> Bool
not Bool
inHdrBool -> do
((DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s { docxAnchorMap = M.insert anchor prevAnchor anchorMap})
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Maybe Text
_ -> do
exts <- (DEnv -> Extensions) -> ReaderT DEnv (StateT DState m) Extensions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ReaderOptions -> Extensions
readerExtensions (ReaderOptions -> Extensions)
-> (DEnv -> ReaderOptions) -> DEnv -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
let newAnchor =
if Bool -> Bool
not Bool
inHdrBool Bool -> Bool -> Bool
&& Text
anchor Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
anchorMap
then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Text -> Inline
Str Text
anchor]
([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
anchorMap)
else Text
anchor
unless inHdrBool
(modify $ \DState
s -> DState
s { docxAnchorMap = M.insert anchor newAnchor anchorMap})
return $ spanWith (newAnchor, ["anchor"], []) mempty
parPartToInlines' (Drawing String
fp Text
title Text
alt ByteString
bs Extent
ext) = do
(StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT DEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> (m () -> StateT DState m ())
-> m ()
-> ReaderT DEnv (StateT DState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT DState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT DState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (m () -> ReaderT DEnv (StateT DState m) ())
-> m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp Maybe Text
forall a. Maybe a
Nothing ByteString
bs
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Extent -> Attr
extentToAttr Extent
ext) (String -> Text
T.pack String
fp) Text
title (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
parPartToInlines' ParPart
Chart =
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"chart"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[CHART]"
parPartToInlines' ParPart
Diagram =
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"diagram"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[DIAGRAM]"
parPartToInlines' (InternalHyperLink Text
anchor [ParPart]
children) = do
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
return $ link ("#" <> anchor) "" ils
parPartToInlines' (ExternalHyperLink Text
target [ParPart]
children) = do
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
return $ link target "" ils
parPartToInlines' (PlainOMath [Exp]
exps) =
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
math (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeTeX [Exp]
exps
parPartToInlines' (OMathPara [Exp]
exps) =
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
displayMath (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeTeX [Exp]
exps
parPartToInlines' (Field FieldInfo
info [ParPart]
children) =
case FieldInfo
info of
HyperlinkField Text
url -> ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' (ParPart -> DocxContext m Inlines)
-> ParPart -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> [ParPart] -> ParPart
ExternalHyperLink Text
url [ParPart]
children
IndexrefField IndexEntry
ie ->
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"indexref"],
((Text
"entry", IndexEntry -> Text
entryTitle IndexEntry
ie) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
[(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"crossref",Text
x)]) (IndexEntry -> Maybe Text
entrySee IndexEntry
ie)
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text
"yomi",Text
x)]) (IndexEntry -> Maybe Text
entryYomi IndexEntry
ie)
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
"bold",Text
"") | IndexEntry -> Bool
entryBold IndexEntry
ie]
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
"italic",Text
"") | IndexEntry -> Bool
entryItalic IndexEntry
ie])) Inlines
forall a. Monoid a => a
mempty
PagerefField Text
fieldAnchor Bool
True -> ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' (ParPart -> DocxContext m Inlines)
-> ParPart -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> [ParPart] -> ParPart
InternalHyperLink Text
fieldAnchor [ParPart]
children
EndNoteCite Text
t -> do
formattedCite <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
opts <- asks docxOptions
if isEnabled Ext_citations opts
then catchError
(do citation <- readEndNoteXMLCitation t
cs <- handleCitation citation
return $ cite cs formattedCite)
(\case
PandocXMLError Text
_ Text
msg -> do
LogMessage -> ReaderT DEnv (StateT DState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (LogMessage -> ReaderT DEnv (StateT DState m) ())
-> LogMessage -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
DocxParserWarning
(Text
"Cannot parse EndNote citation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
formattedCite
PandocError
e -> PandocError -> DocxContext m Inlines
forall a. PandocError -> ReaderT DEnv (StateT DState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
else return formattedCite
CslCitation Text
t -> do
formattedCite <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
opts <- asks docxOptions
if isEnabled Ext_citations opts
then do
let bs = Text -> ByteString
fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
t
case eitherDecode bs of
Left String
_err -> Inlines -> DocxContext m Inlines
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
formattedCite
Right Citation Text
citation -> do
cs <- Citation Text -> DocxContext m [Citation]
forall (m :: * -> *).
PandocMonad m =>
Citation Text -> DocxContext m [Citation]
handleCitation Citation Text
citation
return $ cite cs formattedCite
else return formattedCite
FieldInfo
CslBibliography -> do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
if isEnabled Ext_citations opts
then return mempty
else smushInlines <$> mapM parPartToInlines' children
FieldInfo
EndNoteRefList -> do
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
if isEnabled Ext_citations opts
then return mempty
else smushInlines <$> mapM parPartToInlines' children
FieldInfo
_ -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> DocxContext m Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
convertCitationMode :: Citeproc.CitationItemType -> CitationMode
convertCitationMode :: CitationItemType -> CitationMode
convertCitationMode CitationItemType
itemType = case CitationItemType
itemType of
CitationItemType
Citeproc.NormalCite -> CitationMode
NormalCitation
CitationItemType
Citeproc.SuppressAuthor -> CitationMode
SuppressAuthor
CitationItemType
Citeproc.AuthorOnly -> CitationMode
AuthorInText
handleCitation :: PandocMonad m
=> Citeproc.Citation T.Text
-> DocxContext m [Citation]
handleCitation :: forall (m :: * -> *).
PandocMonad m =>
Citation Text -> DocxContext m [Citation]
handleCitation Citation Text
citation = do
let toPandocCitation :: CitationItem Text -> Citation
toPandocCitation CitationItem Text
item =
Citation{ citationId :: Text
citationId = ItemId -> Text
unItemId (CitationItem Text -> ItemId
forall a. CitationItem a -> ItemId
Citeproc.citationItemId CitationItem Text
item)
, citationPrefix :: [Inline]
citationPrefix = [Inline] -> (Text -> [Inline]) -> Maybe Text -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline]) -> (Text -> Inlines) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text) (Maybe Text -> [Inline]) -> Maybe Text -> [Inline]
forall a b. (a -> b) -> a -> b
$
CitationItem Text -> Maybe Text
forall a. CitationItem a -> Maybe a
Citeproc.citationItemPrefix CitationItem Text
item
, citationSuffix :: [Inline]
citationSuffix = (Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline]) -> (Text -> Inlines) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text) (Text -> [Inline]) -> Text -> [Inline]
forall a b. (a -> b) -> a -> b
$
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (\Text
x -> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" ") (CitationItem Text -> Maybe Text
forall a. CitationItem a -> Maybe Text
Citeproc.citationItemLabel CitationItem Text
item)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")
(CitationItem Text -> Maybe Text
forall a. CitationItem a -> Maybe Text
Citeproc.citationItemLocator CitationItem Text
item)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (CitationItem Text -> Maybe Text
forall a. CitationItem a -> Maybe a
Citeproc.citationItemSuffix CitationItem Text
item)
, citationMode :: CitationMode
citationMode = CitationItemType -> CitationMode
convertCitationMode (CitationItem Text -> CitationItemType
forall a. CitationItem a -> CitationItemType
Citeproc.citationItemType CitationItem Text
item)
, citationNoteNum :: Int
citationNoteNum = Int
0
, citationHash :: Int
citationHash = Int
0 }
let items :: [CitationItem Text]
items = Citation Text -> [CitationItem Text]
forall a. Citation a -> [CitationItem a]
Citeproc.citationItems Citation Text
citation
let cs :: [Citation]
cs = (CitationItem Text -> Citation)
-> [CitationItem Text] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem Text -> Citation
toPandocCitation [CitationItem Text]
items
let refs :: [Reference Inlines]
refs = (CitationItem Text -> Maybe (Reference Inlines))
-> [CitationItem Text] -> [Reference Inlines]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\CitationItem Text
item -> (Reference Text -> Reference Inlines)
-> Maybe (Reference Text) -> Maybe (Reference Inlines)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Reference Text
itemData -> Text -> Inlines
text (Text -> Inlines) -> Reference Text -> Reference Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Reference Text
itemData{ referenceId =
Citeproc.citationItemId item })
(CitationItem Text -> Maybe (Reference Text)
forall a. CitationItem a -> Maybe (Reference a)
Citeproc.citationItemData CitationItem Text
item)) [CitationItem Text]
items
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
st ->
DState
st{ docxReferences = foldr
(\Reference Inlines
ref -> ItemId
-> Reference Inlines
-> Map ItemId (Reference Inlines)
-> Map ItemId (Reference Inlines)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Reference Inlines -> ItemId
forall a. Reference a -> ItemId
referenceId Reference Inlines
ref) Reference Inlines
ref)
(docxReferences st)
refs }
[Citation] -> ReaderT DEnv (StateT DState m) [Citation]
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Citation]
cs
isAnchorSpan :: Inline -> Bool
isAnchorSpan :: Inline -> Bool
isAnchorSpan (Span (Text
_, [Text
"anchor"], []) [Inline]
_) = Bool
True
isAnchorSpan Inline
_ = Bool
False
dummyAnchors :: [T.Text]
dummyAnchors :: [Text]
dummyAnchors = [Text
"_GoBack"]
makeHeaderAnchor :: PandocMonad m => Blocks -> DocxContext m Blocks
Blocks
bs = (Block -> ReaderT DEnv (StateT DState m) Block)
-> Blocks -> ReaderT DEnv (StateT DState m) Blocks
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Many a -> f (Many b)
traverse Block -> ReaderT DEnv (StateT DState m) Block
forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' Blocks
bs
makeHeaderAnchor' :: PandocMonad m => Block -> DocxContext m Block
(Header Int
n (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils)
| (Inline
c:[Inline]
_) <- (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
isAnchorSpan [Inline]
ils
, (Span (Text
anchIdent, [Text
"anchor"], [(Text, Text)]
_) [Inline]
cIls) <- Inline
c = do
hdrIDMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
exts <- asks (readerExtensions . docxOptions)
let newIdent = if Text -> Bool
T.null Text
ident
then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
ils ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
else Text
ident
newIls = (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
f [Inline]
ils where f :: Inline -> [Inline]
f Inline
il | Inline
il Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
c = [Inline]
cIls
| Bool
otherwise = [Inline
il]
modify $ \DState
s -> DState
s {docxAnchorMap = M.insert anchIdent newIdent hdrIDMap}
makeHeaderAnchor' $ Header n (newIdent, classes, kvs) newIls
makeHeaderAnchor' (Header Int
n (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils) =
do
hdrIDMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
exts <- asks (readerExtensions . docxOptions)
let newIdent = if Text -> Bool
T.null Text
ident
then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
ils ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
else Text
ident
modify $ \DState
s -> DState
s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap}
return $ Header n (newIdent, classes, kvs) ils
makeHeaderAnchor' Block
blk = Block -> DocxContext m Block
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
blk
singleParaToPlain :: Blocks -> Blocks
singleParaToPlain :: Blocks -> Blocks
singleParaToPlain Blocks
blks
| (Para [Inline]
ils :< Seq Block
seeq) <- Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl (Seq Block -> ViewL Block) -> Seq Block -> ViewL Block
forall a b. (a -> b) -> a -> b
$ Blocks -> Seq Block
forall a. Many a -> Seq a
unMany Blocks
blks
, Seq Block -> Bool
forall a. Seq a -> Bool
Seq.null Seq Block
seeq =
Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [Inline]
ils
singleParaToPlain Blocks
blks = Blocks
blks
cellToCell :: PandocMonad m => RowSpan -> Docx.Cell -> DocxContext m Pandoc.Cell
cellToCell :: forall (m :: * -> *).
PandocMonad m =>
RowSpan -> Cell -> DocxContext m Cell
cellToCell RowSpan
rowSpan (Docx.Cell Align
align Integer
gridSpan VMerge
_ [BodyPart]
bps) = do
blks <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
let blks' = Blocks -> Blocks
singleParaToPlain (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToDefinitions ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToBullets ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blks
return (cell (convertAlign align)
rowSpan (ColSpan (fromIntegral gridSpan)) blks')
rowsToRows :: PandocMonad m => [Docx.Row] -> DocxContext m [Pandoc.Row]
rowsToRows :: forall (m :: * -> *). PandocMonad m => [Row] -> DocxContext m [Row]
rowsToRows [Row]
rows = do
let rowspans :: [[(RowSpan, Cell)]]
rowspans = (([(Int, Cell)] -> [(RowSpan, Cell)])
-> [[(Int, Cell)]] -> [[(RowSpan, Cell)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Int, Cell)] -> [(RowSpan, Cell)])
-> [[(Int, Cell)]] -> [[(RowSpan, Cell)]])
-> (((Int, Cell) -> (RowSpan, Cell))
-> [(Int, Cell)] -> [(RowSpan, Cell)])
-> ((Int, Cell) -> (RowSpan, Cell))
-> [[(Int, Cell)]]
-> [[(RowSpan, Cell)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Cell) -> (RowSpan, Cell))
-> [(Int, Cell)] -> [(RowSpan, Cell)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((Int -> RowSpan) -> (Int, Cell) -> (RowSpan, Cell)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> RowSpan
RowSpan) ([Row] -> [[(Int, Cell)]]
Docx.rowsToRowspans [Row]
rows)
cells <- ([(RowSpan, Cell)] -> ReaderT DEnv (StateT DState m) [Cell])
-> [[(RowSpan, Cell)]] -> ReaderT DEnv (StateT DState m) [[Cell]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((RowSpan, Cell) -> ReaderT DEnv (StateT DState m) Cell)
-> [(RowSpan, Cell)] -> ReaderT DEnv (StateT DState m) [Cell]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((RowSpan -> Cell -> ReaderT DEnv (StateT DState m) Cell)
-> (RowSpan, Cell) -> ReaderT DEnv (StateT DState m) Cell
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RowSpan -> Cell -> ReaderT DEnv (StateT DState m) Cell
forall (m :: * -> *).
PandocMonad m =>
RowSpan -> Cell -> DocxContext m Cell
cellToCell)) [[(RowSpan, Cell)]]
rowspans
return (fmap (Pandoc.Row nullAttr) cells)
splitHeaderRows :: Bool -> [Docx.Row] -> ([Docx.Row], [Docx.Row])
Bool
hasFirstRowFormatting [Row]
rs = ([Row] -> [Row])
-> ([Row] -> [Row]) -> ([Row], [Row]) -> ([Row], [Row])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Row] -> [Row]
forall a. [a] -> [a]
reverse [Row] -> [Row]
forall a. [a] -> [a]
reverse (([Row], [Row]) -> ([Row], [Row]))
-> ([Row], [Row]) -> ([Row], [Row])
forall a b. (a -> b) -> a -> b
$ (([Row], [Row]), Bool) -> ([Row], [Row])
forall a b. (a, b) -> a
fst
((([Row], [Row]), Bool) -> ([Row], [Row]))
-> (([Row], [Row]), Bool) -> ([Row], [Row])
forall a b. (a -> b) -> a -> b
$ if Bool
hasFirstRowFormatting
then ((([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool))
-> (([Row], [Row]), Bool) -> [Row] -> (([Row], [Row]), Bool)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool)
f ((Int -> [Row] -> [Row]
forall a. Int -> [a] -> [a]
take Int
1 [Row]
rs, []), Bool
True) (Int -> [Row] -> [Row]
forall a. Int -> [a] -> [a]
drop Int
1 [Row]
rs)
else ((([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool))
-> (([Row], [Row]), Bool) -> [Row] -> (([Row], [Row]), Bool)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool)
f (([], []), Bool
False) [Row]
rs
where
f :: (([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool)
f (([Row]
headerRows, [Row]
bodyRows), Bool
previousRowWasHeader) r :: Row
r@(Docx.Row TblHeader
h [Cell]
cs)
| TblHeader
h TblHeader -> TblHeader -> Bool
forall a. Eq a => a -> a -> Bool
== TblHeader
HasTblHeader Bool -> Bool -> Bool
|| (Bool
previousRowWasHeader Bool -> Bool -> Bool
&& (Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Cell -> Bool
isContinuationCell [Cell]
cs)
= ((Row
r Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
headerRows, [Row]
bodyRows), Bool
True)
| Bool
otherwise
= (([Row]
headerRows, Row
r Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
bodyRows), Bool
False)
isContinuationCell :: Cell -> Bool
isContinuationCell (Docx.Cell Align
_ Integer
_ VMerge
vm [BodyPart]
_) = VMerge
vm VMerge -> VMerge -> Bool
forall a. Eq a => a -> a -> Bool
== VMerge
Docx.Continue
trimSps :: Inlines -> Inlines
trimSps :: Inlines -> Inlines
trimSps (Many Seq Inline
ils) = Seq Inline -> Inlines
forall a. Seq a -> Many a
Many (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> Seq Inline -> Seq Inline
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL Inline -> Bool
isSp (Seq Inline -> Seq Inline) -> Seq Inline -> Seq Inline
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> Seq Inline -> Seq Inline
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileR Inline -> Bool
isSp Seq Inline
ils
where isSp :: Inline -> Bool
isSp Inline
Space = Bool
True
isSp Inline
SoftBreak = Bool
True
isSp Inline
LineBreak = Bool
True
isSp Inline
_ = Bool
False
extraAttr :: (Eq (StyleName a), HasStyleName a) => a -> Attr
a
s = (Text
"", [], [(Text
"custom-style", StyleName a -> Text
forall a. FromStyleName a => a -> Text
fromStyleName (StyleName a -> Text) -> StyleName a -> Text
forall a b. (a -> b) -> a -> b
$ a -> StyleName a
forall a. HasStyleName a => a -> StyleName a
getStyleName a
s)])
paragraphStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform :: forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr =
let transform :: Blocks -> Blocks
transform = if ParagraphStyle -> Integer
relativeIndent ParagraphStyle
pPr Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (ParagraphStyle -> Bool
numbered ParagraphStyle
pPr) Bool -> Bool -> Bool
&&
Bool -> Bool
not ((ParStyle -> Bool) -> [ParStyle] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ParaStyleName -> [ParaStyleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
listParagraphStyles) (ParaStyleName -> Bool)
-> (ParStyle -> ParaStyleName) -> ParStyle -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStyle -> StyleName ParStyle
ParStyle -> ParaStyleName
forall a. HasStyleName a => a -> StyleName a
getStyleName) (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr))
then Blocks -> Blocks
blockQuote
else Blocks -> Blocks
forall a. a -> a
id
in do
extStylesEnabled <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles (ReaderOptions -> Bool) -> (DEnv -> ReaderOptions) -> DEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
return $ foldr (\ParStyle
parStyle Blocks -> Blocks
transform' ->
(Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform Bool
extStylesEnabled ParStyle
parStyle) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform'
) transform (pStyle pPr)
parStyleToTransform :: Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform :: Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform Bool
extStylesEnabled parStyle :: ParStyle
parStyle@(ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName -> StyleName ParStyle
styleName)
| (StyleName ParStyle
ParaStyleName
styleName ParaStyleName -> [ParaStyleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
divsToKeep) Bool -> Bool -> Bool
|| (StyleName ParStyle
ParaStyleName
styleName ParaStyleName -> [ParaStyleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
listParagraphStyles) =
Attr -> Blocks -> Blocks
divWith (Text
"", [ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName StyleName ParStyle
ParaStyleName
styleName], [])
| Bool
otherwise =
(if Bool
extStylesEnabled then Attr -> Blocks -> Blocks
divWith (ParStyle -> Attr
forall a. (Eq (StyleName a), HasStyleName a) => a -> Attr
extraAttr ParStyle
parStyle) else Blocks -> Blocks
forall a. a -> a
id)
(Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if ParStyle -> Bool
isBlockQuote ParStyle
parStyle then Blocks -> Blocks
blockQuote else Blocks -> Blocks
forall a. a -> a
id)
relativeIndent :: ParagraphStyle -> Integer
relativeIndent :: ParagraphStyle -> Integer
relativeIndent ParagraphStyle
pPr =
let pStyleLeft :: Integer
pStyleLeft = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
pStyleIndentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
leftParIndent
pStyleHang :: Integer
pStyleHang = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
pStyleIndentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
hangingParIndent
left :: Integer
left = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
pStyleLeft (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
leftParIndent
hang :: Integer
hang = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
pStyleHang (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
hangingParIndent
in (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
hang) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
pStyleLeft Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
pStyleHang)
normalizeToClassName :: (FromStyleName a) => a -> T.Text
normalizeToClassName :: forall a. FromStyleName a => a -> Text
normalizeToClassName = (Char -> Char) -> Text -> Text
T.map Char -> Char
go (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. FromStyleName a => a -> Text
fromStyleName
where go :: Char -> Char
go Char
c | Char -> Bool
isSpace Char
c = Char
'-'
| Bool
otherwise = Char
c
bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks
bodyPartToBlocks :: forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (Heading Int
n ParaStyleName
style ParagraphStyle
pPr Text
numId Text
lvl Maybe Level
mblvlInfo [ParPart]
parparts) = do
ils <- (DEnv -> DEnv)
-> ReaderT DEnv (StateT DState m) Inlines
-> ReaderT DEnv (StateT DState m) Inlines
forall a.
(DEnv -> DEnv)
-> ReaderT DEnv (StateT DState m) a
-> ReaderT DEnv (StateT DState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DEnv
s-> DEnv
s{docxInHeaderBlock=True})
([Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts)
let classes = (ParaStyleName -> Text) -> [ParaStyleName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName ([ParaStyleName] -> [Text])
-> ([ParaStyleName] -> [ParaStyleName])
-> [ParaStyleName]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParaStyleName -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => a -> [a] -> [a]
delete ParaStyleName
style
([ParaStyleName] -> [Text]) -> [ParaStyleName] -> [Text]
forall a b. (a -> b) -> a -> b
$ [ParStyle] -> [StyleName ParStyle]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr)
hasNumbering <- gets docxNumberedHeadings
let addNum = if Bool
hasNumbering Bool -> Bool -> Bool
&& Bool -> Bool
not (ParagraphStyle -> Bool
numbered ParagraphStyle
pPr)
then ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"unnumbered"])
else [Text] -> [Text]
forall a. a -> a
id
if T.null numId
then pure ()
else do
listState <- gets docxListState
let start = case (Text, Text) -> Map (Text, Text) Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
numId, Text
lvl) Map (Text, Text) Integer
listState of
Maybe Integer
Nothing -> case Maybe Level
mblvlInfo of
Maybe Level
Nothing -> Integer
1
Just (Level Text
_ Text
_ Text
_ Maybe Integer
z) -> Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
1 Maybe Integer
z
Just Integer
z -> Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
modify $ \DState
st -> DState
st{ docxListState =
let notExpired (a
_, Text
lvl') p
_ = Text
lvl' Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
<= Text
lvl
in M.insert (numId, lvl) start
(M.filterWithKey notExpired listState) }
makeHeaderAnchor $ headerWith ("", addNum classes, []) n ils
bodyPartToBlocks (Paragraph ParagraphStyle
pPr [ParPart]
parparts)
| Just Bool
True <- ParagraphStyle -> Maybe Bool
pBidi ParagraphStyle
pPr = do
let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pBidi = Nothing }
(DEnv -> DEnv) -> DocxContext m Blocks -> DocxContext m Blocks
forall a.
(DEnv -> DEnv)
-> ReaderT DEnv (StateT DState m) a
-> ReaderT DEnv (StateT DState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DEnv
s -> DEnv
s{ docxInBidi = True })
(BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts))
| ParagraphStyle -> Bool
isCodeDiv ParagraphStyle
pPr = do
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr
return $
transform $
codeBlock $
T.concat $
map parPartToText parparts
| Bool
otherwise = do
ils <- Inlines -> Inlines
trimSps (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts
prevParaIls <- gets docxPrevPara
dropIls <- gets docxDropCap
let ils' = Inlines
dropIls Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils
let (paraOrPlain, pPr')
| hasStylesInheritedFrom ["Compact"] pPr = (plain, removeStyleNamed "Compact" pPr)
| otherwise = (para, pPr)
if dropCap pPr'
then do modify $ \DState
s -> DState
s { docxDropCap = ils' }
return mempty
else do modify $ \DState
s -> DState
s { docxDropCap = mempty }
let ils'' = (if Inlines -> Bool
forall a. Many a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
prevParaIls then Inlines
forall a. Monoid a => a
mempty
else Inlines
prevParaIls Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils'
handleInsertion = do
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara = mempty}
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
return $ transform $ paraOrPlain ils''
opts <- asks docxOptions
case (pChange pPr', readerTrackChanges opts) of
(Maybe TrackedChange, TrackChanges)
_ | Inlines -> Bool
forall a. Many a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
ils'', Bool -> Bool
not (Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs ReaderOptions
opts) ->
Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
(Just (TrackedChange ChangeType
Insertion ChangeInfo
_), TrackChanges
AcceptChanges) ->
DocxContext m Blocks
handleInsertion
(Just (TrackedChange ChangeType
Insertion ChangeInfo
_), TrackChanges
RejectChanges) -> do
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara = ils''}
Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
(Just (TrackedChange ChangeType
Insertion (ChangeInfo Text
_ Text
cAuthor Maybe Text
cDate))
, TrackChanges
AllChanges) -> do
let attr :: Attr
attr = (Text
"", [Text
"paragraph-insertion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
cAuthor Maybe Text
cDate)
insertMark :: Inlines
insertMark = Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
return $ transform $
paraOrPlain $ ils'' <> insertMark
(Just (TrackedChange ChangeType
Deletion ChangeInfo
_), TrackChanges
AcceptChanges) -> do
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara = ils''}
Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
(Just (TrackedChange ChangeType
Deletion ChangeInfo
_), TrackChanges
RejectChanges) ->
DocxContext m Blocks
handleInsertion
(Just (TrackedChange ChangeType
Deletion (ChangeInfo Text
_ Text
cAuthor Maybe Text
cDate))
, TrackChanges
AllChanges) -> do
let attr :: Attr
attr = (Text
"", [Text
"paragraph-deletion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
cAuthor Maybe Text
cDate)
insertMark :: Inlines
insertMark = Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
return $ transform $
paraOrPlain $ ils'' <> insertMark
(Maybe TrackedChange, TrackChanges)
_ -> DocxContext m Blocks
handleInsertion
bodyPartToBlocks (ListItem ParagraphStyle
pPr Text
numId Text
lvl (Just Level
levelInfo) [ParPart]
parparts) = do
listState <- (DState -> Map (Text, Text) Integer)
-> ReaderT DEnv (StateT DState m) (Map (Text, Text) Integer)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map (Text, Text) Integer
docxListState
let startFromState = (Text, Text) -> Map (Text, Text) Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
numId, Text
lvl) Map (Text, Text) Integer
listState
Level _ fmt txt startFromLevelInfo = levelInfo
start = case Maybe Integer
startFromState of
Just Integer
n -> Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
Maybe Integer
Nothing -> Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
1 Maybe Integer
startFromLevelInfo
kvs = [ (Text
"level", Text
lvl)
, (Text
"num-id", Text
numId)
, (Text
"format", Text
fmt)
, (Text
"text", Text
txt)
, (Text
"start", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
start)
]
modify $ \DState
st -> DState
st{ docxListState =
let notExpired (a
_, Text
lvl') p
_ = Text
lvl' Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
<= Text
lvl
in M.insert (numId, lvl) start (M.filterWithKey notExpired listState) }
blks <- bodyPartToBlocks (Paragraph pPr parparts)
return $ divWith ("", ["list-item"], kvs) blks
bodyPartToBlocks (ListItem ParagraphStyle
pPr Text
_ Text
_ Maybe Level
_ [ParPart]
parparts) =
let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr {pStyle = constructBogusParStyleData "list-paragraph": pStyle pPr}
in
BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (BodyPart -> DocxContext m Blocks)
-> BodyPart -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts
bodyPartToBlocks (Captioned ParagraphStyle
parstyle [ParPart]
parparts BodyPart
bpart) = do
bs <- BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks BodyPart
bpart
captContents <- bodyPartToBlocks (Paragraph parstyle parparts)
let capt = Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
captContents)
case toList bs of
[Table Attr
attr Caption
_cap [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot]
-> Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
capt [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot
[Figure Attr
attr Caption
_cap [Block]
blks]
-> Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
capt [Block]
blks
[Para im :: [Inline]
im@[Image{}]]
-> Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
Figure Attr
nullAttr Caption
capt [[Inline] -> Block
Plain [Inline]
im]
[Block]
_ -> Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
captContents
bodyPartToBlocks (Tbl Maybe Text
_ Text
_ TblGrid
_ TblLook
_ []) =
Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
bodyPartToBlocks (Tbl Maybe Text
mbsty Text
cap TblGrid
grid TblLook
look [Row]
parts) = do
let fullCaption :: Blocks
fullCaption = if Text -> Bool
T.null Text
cap then Blocks
forall a. Monoid a => a
mempty else Inlines -> Blocks
plain (Text -> Inlines
text Text
cap)
let shortCaption :: Maybe [Inline]
shortCaption = if Text -> Bool
T.null Text
cap then Maybe [Inline]
forall a. Maybe a
Nothing else [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just (Inlines -> [Inline]
forall a. Many a -> [a]
toList (Text -> Inlines
text Text
cap))
cap' :: Caption
cap' = Maybe [Inline] -> Blocks -> Caption
caption Maybe [Inline]
shortCaption Blocks
fullCaption
([Row]
hdr, [Row]
rows) = Bool -> [Row] -> ([Row], [Row])
splitHeaderRows (TblLook -> Bool
firstRowFormatting TblLook
look) [Row]
parts
let rowHeadCols :: Int
rowHeadCols = if TblLook -> Bool
firstColumnFormatting TblLook
look then Int
1 else Int
0
let width :: Int
width = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ (Row -> Int) -> [Row] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Int
rowLength [Row]
parts
rowLength :: Docx.Row -> Int
rowLength :: Row -> Int
rowLength (Docx.Row TblHeader
_ [Cell]
c) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Docx.Cell Align
_ Integer
gridSpan VMerge
_ [BodyPart]
_) -> Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
gridSpan) [Cell]
c)
headerCells <- [Row] -> DocxContext m [Row]
forall (m :: * -> *). PandocMonad m => [Row] -> DocxContext m [Row]
rowsToRows [Row]
hdr
bodyCells <- rowsToRows rows
let getAlignment (Docx.Cell Align
al Integer
colspan VMerge
_ [BodyPart]
_) = Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
colspan)
(Alignment -> [Alignment]) -> Alignment -> [Alignment]
forall a b. (a -> b) -> a -> b
$ Align -> Alignment
convertAlign Align
al
alignments = case [Row]
rows of
[] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
width Alignment
Pandoc.AlignDefault
Docx.Row TblHeader
_ [Cell]
cs : [Row]
_ -> (Cell -> [Alignment]) -> [Cell] -> [Alignment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cell -> [Alignment]
getAlignment [Cell]
cs
totalWidth = TblGrid -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum TblGrid
grid
widths = (\Integer
w -> Double -> ColWidth
ColWidth (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
totalWidth)) (Integer -> ColWidth) -> TblGrid -> [ColWidth]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TblGrid
grid
extStylesEnabled <- asks (isEnabled Ext_styles . docxOptions)
let attr = case Maybe Text
mbsty of
Just Text
sty | Bool
extStylesEnabled -> (Text
"", [], [(Text
"custom-style", Text
sty)])
Maybe Text
_ -> Attr
nullAttr
return $ tableWith attr cap'
(zip alignments widths)
(TableHead nullAttr headerCells)
[TableBody nullAttr (RowHeadColumns rowHeadCols) [] bodyCells]
(TableFoot nullAttr [])
bodyPartToBlocks BodyPart
HRule = Blocks -> DocxContext m Blocks
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
Pandoc.horizontalRule
rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline
rewriteLink' :: forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m Inline
rewriteLink' l :: Inline
l@(Link Attr
attr [Inline]
ils (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#',Text
target), Text
title)) = do
anchorMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
case M.lookup target anchorMap of
Just Text
newTarget -> do
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{docxAnchorSet = Set.insert newTarget (docxAnchorSet s)}
Inline -> ReaderT DEnv (StateT DState m) Inline
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> ReaderT DEnv (StateT DState m) Inline)
-> Inline -> ReaderT DEnv (StateT DState m) Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
ils (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTarget, Text
title)
Maybe Text
Nothing -> do
(DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{docxAnchorSet = Set.insert target (docxAnchorSet s)}
Inline -> ReaderT DEnv (StateT DState m) Inline
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
l
rewriteLink' Inline
il = Inline -> ReaderT DEnv (StateT DState m) Inline
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
il
rewriteLinks :: PandocMonad m => [Block] -> DocxContext m [Block]
rewriteLinks :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
rewriteLinks = (Block -> ReaderT DEnv (StateT DState m) Block)
-> [Block] -> ReaderT DEnv (StateT DState m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Inline -> ReaderT DEnv (StateT DState m) Inline)
-> Block -> ReaderT DEnv (StateT DState m) Block
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Block -> m Block
walkM Inline -> ReaderT DEnv (StateT DState m) Inline
forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m Inline
rewriteLink')
removeOrphanAnchors'' :: PandocMonad m => Inline -> DocxContext m [Inline]
removeOrphanAnchors'' :: forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m [Inline]
removeOrphanAnchors'' s :: Inline
s@(Span (Text
ident, [Text]
classes, [(Text, Text)]
_) [Inline]
ils)
| Text
"anchor" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
anchorSet <- (DState -> Set Text) -> ReaderT DEnv (StateT DState m) (Set Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Set Text
docxAnchorSet
return $ if ident `Set.member` anchorSet
then [s]
else ils
removeOrphanAnchors'' Inline
il = [Inline] -> ReaderT DEnv (StateT DState m) [Inline]
forall a. a -> ReaderT DEnv (StateT DState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline
il]
removeOrphanAnchors' :: PandocMonad m => [Inline] -> DocxContext m [Inline]
removeOrphanAnchors' :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> DocxContext m [Inline]
removeOrphanAnchors' [Inline]
ils = ([[Inline]] -> [Inline])
-> ReaderT DEnv (StateT DState m) [[Inline]]
-> ReaderT DEnv (StateT DState m) [Inline]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT DEnv (StateT DState m) [[Inline]]
-> ReaderT DEnv (StateT DState m) [Inline])
-> ReaderT DEnv (StateT DState m) [[Inline]]
-> ReaderT DEnv (StateT DState m) [Inline]
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT DEnv (StateT DState m) [Inline])
-> [Inline] -> ReaderT DEnv (StateT DState m) [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> ReaderT DEnv (StateT DState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m [Inline]
removeOrphanAnchors'' [Inline]
ils
removeOrphanAnchors :: PandocMonad m => [Block] -> DocxContext m [Block]
removeOrphanAnchors :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
removeOrphanAnchors = (Block -> ReaderT DEnv (StateT DState m) Block)
-> [Block] -> ReaderT DEnv (StateT DState m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Inline] -> ReaderT DEnv (StateT DState m) [Inline])
-> Block -> ReaderT DEnv (StateT DState m) Block
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
([Inline] -> m [Inline]) -> Block -> m Block
walkM [Inline] -> ReaderT DEnv (StateT DState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> DocxContext m [Inline]
removeOrphanAnchors')
bodyToOutput :: PandocMonad m => Body -> DocxContext m (Meta, [Block])
bodyToOutput :: forall (m :: * -> *).
PandocMonad m =>
Body -> DocxContext m (Meta, [Block])
bodyToOutput (Body [BodyPart]
bps) = do
let ([BodyPart]
metabps, [BodyPart]
blkbps) = [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts [BodyPart]
bps
meta <- [BodyPart] -> DocxContext m Meta
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m Meta
bodyPartsToMeta [BodyPart]
metabps
let isNumberedPara (Paragraph ParagraphStyle
pPr [ParPart]
_) = ParagraphStyle -> Bool
numbered ParagraphStyle
pPr
isNumberedPara BodyPart
_ = Bool
False
modify (\DState
s -> DState
s { docxNumberedHeadings = any isNumberedPara blkbps })
blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps
blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks
blks'' <- removeOrphanAnchors blks'
refs <- gets (map referenceToMetaValue . M.elems . docxReferences)
let meta' = if [MetaValue] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MetaValue]
refs
then Meta
meta
else Text -> [MetaValue] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"references" [MetaValue]
refs Meta
meta
return (meta', blks'')
docxToOutput :: PandocMonad m
=> ReaderOptions
-> Docx
-> m (Meta, [Block])
docxToOutput :: forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Docx -> m (Meta, [Block])
docxToOutput ReaderOptions
opts (Docx (Document Map Text Text
_ Body
body)) =
let dEnv :: DEnv
dEnv = DEnv
forall a. Default a => a
def { docxOptions = opts} in
DocxContext m (Meta, [Block])
-> DEnv -> DState -> m (Meta, [Block])
forall (m :: * -> *) a.
PandocMonad m =>
DocxContext m a -> DEnv -> DState -> m a
evalDocxContext (Body -> DocxContext m (Meta, [Block])
forall (m :: * -> *).
PandocMonad m =>
Body -> DocxContext m (Meta, [Block])
bodyToOutput Body
body) DEnv
dEnv DState
forall a. Default a => a
def
addAuthorAndDate :: T.Text -> Maybe T.Text -> [(T.Text, T.Text)]
addAuthorAndDate :: Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
mdate =
(Text
"author", Text
author) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
date -> [(Text
"date", Text
date)]) Maybe Text
mdate
convertAlign :: Docx.Align -> Pandoc.Alignment
convertAlign :: Align -> Alignment
convertAlign Align
al = case Align
al of
Align
Docx.AlignDefault -> Alignment
Pandoc.AlignDefault
Align
Docx.AlignLeft -> Alignment
Pandoc.AlignLeft
Align
Docx.AlignCenter -> Alignment
Pandoc.AlignCenter
Align
Docx.AlignRight -> Alignment
Pandoc.AlignRight