{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Readers.Docx
   Copyright   : Copyright (C) 2014-2020 Jesse Rosenthal
   License     : GNU GPL, version 2 or above

   Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
   Stability   : alpha
   Portability : portable

Conversion of Docx type (defined in Text.Pandoc.Readers.Docx.Parse)
to 'Pandoc' document.  -}

{-
Current state of implementation of Docx entities ([x] means
implemented, [-] means partially implemented):

* Blocks

  - [X] Para
  - [X] CodeBlock (styled with `SourceCode`)
  - [X] BlockQuote (styled with `Quote`, `BlockQuote`, `Intense Quote` or, optionally,
        indented)
  - [X] OrderedList
  - [X] BulletList
  - [X] DefinitionList (styled with adjacent `DefinitionTerm` and `Definition`)
  - [X] Header (styled with `Heading#`)
  - [ ] HorizontalRule
  - [-] Table (column widths and alignments not yet implemented)

* Inlines

  - [X] Str
  - [X] Emph
  - [X] Strong
  - [X] Strikeout
  - [X] Superscript
  - [X] Subscript
  - [X] SmallCaps
  - [-] Underline (was previously converted to Emph)
  - [ ] Quoted
  - [ ] Cite
  - [X] Code (styled with `VerbatimChar`)
  - [X] Space
  - [X] LineBreak (these are invisible in Word: entered with Shift-Return)
  - [X] Math
  - [X] Link (links to an arbitrary bookmark create a span with the target as
        id and "anchor" class)
  - [X] Image
  - [X] Note (Footnotes and Endnotes are silently combined.)
-}

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 (catMaybes, 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)
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)
import Text.Pandoc.Sources (toSources)

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
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogMessage
DocxParserWarning) [Text]
parserWarnings
          (Meta
meta, [Block]
blks) <- forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Docx -> m (Meta, [Block])
docxToOutput ReaderOptions
opts Docx
docx
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks
        Left DocxError
docxerr -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError forall a b. (a -> b) -> a -> b
$
                         Text
"couldn't parse docx file: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show DocxError
docxerr)
    Left String
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError forall a b. (a -> b) -> a -> b
$
                  Text
"couldn't unpack docx container: " 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
                     -- keep track of (numId, lvl) values for
                     -- restarting
                     , DState -> Map (Text, Text) Integer
docxListState :: M.Map (T.Text, T.Text) Integer
                     , DState -> Inlines
docxPrevPara  :: Inlines
                     , DState -> [Blocks]
docxTableCaptions :: [Blocks]
                     , DState -> Map ItemId (Reference Inlines)
docxReferences :: M.Map ItemId (Reference Inlines)
                     }

instance Default DState where
  def :: DState
def = DState { docxAnchorMap :: Map Text Text
docxAnchorMap = forall k a. Map k a
M.empty
               , docxAnchorSet :: Set Text
docxAnchorSet = forall a. Monoid a => a
mempty
               , docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = forall a. Maybe a
Nothing
               , docxMediaBag :: MediaBag
docxMediaBag  = forall a. Monoid a => a
mempty
               , docxNumberedHeadings :: Bool
docxNumberedHeadings = Bool
False
               , docxDropCap :: Inlines
docxDropCap   = forall a. Monoid a => a
mempty
               , docxListState :: Map (Text, Text) Integer
docxListState = forall k a. Map k a
M.empty
               , docxPrevPara :: Inlines
docxPrevPara  = forall a. Monoid a => a
mempty
               , docxTableCaptions :: [Blocks]
docxTableCaptions = []
               , docxReferences :: Map ItemId (Reference Inlines)
docxReferences = forall a. Monoid a => a
mempty
               }

data DEnv = DEnv { DEnv -> ReaderOptions
docxOptions       :: ReaderOptions
                 , DEnv -> Bool
docxInHeaderBlock :: Bool
                 , DEnv -> Bool
docxInBidi        :: Bool
                 }

instance Default DEnv where
  def :: DEnv
def = ReaderOptions -> Bool -> Bool -> DEnv
DEnv 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT DState
st forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DocxContext m a
ctx DEnv
env

-- This is empty, but we put it in for future-proofing.
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 = 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 = 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
intersect (forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) (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) =
  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)) = 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 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' [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty
bodyPartsToMeta' (BodyPart
bp : [BodyPart]
bps)
  | (Paragraph ParagraphStyle
pPr [ParPart]
parParts) <- BodyPart
bp
  , (ParaStyleName
c : [ParaStyleName]
_)<- forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) forall a. Eq a => [a] -> [a] -> [a]
`intersect` forall k a. Map k a -> [k]
M.keys Map ParaStyleName Text
metaStyles
  , (Just Text
metaField) <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ParaStyleName
c Map ParaStyleName Text
metaStyles = do
    Inlines
inlines <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parParts
    Map Text MetaValue
remaining <- forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
    let
      f :: MetaValue -> MetaValue -> MetaValue
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 forall a. a -> [a] -> [a]
: [Block]
blks)
      f MetaValue
m (MetaList [MetaValue]
mv) = [MetaValue] -> MetaValue
MetaList (MetaValue
m forall a. a -> [a] -> [a]
: [MetaValue]
mv)
      f MetaValue
m MetaValue
n             = [MetaValue] -> MetaValue
MetaList [MetaValue
m, MetaValue
n]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith MetaValue -> MetaValue -> MetaValue
f Text
metaField ([Inline] -> MetaValue
MetaInlines (forall a. Many a -> [a]
toList Inlines
inlines)) Map Text MetaValue
remaining
bodyPartsToMeta' (BodyPart
_ : [BodyPart]
bps) = 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
  Map Text MetaValue
mp <- forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
  let mp' :: Map Text MetaValue
mp' =
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"author" Map Text MetaValue
mp of
          Just MetaValue
mv -> 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> Meta
Meta Map Text MetaValue
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
  | forall a. HasStyleName a => a -> StyleName a
getStyleName s
sty forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StyleName s]
names = Bool
True
  | Just s
psty <- forall a. HasParentStyle a => a -> Maybe a
getParentStyle s
sty = 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [ParaStyleName]
ns) 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 :: [ParStyle]
pStyle = forall a. (a -> Bool) -> [a] -> [a]
filter (\ParStyle
psd -> forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
psd forall a. Eq a => a -> a -> Bool
/= ParaStyleName
sn) forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
ps}

isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle = forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [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 =
  forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [
    ParaStyleName
"Quote", ParaStyleName
"Block Text", ParaStyleName
"Block Quote", ParaStyleName
"Block Quotation", 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ParPart -> Text
parPartToText [ParPart]
children
parPartToText (ExternalHyperLink Text
_ [ParPart]
children) = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ 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
  , forall a. HasStyleName a => a -> StyleName a
getStyleName CharStyle
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CharStyleName]
blacklistedCharStyles = do
      ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles ReaderOptions
opts
        then forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
rPr
        else RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle RunStyle
rPr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle (CharStyle -> RunStyle
cStyleData CharStyle
s)
  | Bool
otherwise = 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
  ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  Bool
inBidi <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInBidi
  let styles :: Bool
styles = forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles ReaderOptions
opts
      ctl :: Bool
ctl = (forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== RunStyle -> Maybe Bool
isRTL RunStyle
rPr') Bool -> Bool -> Bool
|| (forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== RunStyle -> Maybe Bool
isForceCTL RunStyle
rPr')
      italic :: RunStyle -> Maybe Bool
italic RunStyle
rPr | Bool
ctl = RunStyle -> Maybe Bool
isItalicCTL RunStyle
rPr
                 | Bool
otherwise = RunStyle -> Maybe Bool
isItalic RunStyle
rPr
      bold :: RunStyle -> Maybe Bool
bold RunStyle
rPr | Bool
ctl = RunStyle -> Maybe Bool
isBoldCTL RunStyle
rPr
               | Bool
otherwise = RunStyle -> Maybe Bool
isBold RunStyle
rPr
      go :: RunStyle -> Inlines -> Inlines
go RunStyle
rPr
        | Just CharStyleName
sn <- forall a. HasStyleName a => a -> StyleName a
getStyleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr
        , CharStyleName
sn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CharStyleName]
spansToKeep =
            Attr -> Inlines -> Inlines
spanWith (Text
"", [forall a. FromStyleName a => a -> Text
normalizeToClassName CharStyleName
sn], [])
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rParentStyle :: Maybe CharStyle
rParentStyle = forall a. Maybe a
Nothing}
        | Bool
styles, Just CharStyle
s <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr =
             Attr -> Inlines -> Inlines
spanWith (forall a. (Eq (StyleName a), HasStyleName a) => a -> Attr
extraAttr CharStyle
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rParentStyle :: Maybe CharStyle
rParentStyle = forall a. Maybe a
Nothing}
        | Just Bool
True <- RunStyle -> Maybe Bool
italic RunStyle
rPr =
            Inlines -> Inlines
emph forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isItalic :: Maybe Bool
isItalic = forall a. Maybe a
Nothing, isItalicCTL :: Maybe Bool
isItalicCTL = forall a. Maybe a
Nothing}
        | Just Bool
True <- RunStyle -> Maybe Bool
bold RunStyle
rPr =
            Inlines -> Inlines
strong forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isBold :: Maybe Bool
isBold = forall a. Maybe a
Nothing, isBoldCTL :: Maybe Bool
isBoldCTL = forall a. Maybe a
Nothing}
        | Just Text
_ <- RunStyle -> Maybe Text
rHighlight RunStyle
rPr =
            Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"mark"],[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rHighlight :: Maybe Text
rHighlight = forall a. Maybe a
Nothing}
        | Just Bool
True <- RunStyle -> Maybe Bool
isSmallCaps RunStyle
rPr =
            Inlines -> Inlines
smallcaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isSmallCaps :: Maybe Bool
isSmallCaps = forall a. Maybe a
Nothing}
        | Just Bool
True <- RunStyle -> Maybe Bool
isStrike RunStyle
rPr =
            Inlines -> Inlines
strikeout forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isStrike :: Maybe Bool
isStrike = forall a. Maybe a
Nothing}
        | Just Bool
True <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr =
            Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"dir",Text
"rtl")]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isRTL :: Maybe Bool
isRTL = forall a. Maybe a
Nothing}
        | Bool
inBidi, Just Bool
False <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr =
            Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"dir",Text
"ltr")]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{isRTL :: Maybe Bool
isRTL = forall a. Maybe a
Nothing}
        | Just VertAlign
SupScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr =
            Inlines -> Inlines
superscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rVertAlign :: Maybe VertAlign
rVertAlign = forall a. Maybe a
Nothing}
        | Just VertAlign
SubScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr =
            Inlines -> Inlines
subscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rVertAlign :: Maybe VertAlign
rVertAlign = forall a. Maybe a
Nothing}
        | Just Text
"single" <- RunStyle -> Maybe Text
rUnderline RunStyle
rPr =
            Inlines -> Inlines
Pandoc.underline forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunStyle -> Inlines -> Inlines
go RunStyle
rPr{rUnderline :: Maybe Text
rUnderline = forall a. Maybe a
Nothing}
        | Bool
otherwise = forall a. a -> a
id
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RunStyle -> Inlines -> Inlines
go RunStyle
rPr'


runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
runToInlines :: forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines (Run RunStyle
rs [RunElem]
runElems)
  | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False CharStyle -> Bool
isCodeCharStyle forall a b. (a -> b) -> a -> b
$ RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rs = do
      RunStyle
rPr <- forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
      let codeString :: Inlines
codeString = Text -> Inlines
code forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Text
runElemToText [RunElem]
runElems
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case RunStyle -> Maybe VertAlign
rVertAlign RunStyle
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
      RunStyle
rPr <- forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
      let ils :: Inlines
ils = [Inlines] -> Inlines
smushInlines (forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Inlines
runElemToInlines [RunElem]
runElems)
      Inlines -> Inlines
transform <- forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
transform Inlines
ils
runToInlines (Footnote [BodyPart]
bps) = Blocks -> Inlines
note forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
smushBlocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
runToInlines (Endnote [BodyPart]
bps) = Blocks -> Inlines
note forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
smushBlocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
runToInlines (InlineDrawing String
fp Text
title Text
alt ByteString
bs Extent
ext) = do
  (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp forall a. Maybe a
Nothing ByteString
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
runToInlines Run
InlineChart = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"chart"], []) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[CHART]"
runToInlines Run
InlineDiagram = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"diagram"], []) 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", forall {a}. (Show a, Fractional a) => a -> Text
showDim Double
w), (Text
"height", forall {a}. (Show a, Fractional a) => a -> Text
showDim Double
h)] )
  where
    showDim :: a -> Text
showDim a
d = forall a. Show a => a -> Text
tshow (a
d forall a. Fractional a => a -> a -> a
/ a
914400) 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
paraOrPlain Blocks
blks) forall a b. (a -> b) -> a -> b
$
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
DocxParserWarning forall a b. (a -> b) -> a -> b
$
      Text
"Docx comment " forall a. Semigroup a => a -> a -> a
<> Text
cmtId forall a. Semigroup a => a -> a -> a
<> Text
" will not retain formatting"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Block] -> Inlines
blocksToInlines' (forall a. Many a -> [a]
toList Blocks
blks)

-- The majority of work in this function is done in the primed
-- subfunction `partPartToInlines'`. We make this wrapper so that we
-- don't have to modify `docxImmedPrevAnchor` state after every function.
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dummyAnchors -> do
      Bool
inHdrBool <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
      Inlines
ils <- forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' ParPart
parPart
      Maybe Text
immedPrevAnchor <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Maybe Text
docxImmedPrevAnchor
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Maybe a -> Bool
isJust Maybe Text
immedPrevAnchor Bool -> Bool -> Bool
|| Bool
inHdrBool)
        (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{ docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = forall a. a -> Maybe a
Just Text
anchor})
      forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils
    ParPart
_ -> do
      Inlines
ils <- forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' ParPart
parPart
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{ docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = forall a. Maybe a
Nothing}
      forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils

parPartToInlines' :: PandocMonad m => ParPart -> DocxContext m Inlines
parPartToInlines' :: forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' (PlainRun Run
r) = forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines Run
r
parPartToInlines' (ChangedRuns (TrackedChange ChangeType
Insertion (ChangeInfo Text
_ Text
author Maybe Text
date)) [Run]
runs) = do
  ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    TrackChanges
AcceptChanges -> [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
    TrackChanges
RejectChanges -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    TrackChanges
AllChanges    -> do
      Inlines
ils <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
      let attr :: Attr
attr = (Text
"", [Text
"insertion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
parPartToInlines' (ChangedRuns (TrackedChange ChangeType
Deletion (ChangeInfo Text
_ Text
author Maybe Text
date)) [Run]
runs) = do
  ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    TrackChanges
AcceptChanges -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    TrackChanges
RejectChanges -> [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
    TrackChanges
AllChanges    -> do
      Inlines
ils <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
      let attr :: Attr
attr = (Text
"", [Text
"deletion"], Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
parPartToInlines' (CommentStart Text
cmtId Text
author Maybe Text
date [BodyPart]
bodyParts) = do
  ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    TrackChanges
AllChanges -> do
      Blocks
blks <- [Blocks] -> Blocks
smushBlocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bodyParts
      Inlines
ils <- forall (m :: * -> *).
PandocMonad m =>
Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn Text
cmtId Blocks
blks
      let attr :: Attr
attr = (Text
"", [Text
"comment-start"], (Text
"id", Text
cmtId) forall a. a -> [a] -> [a]
: Text -> Maybe Text -> [(Text, Text)]
addAuthorAndDate Text
author Maybe Text
date)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
    TrackChanges
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
parPartToInlines' (CommentEnd Text
cmtId) = do
  ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    TrackChanges
AllChanges -> do
      let attr :: Attr
attr = (Text
"", [Text
"comment-end"], [(Text
"id", Text
cmtId)])
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr forall a. Monoid a => a
mempty
    TrackChanges
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
parPartToInlines' (BookMark Text
_ Text
anchor) | Text
anchor forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dummyAnchors =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
parPartToInlines' (BookMark Text
_ Text
anchor) =
  -- We record these, so we can make sure not to overwrite
  -- user-defined anchor links with header auto ids.
  do
    -- get whether we're in a header.
    Bool
inHdrBool <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
    -- Get the anchor map.
    Map Text Text
anchorMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    -- We don't want to rewrite if we're in a header, since we'll take
    -- care of that later, when we make the header anchor. If the
    -- bookmark were already in uniqueIdent form, this would lead to a
    -- duplication. Otherwise, we check to see if the id is already in
    -- there. Rewrite if necessary. This will have the possible effect
    -- of rewriting user-defined anchor links. However, since these
    -- are not defined in pandoc, it seems like a necessary evil to
    -- avoid an extra pass.
    Maybe Text
immedPrevAnchor <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Maybe Text
docxImmedPrevAnchor
    case Maybe Text
immedPrevAnchor of
      Just Text
prevAnchor -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inHdrBool
          (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s { docxAnchorMap :: Map Text Text
docxAnchorMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor Text
prevAnchor Map Text Text
anchorMap})
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      Maybe Text
Nothing -> do
        Extensions
exts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ReaderOptions -> Extensions
readerExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
        let newAnchor :: Text
newAnchor =
              if Bool -> Bool
not Bool
inHdrBool Bool -> Bool -> Bool
&& Text
anchor forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` 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]
                     (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Text Text
anchorMap)
              else Text
anchor
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inHdrBool
          (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s { docxAnchorMap :: Map Text Text
docxAnchorMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor Text
newAnchor Map Text Text
anchorMap})
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
newAnchor, [Text
"anchor"], []) forall a. Monoid a => a
mempty
parPartToInlines' (Drawing String
fp Text
title Text
alt ByteString
bs Extent
ext) = do
  (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp forall a. Maybe a
Nothing ByteString
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
parPartToInlines' ParPart
Chart =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"chart"], []) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[CHART]"
parPartToInlines' ParPart
Diagram =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
"", [Text
"diagram"], []) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"[DIAGRAM]"
parPartToInlines' (InternalHyperLink Text
anchor [ParPart]
children) = do
  Inlines
ils <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
anchor) Text
"" Inlines
ils
parPartToInlines' (ExternalHyperLink Text
target [ParPart]
children) = do
  Inlines
ils <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
target Text
"" Inlines
ils
parPartToInlines' (PlainOMath [Exp]
exps) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
math forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeTeX [Exp]
exps
parPartToInlines' (OMathPara [Exp]
exps) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
displayMath 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 -> forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' forall a b. (a -> b) -> a -> b
$ Text -> [ParPart] -> ParPart
ExternalHyperLink Text
url [ParPart]
children
    PagerefField Text
fieldAnchor Bool
True -> forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' forall a b. (a -> b) -> a -> b
$ Text -> [ParPart] -> ParPart
InternalHyperLink Text
fieldAnchor [ParPart]
children
    EndNoteCite Text
t -> do
      Inlines
formattedCite <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
      ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations ReaderOptions
opts
         then do
           Citation Text
citation <- forall (m :: * -> *). PandocMonad m => Sources -> m (Citation Text)
readEndNoteXMLCitation (forall a. ToSources a => a -> Sources
toSources Text
t)
           [Citation]
cs <- forall (m :: * -> *).
PandocMonad m =>
Citation Text -> DocxContext m [Citation]
handleCitation Citation Text
citation
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite [Citation]
cs Inlines
formattedCite
         else forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
formattedCite
    CslCitation Text
t -> do
      Inlines
formattedCite <- [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
      ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations ReaderOptions
opts
         then do
           let bs :: ByteString
bs = Text -> ByteString
fromTextLazy forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
t
           case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs of
             Left String
_err -> forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
formattedCite
             Right Citation Text
citation -> do
               [Citation]
cs <- forall (m :: * -> *).
PandocMonad m =>
Citation Text -> DocxContext m [Citation]
handleCitation Citation Text
citation
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite [Citation]
cs Inlines
formattedCite
         else forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
formattedCite
    FieldInfo
CslBibliography -> do
      ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations ReaderOptions
opts
         then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty -- omit Zotero-generated bibliography
         else [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
    FieldInfo
EndNoteRefList -> do
      ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations ReaderOptions
opts
         then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty -- omit EndNote-generated bibliography
         else [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children
    FieldInfo
_ -> [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' [ParPart]
children

-- Turn a 'Citeproc.Citation' into a list of 'Text.Pandoc.Definition.Citation',
-- and store the embedded bibliographic data in state.
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 (forall a. CitationItem a -> ItemId
Citeproc.citationItemId CitationItem Text
item)
                , citationPrefix :: [Inline]
citationPrefix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. Many a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text) forall a b. (a -> b) -> a -> b
$
                                     forall a. CitationItem a -> Maybe a
Citeproc.citationItemPrefix CitationItem Text
item
                , citationSuffix :: [Inline]
citationSuffix = (forall a. Many a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text) forall a b. (a -> b) -> a -> b
$
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Text
x -> Text
", " forall a. Semigroup a => a -> a -> a
<>
                       forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. Semigroup a => a -> a -> a
<>Text
" ") (forall a. CitationItem a -> Maybe Text
Citeproc.citationItemLabel CitationItem Text
item)
                         forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
" ")
                     (forall a. CitationItem a -> Maybe Text
Citeproc.citationItemLocator CitationItem Text
item)
                    forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (forall a. CitationItem a -> Maybe a
Citeproc.citationItemSuffix CitationItem Text
item)
                , citationMode :: CitationMode
citationMode = CitationMode
NormalCitation -- TODO for now
                , citationNoteNum :: Int
citationNoteNum = Int
0
                , citationHash :: Int
citationHash = Int
0 }
  let items :: [CitationItem Text]
items = forall a. Citation a -> [CitationItem a]
Citeproc.citationItems Citation Text
citation
  let cs :: [Citation]
cs = forall a b. (a -> b) -> [a] -> [b]
map CitationItem Text -> Citation
toPandocCitation [CitationItem Text]
items
  [Reference Inlines]
refs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text)) forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. CitationItem a -> Maybe (Reference a)
Citeproc.citationItemData [CitationItem Text]
items
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
st ->
    DState
st{ docxReferences :: Map ItemId (Reference Inlines)
docxReferences = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Reference Inlines
ref -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. Reference a -> ItemId
referenceId Reference Inlines
ref) Reference Inlines
ref)
          (DState -> Map ItemId (Reference Inlines)
docxReferences DState
st)
          [Reference Inlines]
refs }
  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
makeHeaderAnchor :: forall (m :: * -> *).
PandocMonad m =>
Blocks -> DocxContext m Blocks
makeHeaderAnchor Blocks
bs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' Blocks
bs

makeHeaderAnchor' :: PandocMonad m => Block -> DocxContext m Block
-- If there is an anchor already there (an anchor span in the header,
-- to be exact), we rename and associate the new id with the old one.
makeHeaderAnchor' :: forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' (Header Int
n (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils)
  | (Inline
c:[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
    Map Text Text
hdrIDMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    Extensions
exts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ReaderOptions -> Extensions
readerExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
    let newIdent :: Text
newIdent = if Text -> Bool
T.null Text
ident
                   then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
ils (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
                   else Text
ident
        newIls :: [Inline]
newIls = 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 forall a. Eq a => a -> a -> Bool
== Inline
c   = [Inline]
cIls
                                            | Bool
otherwise = [Inline
il]
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxAnchorMap :: Map Text Text
docxAnchorMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchIdent Text
newIdent Map Text Text
hdrIDMap}
    forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
newIdent, [Text]
classes, [(Text, Text)]
kvs) [Inline]
newIls
-- Otherwise we just give it a name, and register that name (associate
-- it with itself.)
makeHeaderAnchor' (Header Int
n (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils) =
  do
    Map Text Text
hdrIDMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    Extensions
exts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ReaderOptions -> Extensions
readerExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
    let newIdent :: Text
newIdent = if Text -> Bool
T.null Text
ident
                   then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
ils (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
                   else Text
ident
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxAnchorMap :: Map Text Text
docxAnchorMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
newIdent Text
newIdent Map Text Text
hdrIDMap}
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
newIdent, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils
makeHeaderAnchor' Block
blk = forall (m :: * -> *) a. Monad m => a -> m a
return Block
blk

-- Rewrite a standalone paragraph block as a plain
singleParaToPlain :: Blocks -> Blocks
singleParaToPlain :: Blocks -> Blocks
singleParaToPlain Blocks
blks
  | (Para [Inline]
ils :< Seq Block
seeq) <- forall a. Seq a -> ViewL a
viewl forall a b. (a -> b) -> a -> b
$ forall a. Many a -> Seq a
unMany Blocks
blks
  , forall a. Seq a -> Bool
Seq.null Seq Block
seeq =
      forall a. a -> Many a
singleton 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 Integer
gridSpan VMerge
_ [BodyPart]
bps) = do
  Blocks
blks <- [Blocks] -> Blocks
smushBlocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
  let blks' :: Blocks
blks' = Blocks -> Blocks
singleParaToPlain forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
fromList forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToDefinitions forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToBullets forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
toList Blocks
blks
  forall (m :: * -> *) a. Monad m => a -> m a
return (Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell Alignment
AlignDefault RowSpan
rowSpan (Int -> ColSpan
ColSpan (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
gridSpan)) Blocks
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 = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (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)
  [[Cell]]
cells <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
PandocMonad m =>
RowSpan -> Cell -> DocxContext m Cell
cellToCell)) [[(RowSpan, Cell)]]
rowspans
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> [Cell] -> Row
Pandoc.Row Attr
nullAttr) [[Cell]]
cells)

splitHeaderRows :: Bool -> [Docx.Row] -> ([Docx.Row], [Docx.Row])
splitHeaderRows :: Bool -> [Row] -> ([Row], [Row])
splitHeaderRows Bool
hasFirstRowFormatting [Row]
rs = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. [a] -> [a]
reverse forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst
  forall a b. (a -> b) -> a -> b
$ if Bool
hasFirstRowFormatting
    then forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([Row], [Row]), Bool) -> Row -> (([Row], [Row]), Bool)
f ((forall a. Int -> [a] -> [a]
take Int
1 [Row]
rs, []), Bool
True) (forall a. Int -> [a] -> [a]
drop Int
1 [Row]
rs)
    else 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 forall a. Eq a => a -> a -> Bool
== TblHeader
HasTblHeader Bool -> Bool -> Bool
|| (Bool
previousRowWasHeader Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Cell -> Bool
isContinuationCell [Cell]
cs)
        = ((Row
r forall a. a -> [a] -> [a]
: [Row]
headerRows, [Row]
bodyRows), Bool
True)
      | Bool
otherwise
        = (([Row]
headerRows, Row
r forall a. a -> [a] -> [a]
: [Row]
bodyRows), Bool
False)

    isContinuationCell :: Cell -> Bool
isContinuationCell (Docx.Cell Integer
_ VMerge
vm [BodyPart]
_) = VMerge
vm forall a. Eq a => a -> a -> Bool
== VMerge
Docx.Continue


-- like trimInlines, but also take out linebreaks
trimSps :: Inlines -> Inlines
trimSps :: Inlines -> Inlines
trimSps (Many Seq Inline
ils) = forall a. Seq a -> Many a
Many forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL Inline -> Bool
isSp forall a b. (a -> b) -> a -> b
$ 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
extraAttr :: forall a. (Eq (StyleName a), HasStyleName a) => a -> Attr
extraAttr a
s = (Text
"", [], [(Text
"custom-style", forall a. FromStyleName a => a -> Text
fromStyleName forall a b. (a -> b) -> a -> b
$ 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 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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
listParagraphStyles) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyleName a => a -> StyleName a
getStyleName) (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr))
                  then Blocks -> Blocks
blockQuote
                  else forall a. a -> a
id
  in do
    Bool
extStylesEnabled <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. DEnv -> ReaderOptions
docxOptions)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ParStyle
parStyle Blocks -> Blocks
transform' ->
        (Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform Bool
extStylesEnabled ParStyle
parStyle) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform'
      ) Blocks -> Blocks
transform (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr)

parStyleToTransform :: Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform :: Bool -> ParStyle -> Blocks -> Blocks
parStyleToTransform Bool
extStylesEnabled parStyle :: ParStyle
parStyle@(forall a. HasStyleName a => a -> StyleName a
getStyleName -> StyleName ParStyle
styleName)
  | (StyleName ParStyle
styleName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
divsToKeep) Bool -> Bool -> Bool
|| (StyleName ParStyle
styleName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
listParagraphStyles) =
      Attr -> Blocks -> Blocks
divWith (Text
"", [forall a. FromStyleName a => a -> Text
normalizeToClassName StyleName ParStyle
styleName], [])
  | Bool
otherwise =
      (if Bool
extStylesEnabled then Attr -> Blocks -> Blocks
divWith (forall a. (Eq (StyleName a), HasStyleName a) => a -> Attr
extraAttr ParStyle
parStyle) else forall a. a -> a
id)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if ParStyle -> Bool
isBlockQuote ParStyle
parStyle then Blocks -> Blocks
blockQuote else forall a. a -> a
id)

-- The relative indent is the indentation minus the indentation of the parent style.
-- This tells us whether this paragraph in particular was indented more and thus
-- should be considered a block quote.
relativeIndent :: ParagraphStyle -> Integer
relativeIndent :: ParagraphStyle -> Integer
relativeIndent ParagraphStyle
pPr =
  let pStyleLeft :: Integer
pStyleLeft = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
pStyleIndentation ParagraphStyle
pPr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
leftParIndent
      pStyleHang :: Integer
pStyleHang = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
pStyleIndentation ParagraphStyle
pPr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
hangingParIndent
      left :: Integer
left = forall a. a -> Maybe a -> a
fromMaybe Integer
pStyleLeft forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
leftParIndent
      hang :: Integer
hang = forall a. a -> Maybe a -> a
fromMaybe Integer
pStyleHang forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
hangingParIndent
  in (Integer
left forall a. Num a => a -> a -> a
- Integer
hang) forall a. Num a => a -> a -> a
- (Integer
pStyleLeft 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromStyleName a => a -> Text
fromStyleName
  where go :: Char -> Char
go Char
c | Char -> Bool
isSpace Char
c = Char
'-'
             | Bool
otherwise = Char
c

bodyPartToTableCaption :: PandocMonad m => BodyPart -> DocxContext m (Maybe Blocks)
bodyPartToTableCaption :: forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m (Maybe Blocks)
bodyPartToTableCaption (TblCaption ParagraphStyle
pPr [ParPart]
parparts) =
  forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr [ParPart]
parparts)
bodyPartToTableCaption BodyPart
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks
bodyPartToBlocks :: forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (Paragraph ParagraphStyle
pPr [ParPart]
parparts)
  | Just Bool
True <- ParagraphStyle -> Maybe Bool
pBidi ParagraphStyle
pPr = do
      let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pBidi :: Maybe Bool
pBidi = forall a. Maybe a
Nothing }
      forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DEnv
s -> DEnv
s{ docxInBidi :: Bool
docxInBidi = Bool
True })
        (forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts))
  | ParagraphStyle -> Bool
isCodeDiv ParagraphStyle
pPr = do
      Blocks -> Blocks
transform <- forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        Blocks -> Blocks
transform forall a b. (a -> b) -> a -> b
$
        Text -> Blocks
codeBlock forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map ParPart -> Text
parPartToText [ParPart]
parparts
  | Just (ParaStyleName
style, Int
n) <- ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading ParagraphStyle
pPr = do
    Inlines
ils <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\DEnv
s-> DEnv
s{docxInHeaderBlock :: Bool
docxInHeaderBlock=Bool
True})
           ([Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts)
    let classes :: [Text]
classes = forall a b. (a -> b) -> [a] -> [b]
map forall a. FromStyleName a => a -> Text
normalizeToClassName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [a]
delete ParaStyleName
style
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr)

    Bool
hasNumbering <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Bool
docxNumberedHeadings
    let addNum :: [Text] -> [Text]
addNum = if Bool
hasNumbering Bool -> Bool -> Bool
&& Bool -> Bool
not (ParagraphStyle -> Bool
numbered ParagraphStyle
pPr)
                 then (forall a. [a] -> [a] -> [a]
++ [Text
"unnumbered"])
                 else forall a. a -> a
id
    forall (m :: * -> *).
PandocMonad m =>
Blocks -> DocxContext m Blocks
makeHeaderAnchor forall a b. (a -> b) -> a -> b
$
      Attr -> Int -> Inlines -> Blocks
headerWith (Text
"", [Text] -> [Text]
addNum [Text]
classes, []) Int
n Inlines
ils
  | Bool
otherwise = do
    Inlines
ils <- Inlines -> Inlines
trimSps forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
smushInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts
    Inlines
prevParaIls <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Inlines
docxPrevPara
    Inlines
dropIls <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Inlines
docxDropCap
    let ils' :: Inlines
ils' = Inlines
dropIls forall a. Semigroup a => a -> a -> a
<> Inlines
ils
    let (Inlines -> Blocks
paraOrPlain, ParagraphStyle
pPr')
          | [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom [ParaStyleName
"Compact"] ParagraphStyle
pPr = (Inlines -> Blocks
plain, ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed ParaStyleName
"Compact" ParagraphStyle
pPr)
          | Bool
otherwise = (Inlines -> Blocks
para, ParagraphStyle
pPr)
    if ParagraphStyle -> Bool
dropCap ParagraphStyle
pPr'
      then do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s { docxDropCap :: Inlines
docxDropCap = Inlines
ils' }
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      else do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s { docxDropCap :: Inlines
docxDropCap = forall a. Monoid a => a
mempty }
              let ils'' :: Inlines
ils'' = (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
prevParaIls then forall a. Monoid a => a
mempty
                          else Inlines
prevParaIls forall a. Semigroup a => a -> a -> a
<> Inlines
space) forall a. Semigroup a => a -> a -> a
<> Inlines
ils'
                  handleInsertion :: DocxContext m Blocks
handleInsertion = do
                    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = forall a. Monoid a => a
mempty}
                    Blocks -> Blocks
transform <- forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
paraOrPlain Inlines
ils''
              ReaderOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
              case (ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr', ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts) of
                  (Maybe TrackedChange, TrackChanges)
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
ils'', Bool -> Bool
not (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs ReaderOptions
opts) ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return 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
                      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = Inlines
ils''}
                      forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Monoid a => a
mempty
                      Blocks -> Blocks
transform <- forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform forall a b. (a -> b) -> a -> b
$
                        Inlines -> Blocks
paraOrPlain forall a b. (a -> b) -> a -> b
$ Inlines
ils'' forall a. Semigroup a => a -> a -> a
<> Inlines
insertMark
                  (Just (TrackedChange ChangeType
Deletion ChangeInfo
_), TrackChanges
AcceptChanges) -> do
                      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = Inlines
ils''}
                      forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Monoid a => a
mempty
                      Blocks -> Blocks
transform <- forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
paragraphStyleToTransform ParagraphStyle
pPr'
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform forall a b. (a -> b) -> a -> b
$
                        Inlines -> Blocks
paraOrPlain forall a b. (a -> b) -> a -> b
$ Inlines
ils'' forall a. Semigroup a => a -> a -> a
<> Inlines
insertMark
                  (Maybe TrackedChange, TrackChanges)
_ -> DocxContext m Blocks
handleInsertion
bodyPartToBlocks (ListItem ParagraphStyle
pPr Text
numId Text
lvl (Just Level
levelInfo) [ParPart]
parparts) = do
  -- We check whether this current numId has previously been used,
  -- since Docx expects us to pick up where we left off.
  Map (Text, Text) Integer
listState <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map (Text, Text) Integer
docxListState
  let startFromState :: Maybe Integer
startFromState = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
numId, Text
lvl) Map (Text, Text) Integer
listState
      Level Text
_ Text
fmt Text
txt Maybe Integer
startFromLevelInfo = Level
levelInfo
      start :: Integer
start = case Maybe Integer
startFromState of
        Just Integer
n -> Integer
n forall a. Num a => a -> a -> a
+ Integer
1
        Maybe Integer
Nothing -> forall a. a -> Maybe a -> a
fromMaybe Integer
1 Maybe Integer
startFromLevelInfo
      kvs :: [(Text, Text)]
kvs = [ (Text
"level", Text
lvl)
            , (Text
"num-id", Text
numId)
            , (Text
"format", Text
fmt)
            , (Text
"text", Text
txt)
            , (Text
"start", forall a. Show a => a -> Text
tshow Integer
start)
            ]
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
st -> DState
st{ docxListState :: Map (Text, Text) Integer
docxListState =
    -- expire all the continuation data for lists of level > this one:
    -- a new level 1 list item resets continuation for level 2+
    let notExpired :: (a, Text) -> p -> Bool
notExpired (a
_, Text
lvl') p
_ = Text
lvl' forall a. Ord a => a -> a -> Bool
<= Text
lvl
    in forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
numId, Text
lvl) Integer
start (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey forall {a} {p}. (a, Text) -> p -> Bool
notExpired Map (Text, Text) Integer
listState) }
  Blocks
blks <- forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr [ParPart]
parparts)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"list-item"], [(Text, Text)]
kvs) Blocks
blks
bodyPartToBlocks (ListItem ParagraphStyle
pPr Text
_ Text
_ Maybe Level
_ [ParPart]
parparts) =
  let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr {pStyle :: [ParStyle]
pStyle = ParaStyleName -> ParStyle
constructBogusParStyleData ParaStyleName
"list-paragraph"forall a. a -> [a] -> [a]
: ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr}
  in
    forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts
bodyPartToBlocks (TblCaption ParagraphStyle
_ [ParPart]
_) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para forall a. Monoid a => a
mempty -- collected separately
bodyPartToBlocks (Tbl Text
_ TblGrid
_ TblLook
_ []) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para forall a. Monoid a => a
mempty
bodyPartToBlocks (Tbl Text
cap TblGrid
grid TblLook
look [Row]
parts) = do
  [Blocks]
captions <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> [Blocks]
docxTableCaptions
  Blocks
fullCaption <- case [Blocks]
captions of
    Blocks
c : [Blocks]
cs -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DState
s -> DState
s { docxTableCaptions :: [Blocks]
docxTableCaptions = [Blocks]
cs })
      forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
c
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
cap then 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 forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (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 width :: Int
width = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall a b. (a -> b) -> a -> b
$ 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) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Docx.Cell Integer
gridSpan VMerge
_ [BodyPart]
_) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
gridSpan) [Cell]
c)

  [Row]
headerCells <- forall (m :: * -> *). PandocMonad m => [Row] -> DocxContext m [Row]
rowsToRows [Row]
hdr
  [Row]
bodyCells <- forall (m :: * -> *). PandocMonad m => [Row] -> DocxContext m [Row]
rowsToRows [Row]
rows

      -- Horizontal column alignment goes to the default at the moment. Getting
      -- it might be difficult, since there doesn't seem to be a column entity
      -- in docx.
  let alignments :: [Alignment]
alignments = forall a. Int -> a -> [a]
replicate Int
width Alignment
AlignDefault
      totalWidth :: Integer
totalWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum TblGrid
grid
      widths :: [ColWidth]
widths = (\Integer
w -> Double -> ColWidth
ColWidth (forall a. Num a => Integer -> a
fromInteger Integer
w forall a. Fractional a => a -> a -> a
/ forall a. Num a => Integer -> a
fromInteger Integer
totalWidth)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TblGrid
grid

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table Caption
cap'
                 (forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
alignments [ColWidth]
widths)
                 (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr [Row]
headerCells)
                 [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] [Row]
bodyCells]
                 (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])

-- replace targets with generated anchors.
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
  Map Text Text
anchorMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
target Map Text Text
anchorMap of
    Just Text
newTarget -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{docxAnchorSet :: Set Text
docxAnchorSet = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
newTarget (DState -> Set Text
docxAnchorSet DState
s)}
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
ils (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
newTarget, Text
title)
    Maybe Text
Nothing        -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \DState
s -> DState
s{docxAnchorSet :: Set Text
docxAnchorSet = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
target (DState -> Set Text
docxAnchorSet DState
s)}
      forall (m :: * -> *) a. Monad m => a -> m a
return Inline
l
rewriteLink' Inline
il = 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM 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" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
      Set Text
anchorSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Set Text
docxAnchorSet
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text
ident forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
anchorSet
               then [Inline
s]
               else [Inline]
ils
removeOrphanAnchors'' Inline
il = 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM 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
meta <- forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m Meta
bodyPartsToMeta [BodyPart]
metabps
  [Blocks]
captions <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m (Maybe Blocks)
bodyPartToTableCaption [BodyPart]
blkbps
  let isNumberedPara :: BodyPart -> Bool
isNumberedPara (Paragraph ParagraphStyle
pPr [ParPart]
_) = ParagraphStyle -> Bool
numbered ParagraphStyle
pPr
      isNumberedPara BodyPart
_                 = Bool
False
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DState
s -> DState
s { docxNumberedHeadings :: Bool
docxNumberedHeadings = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BodyPart -> Bool
isNumberedPara [BodyPart]
blkbps })
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DState
s -> DState
s { docxTableCaptions :: [Blocks]
docxTableCaptions = [Blocks]
captions })
  Blocks
blks <- [Blocks] -> Blocks
smushBlocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
blkbps
  [Block]
blks' <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
rewriteLinks forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToDefinitions forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToBullets forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
toList Blocks
blks
  [Block]
blks'' <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
removeOrphanAnchors [Block]
blks'
  [MetaValue]
refs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a b. (a -> b) -> [a] -> [b]
map Reference Inlines -> MetaValue
referenceToMetaValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState -> Map ItemId (Reference Inlines)
docxReferences)
  let meta' :: Meta
meta' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MetaValue]
refs
                 then Meta
meta
                 else forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"references" [MetaValue]
refs Meta
meta
  forall (m :: * -> *) a. Monad m => a -> m a
return (Meta
meta', [Block]
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   = forall a. Default a => a
def { docxOptions :: ReaderOptions
docxOptions  = ReaderOptions
opts} in
   forall (m :: * -> *) a.
PandocMonad m =>
DocxContext m a -> DEnv -> DState -> m a
evalDocxContext (forall (m :: * -> *).
PandocMonad m =>
Body -> DocxContext m (Meta, [Block])
bodyToOutput Body
body) DEnv
dEnv 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) forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
date -> [(Text
"date", Text
date)]) Maybe Text
mdate