{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Readers.Docx
   Copyright   : Copyright (C) 2014-2019 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`, 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 Prelude
import Codec.Archive.Zip
import Control.Monad.Reader
import Control.Monad.State.Strict
import qualified Data.ByteString.Lazy as B
import Data.Default (Default)
import Data.List (delete, intersect)
import Data.Char (isSpace)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Maybe (isJust, fromMaybe)
import Data.Sequence (ViewL (..), viewl)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Text.Pandoc.Builder
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
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import Text.TeXMath (writeTeX)
import Control.Monad.Except (throwError)
import Text.Pandoc.Class (PandocMonad)
import qualified Text.Pandoc.Class as P
import Text.Pandoc.Error
import Text.Pandoc.Logging

readDocx :: PandocMonad m
         => ReaderOptions
         -> B.ByteString
         -> m Pandoc
readDocx :: ReaderOptions -> ByteString -> m Pandoc
readDocx opts :: ReaderOptions
opts bytes :: ByteString
bytes
  | Right archive :: Archive
archive <- ByteString -> Either String Archive
toArchiveOrFail ByteString
bytes
  , Right (docx :: Docx
docx, parserWarnings :: [Text]
parserWarnings) <- Archive -> Either DocxError (Docx, [Text])
archiveToDocxWithWarnings Archive
archive = do
      (Text -> m ()) -> [Text] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (LogMessage -> m ()) -> (Text -> LogMessage) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogMessage
DocxParserWarning) [Text]
parserWarnings
      (meta :: Meta
meta, blks :: [Block]
blks) <- ReaderOptions -> Docx -> m (Meta, [Block])
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Docx -> m (Meta, [Block])
docxToOutput ReaderOptions
opts Docx
docx
      Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks
readDocx _ _ =
  PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError "couldn't parse docx file"

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 -> 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
                     }

instance Default DState where
  def :: DState
def = DState :: Map Text Text
-> Set Text
-> Maybe Text
-> MediaBag
-> Inlines
-> Map (Text, Text) Integer
-> Inlines
-> DState
DState { docxAnchorMap :: Map Text Text
docxAnchorMap = Map Text Text
forall k a. Map k a
M.empty
               , docxAnchorSet :: Set Text
docxAnchorSet = Set Text
forall a. Monoid a => a
mempty
               , docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = Maybe Text
forall a. Maybe a
Nothing
               , docxMediaBag :: MediaBag
docxMediaBag  = MediaBag
forall a. Monoid a => a
mempty
               , docxDropCap :: Inlines
docxDropCap   = Inlines
forall a. Monoid a => a
mempty
               , docxListState :: Map (Text, Text) Integer
docxListState = Map (Text, Text) Integer
forall k a. Map k a
M.empty
               , docxPrevPara :: Inlines
docxPrevPara  = Inlines
forall a. Monoid a => a
mempty
               }

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 ReaderOptions
forall a. Default a => a
def Bool
False Bool
False

type DocxContext m = ReaderT DEnv (StateT DState m)

evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a
evalDocxContext :: DocxContext m a -> DEnv -> DState -> m a
evalDocxContext ctx :: DocxContext m a
ctx env :: DEnv
env st :: DState
st = (StateT DState m a -> DState -> m a)
-> DState -> StateT DState m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT DState m a -> DState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT DState
st (StateT DState m a -> m a) -> StateT DState m a -> m a
forall a b. (a -> b) -> a -> b
$ DocxContext m a -> DEnv -> StateT DState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DocxContext m a
ctx DEnv
env

-- This is empty, but we put it in for future-proofing.
spansToKeep :: [CharStyleName]
spansToKeep :: [CharStyleName]
spansToKeep = []

divsToKeep :: [ParaStyleName]
divsToKeep :: [ParaStyleName]
divsToKeep = ["Definition", "Definition Term"]

metaStyles :: M.Map ParaStyleName T.Text
metaStyles :: Map ParaStyleName Text
metaStyles = [(ParaStyleName, Text)] -> Map ParaStyleName Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ ("Title", "title")
                        , ("Subtitle", "subtitle")
                        , ("Author", "author")
                        , ("Date", "date")
                        , ("Abstract", "abstract")]

sepBodyParts :: [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts :: [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts = (BodyPart -> Bool) -> [BodyPart] -> ([BodyPart], [BodyPart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\bp :: BodyPart
bp -> BodyPart -> Bool
isMetaPar BodyPart
bp Bool -> Bool -> Bool
|| BodyPart -> Bool
isEmptyPar BodyPart
bp)

isMetaPar :: BodyPart -> Bool
isMetaPar :: BodyPart -> Bool
isMetaPar (Paragraph pPr :: ParagraphStyle
pPr _) =
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ParaStyleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ParaStyleName] -> Bool) -> [ParaStyleName] -> Bool
forall a b. (a -> b) -> a -> b
$ [ParaStyleName] -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => [a] -> [a] -> [a]
intersect ([ParStyle] -> [ParaStyleName]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames ([ParStyle] -> [ParaStyleName]) -> [ParStyle] -> [ParaStyleName]
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) (Map ParaStyleName Text -> [ParaStyleName]
forall k a. Map k a -> [k]
M.keys Map ParaStyleName Text
metaStyles)
isMetaPar _ = Bool
False

isEmptyPar :: BodyPart -> Bool
isEmptyPar :: BodyPart -> Bool
isEmptyPar (Paragraph _ parParts :: [ParPart]
parParts) =
  (ParPart -> Bool) -> [ParPart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParPart -> Bool
isEmptyParPart [ParPart]
parParts
  where
    isEmptyParPart :: ParPart -> Bool
isEmptyParPart (PlainRun (Run _ runElems :: [RunElem]
runElems)) = (RunElem -> Bool) -> [RunElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RunElem -> Bool
isEmptyElem [RunElem]
runElems
    isEmptyParPart _                           = Bool
False
    isEmptyElem :: RunElem -> Bool
isEmptyElem (TextRun s :: Text
s) = Text -> Text
trim Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ""
    isEmptyElem _           = Bool
True
isEmptyPar _ = Bool
False

bodyPartsToMeta' :: PandocMonad m => [BodyPart] -> DocxContext m (M.Map T.Text MetaValue)
bodyPartsToMeta' :: [BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [] = Map Text MetaValue -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text MetaValue
forall k a. Map k a
M.empty
bodyPartsToMeta' (bp :: BodyPart
bp : bps :: [BodyPart]
bps)
  | (Paragraph pPr :: ParagraphStyle
pPr parParts :: [ParPart]
parParts) <- BodyPart
bp
  , (c :: ParaStyleName
c : _)<- [ParStyle] -> [StyleName ParStyle]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr) [ParaStyleName] -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Map ParaStyleName Text -> [ParaStyleName]
forall k a. Map k a -> [k]
M.keys Map ParaStyleName Text
metaStyles
  , (Just metaField :: Text
metaField) <- ParaStyleName -> Map ParaStyleName Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ParaStyleName
c Map ParaStyleName Text
metaStyles = do
    Inlines
inlines <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parParts
    Map Text MetaValue
remaining <- [BodyPart] -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
    let
      f :: MetaValue -> MetaValue -> MetaValue
f (MetaInlines ils :: [Inline]
ils) (MetaInlines ils' :: [Inline]
ils') = [Block] -> MetaValue
MetaBlocks [[Inline] -> Block
Para [Inline]
ils, [Inline] -> Block
Para [Inline]
ils']
      f (MetaInlines ils :: [Inline]
ils) (MetaBlocks blks :: [Block]
blks) = [Block] -> MetaValue
MetaBlocks ([Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
      f m :: MetaValue
m (MetaList mv :: [MetaValue]
mv) = [MetaValue] -> MetaValue
MetaList (MetaValue
m MetaValue -> [MetaValue] -> [MetaValue]
forall a. a -> [a] -> [a]
: [MetaValue]
mv)
      f m :: MetaValue
m n :: MetaValue
n             = [MetaValue] -> MetaValue
MetaList [MetaValue
m, MetaValue
n]
    Map Text MetaValue -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text MetaValue -> DocxContext m (Map Text MetaValue))
-> Map Text MetaValue -> DocxContext m (Map Text MetaValue)
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue -> MetaValue)
-> Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
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 (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
inlines)) Map Text MetaValue
remaining
bodyPartsToMeta' (_ : bps :: [BodyPart]
bps) = [BodyPart] -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps

bodyPartsToMeta :: PandocMonad m => [BodyPart] -> DocxContext m Meta
bodyPartsToMeta :: [BodyPart] -> DocxContext m Meta
bodyPartsToMeta bps :: [BodyPart]
bps = do
  Map Text MetaValue
mp <- [BodyPart] -> DocxContext m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m (Map Text MetaValue)
bodyPartsToMeta' [BodyPart]
bps
  let mp' :: Map Text MetaValue
mp' =
        case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "author" Map Text MetaValue
mp of
          Just mv :: MetaValue
mv -> Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "author" (MetaValue -> MetaValue
fixAuthors MetaValue
mv) Map Text MetaValue
mp
          Nothing -> Map Text MetaValue
mp
  Meta -> DocxContext m Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> DocxContext m Meta) -> Meta -> DocxContext m Meta
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> Meta
Meta Map Text MetaValue
mp'

fixAuthors :: MetaValue -> MetaValue
fixAuthors :: MetaValue -> MetaValue
fixAuthors (MetaBlocks blks :: [Block]
blks) =
  [MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
forall a b. (a -> b) -> a -> b
$ (Block -> MetaValue) -> [Block] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map Block -> MetaValue
g ([Block] -> [MetaValue]) -> [Block] -> [MetaValue]
forall a b. (a -> b) -> a -> b
$ (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter Block -> Bool
f [Block]
blks
    where f :: Block -> Bool
f (Para _) = Bool
True
          f _        = Bool
False
          g :: Block -> MetaValue
g (Para ils :: [Inline]
ils) = [Inline] -> MetaValue
MetaInlines [Inline]
ils
          g _          = [Inline] -> MetaValue
MetaInlines []
fixAuthors mv :: MetaValue
mv = MetaValue
mv

isInheritedFromStyles :: (Eq (StyleName s), HasStyleName s, HasParentStyle s) => [StyleName s] -> s -> Bool
isInheritedFromStyles :: [StyleName s] -> s -> Bool
isInheritedFromStyles names :: [StyleName s]
names sty :: s
sty
  | s -> StyleName s
forall a. HasStyleName a => a -> StyleName a
getStyleName s
sty StyleName s -> [StyleName s] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StyleName s]
names = Bool
True
  | Just psty :: s
psty <- s -> Maybe s
forall a. HasParentStyle a => a -> Maybe a
getParentStyle s
sty = [StyleName s] -> s -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName s]
names s
psty
  | Bool
otherwise = Bool
False

hasStylesInheritedFrom :: [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom :: [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom ns :: [ParaStyleName]
ns s :: ParagraphStyle
s = (ParStyle -> Bool) -> [ParStyle] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([StyleName ParStyle] -> ParStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [StyleName ParStyle]
[ParaStyleName]
ns) ([ParStyle] -> Bool) -> [ParStyle] -> Bool
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
s

removeStyleNamed :: ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed :: ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed sn :: ParaStyleName
sn ps :: ParagraphStyle
ps = ParagraphStyle
ps{pStyle :: [ParStyle]
pStyle = (ParStyle -> Bool) -> [ParStyle] -> [ParStyle]
forall a. (a -> Bool) -> [a] -> [a]
filter (\psd :: ParStyle
psd -> ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
psd ParaStyleName -> ParaStyleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ParaStyleName
sn) ([ParStyle] -> [ParStyle]) -> [ParStyle] -> [ParStyle]
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
ps}

isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle :: CharStyle -> Bool
isCodeCharStyle = [StyleName CharStyle] -> CharStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles ["Verbatim Char"]

isCodeDiv :: ParagraphStyle -> Bool
isCodeDiv :: ParagraphStyle -> Bool
isCodeDiv = [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom ["Source Code"]

isBlockQuote :: ParStyle -> Bool
isBlockQuote :: ParStyle -> Bool
isBlockQuote =
  [StyleName ParStyle] -> ParStyle -> Bool
forall s.
(Eq (StyleName s), HasStyleName s, HasParentStyle s) =>
[StyleName s] -> s -> Bool
isInheritedFromStyles [
    "Quote", "Block Text", "Block Quote", "Block Quotation"
    ]

runElemToInlines :: RunElem -> Inlines
runElemToInlines :: RunElem -> Inlines
runElemToInlines (TextRun s :: Text
s)   = Text -> Inlines
text Text
s
runElemToInlines LnBrk         = Inlines
linebreak
runElemToInlines Tab           = Inlines
space
runElemToInlines SoftHyphen    = Text -> Inlines
text "\xad"
runElemToInlines NoBreakHyphen = Text -> Inlines
text "\x2011"

runElemToText :: RunElem -> T.Text
runElemToText :: RunElem -> Text
runElemToText (TextRun s :: Text
s)   = Text
s
runElemToText LnBrk         = Char -> Text
T.singleton '\n'
runElemToText Tab           = Char -> Text
T.singleton '\t'
runElemToText SoftHyphen    = Char -> Text
T.singleton '\xad'
runElemToText NoBreakHyphen = Char -> Text
T.singleton '\x2011'

runToText :: Run -> T.Text
runToText :: Run -> Text
runToText (Run _ runElems :: [RunElem]
runElems) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RunElem -> Text) -> [RunElem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Text
runElemToText [RunElem]
runElems
runToText _                = ""

parPartToText :: ParPart -> T.Text
parPartToText :: ParPart -> Text
parPartToText (PlainRun run :: Run
run)             = Run -> Text
runToText Run
run
parPartToText (InternalHyperLink _ runs :: [Run]
runs) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Run -> Text) -> [Run] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Run -> Text
runToText [Run]
runs
parPartToText (ExternalHyperLink _ runs :: [Run]
runs) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Run -> Text) -> [Run] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Run -> Text
runToText [Run]
runs
parPartToText _                          = ""

blacklistedCharStyles :: [CharStyleName]
blacklistedCharStyles :: [CharStyleName]
blacklistedCharStyles = ["Hyperlink"]

resolveDependentRunStyle :: PandocMonad m => RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle :: RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle rPr :: RunStyle
rPr
  | Just s :: CharStyle
s  <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr
  , CharStyle -> StyleName CharStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName CharStyle
s CharStyleName -> [CharStyleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CharStyleName]
blacklistedCharStyles =
    RunStyle -> DocxContext m RunStyle
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
rPr
  | Just s :: CharStyle
s  <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr = do
      ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
      if Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles ReaderOptions
opts
        then RunStyle -> DocxContext m RunStyle
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
rPr
        else RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle RunStyle
rPr (RunStyle -> RunStyle)
-> DocxContext m RunStyle -> DocxContext m RunStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunStyle -> DocxContext m RunStyle
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle (CharStyle -> RunStyle
cStyleData CharStyle
s)
  | Bool
otherwise = RunStyle -> DocxContext m RunStyle
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
rPr

runStyleToTransform :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform :: RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform rPr :: RunStyle
rPr
  | Just sn :: CharStyleName
sn <- CharStyle -> CharStyleName
forall a. HasStyleName a => a -> StyleName a
getStyleName (CharStyle -> CharStyleName)
-> Maybe CharStyle -> Maybe CharStyleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr
  , CharStyleName
sn CharStyleName -> [CharStyleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CharStyleName]
spansToKeep = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{rParentStyle :: Maybe CharStyle
rParentStyle = Maybe CharStyle
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith ("", [CharStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName CharStyleName
sn], []) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just s :: CharStyle
s <- RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rPr = do
      Inlines -> Inlines
ei <- (Attr -> Inlines -> Inlines)
-> CharStyle -> DocxContext m (Inlines -> Inlines)
forall a (m :: * -> *) i.
(Eq (StyleName a), PandocMonad m, HasStyleName a) =>
(Attr -> i -> i) -> a -> DocxContext m (i -> i)
extraInfo Attr -> Inlines -> Inlines
spanWith CharStyle
s
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{rParentStyle :: Maybe CharStyle
rParentStyle = Maybe CharStyle
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
ei (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just True <- RunStyle -> Maybe Bool
isItalic RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isItalic :: Maybe Bool
isItalic = Maybe Bool
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
emph  (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just True <- RunStyle -> Maybe Bool
isBold RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isBold :: Maybe Bool
isBold = Maybe Bool
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
strong (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just True <- RunStyle -> Maybe Bool
isSmallCaps RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isSmallCaps :: Maybe Bool
isSmallCaps = Maybe Bool
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
smallcaps (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just True <- RunStyle -> Maybe Bool
isStrike RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isStrike :: Maybe Bool
isStrike = Maybe Bool
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
strikeout (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just True <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isRTL :: Maybe Bool
isRTL = Maybe Bool
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith ("",[],[("dir","rtl")]) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just False <- RunStyle -> Maybe Bool
isRTL RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{isRTL :: Maybe Bool
isRTL = Maybe Bool
forall a. Maybe a
Nothing}
      Bool
inBidi <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInBidi
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ if Bool
inBidi
               then Attr -> Inlines -> Inlines
spanWith ("",[],[("dir","ltr")]) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
               else Inlines -> Inlines
transform
  | Just SupScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{rVertAlign :: Maybe VertAlign
rVertAlign = Maybe VertAlign
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
superscript (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just SubScrpt <- RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{rVertAlign :: Maybe VertAlign
rVertAlign = Maybe VertAlign
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
subscript (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Just "single" <- RunStyle -> Maybe String
rUnderline RunStyle
rPr = do
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr{rUnderline :: Maybe String
rUnderline = Maybe String
forall a. Maybe a
Nothing}
      (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines))
-> (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
underlineSpan (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
transform
  | Bool
otherwise = (Inlines -> Inlines) -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines -> Inlines
forall a. a -> a
id

runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
runToInlines :: Run -> DocxContext m Inlines
runToInlines (Run rs :: RunStyle
rs runElems :: [RunElem]
runElems)
  | Bool -> (CharStyle -> Bool) -> Maybe CharStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False CharStyle -> Bool
isCodeCharStyle (Maybe CharStyle -> Bool) -> Maybe CharStyle -> Bool
forall a b. (a -> b) -> a -> b
$ RunStyle -> Maybe CharStyle
rParentStyle RunStyle
rs = do
      RunStyle
rPr <- RunStyle -> DocxContext m RunStyle
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
      let codeString :: Inlines
codeString = Text -> Inlines
code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RunElem -> Text) -> [RunElem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Text
runElemToText [RunElem]
runElems
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ case RunStyle -> Maybe VertAlign
rVertAlign RunStyle
rPr of
        Just SupScrpt -> Inlines -> Inlines
superscript Inlines
codeString
        Just SubScrpt -> Inlines -> Inlines
subscript Inlines
codeString
        _             -> Inlines
codeString
  | Bool
otherwise = do
      RunStyle
rPr <- RunStyle -> DocxContext m RunStyle
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle RunStyle
rs
      let ils :: Inlines
ils = [Inlines] -> Inlines
smushInlines ((RunElem -> Inlines) -> [RunElem] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map RunElem -> Inlines
runElemToInlines [RunElem]
runElems)
      Inlines -> Inlines
transform <- RunStyle -> DocxContext m (Inlines -> Inlines)
forall (m :: * -> *).
PandocMonad m =>
RunStyle -> DocxContext m (Inlines -> Inlines)
runStyleToTransform RunStyle
rPr
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
transform Inlines
ils
runToInlines (Footnote bps :: [BodyPart]
bps) = do
  Blocks
blksList <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
blksList
runToInlines (Endnote bps :: [BodyPart]
bps) = do
  Blocks
blksList <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
blksList
runToInlines (InlineDrawing fp :: String
fp title :: Text
title alt :: Text
alt bs :: ByteString
bs ext :: Extent
ext) = do
  (StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> (m () -> StateT DState m ())
-> m ()
-> ReaderT DEnv (StateT DState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT DState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (m () -> ReaderT DEnv (StateT DState m) ())
-> m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp Maybe Text
forall a. Maybe a
Nothing ByteString
bs
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Extent -> Attr
extentToAttr Extent
ext) (String -> Text
T.pack String
fp) Text
title (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
runToInlines InlineChart = Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith ("", ["chart"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text "[CHART]"

extentToAttr :: Extent -> Attr
extentToAttr :: Extent -> Attr
extentToAttr (Just (w :: Double
w, h :: Double
h)) =
  ("", [], [("width", Double -> Text
forall a. (Show a, Fractional a) => a -> Text
showDim Double
w), ("height", Double -> Text
forall a. (Show a, Fractional a) => a -> Text
showDim Double
h)] )
  where
    showDim :: a -> Text
showDim d :: a
d = a -> Text
forall a. Show a => a -> Text
tshow (a
d a -> a -> a
forall a. Fractional a => a -> a -> a
/ 914400) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in"
extentToAttr _ = Attr
nullAttr

blocksToInlinesWarn :: PandocMonad m => T.Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn :: Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn cmtId :: Text
cmtId blks :: Blocks
blks = do
  let blkList :: [Block]
blkList = Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blks
      notParaOrPlain :: Block -> Bool
      notParaOrPlain :: Block -> Bool
notParaOrPlain (Para _)  = Bool
False
      notParaOrPlain (Plain _) = Bool
False
      notParaOrPlain _         = Bool
True
  Bool
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ( Bool -> Bool
not ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notParaOrPlain [Block]
blkList)) (ReaderT DEnv (StateT DState m) ()
 -> ReaderT DEnv (StateT DState m) ())
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$
    StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> StateT DState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
P.report (LogMessage -> StateT DState m ())
-> LogMessage -> StateT DState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
DocxParserWarning (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$
      "Docx comment " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmtId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " will not retain formatting"
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ [Block] -> Inlines
blocksToInlines' [Block]
blkList

-- 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 :: ParPart -> DocxContext m Inlines
parPartToInlines parPart :: ParPart
parPart =
  case ParPart
parPart of
    (BookMark _ anchor :: Text
anchor) | Text
anchor Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dummyAnchors -> do
      Bool
inHdrBool <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
      Inlines
ils <- ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' ParPart
parPart
      Maybe Text
immedPrevAnchor <- (DState -> Maybe Text)
-> ReaderT DEnv (StateT DState m) (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Maybe Text
docxImmedPrevAnchor
      Bool
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
immedPrevAnchor Bool -> Bool -> Bool
|| Bool
inHdrBool)
        ((DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s{ docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
anchor})
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils
    _ -> do
      Inlines
ils <- ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' ParPart
parPart
      (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s{ docxImmedPrevAnchor :: Maybe Text
docxImmedPrevAnchor = Maybe Text
forall a. Maybe a
Nothing}
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils

parPartToInlines' :: PandocMonad m => ParPart -> DocxContext m Inlines
parPartToInlines' :: ParPart -> DocxContext m Inlines
parPartToInlines' (PlainRun r :: Run
r) = Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines Run
r
parPartToInlines' (ChangedRuns (TrackedChange Insertion (ChangeInfo _ author :: Text
author date :: Text
date)) runs :: [Run]
runs) = do
  ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    AcceptChanges -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
    RejectChanges -> Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    AllChanges    -> do
      Inlines
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
      let attr :: Attr
attr = ("", ["insertion"], [("author", Text
author), ("date", Text
date)])
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
parPartToInlines' (ChangedRuns (TrackedChange Deletion (ChangeInfo _ author :: Text
author date :: Text
date)) runs :: [Run]
runs) = do
  ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    AcceptChanges -> Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    RejectChanges -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
    AllChanges    -> do
      Inlines
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
      let attr :: Attr
attr = ("", ["deletion"], [("author", Text
author), ("date", Text
date)])
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
parPartToInlines' (CommentStart cmtId :: Text
cmtId author :: Text
author date :: Text
date bodyParts :: [BodyPart]
bodyParts) = do
  ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    AllChanges -> do
      Blocks
blks <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bodyParts
      Inlines
ils <- Text -> Blocks -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> Blocks -> DocxContext m Inlines
blocksToInlinesWarn Text
cmtId Blocks
blks
      let attr :: Attr
attr = ("", ["comment-start"], [("id", Text
cmtId), ("author", Text
author), ("date", Text
date)])
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
ils
    _ -> Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (CommentEnd cmtId :: Text
cmtId) = do
  ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  case ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts of
    AllChanges -> do
      let attr :: Attr
attr = ("", ["comment-end"], [("id", Text
cmtId)])
      Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
    _ -> Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (BookMark _ anchor :: Text
anchor) | Text
anchor Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dummyAnchors =
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (BookMark _ anchor :: 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 <- (DEnv -> Bool) -> ReaderT DEnv (StateT DState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> Bool
docxInHeaderBlock
    -- Get the anchor map.
    Map Text Text
anchorMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    -- 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 <- (DState -> Maybe Text)
-> ReaderT DEnv (StateT DState m) (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Maybe Text
docxImmedPrevAnchor
    case Maybe Text
immedPrevAnchor of
      Just prevAnchor :: Text
prevAnchor -> do
        Bool
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inHdrBool
          ((DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s { docxAnchorMap :: Map Text Text
docxAnchorMap = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor Text
prevAnchor Map Text Text
anchorMap})
        Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
      Nothing -> do
        Extensions
exts <- ReaderOptions -> Extensions
readerExtensions (ReaderOptions -> Extensions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
-> ReaderT DEnv (StateT DState m) Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
        let newAnchor :: Text
newAnchor =
              if Bool -> Bool
not Bool
inHdrBool Bool -> Bool -> Bool
&& Text
anchor Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
anchorMap
              then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Text -> Inline
Str Text
anchor]
                     ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
anchorMap)
              else Text
anchor
        Bool
-> ReaderT DEnv (StateT DState m) ()
-> ReaderT DEnv (StateT DState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inHdrBool
          ((DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s { docxAnchorMap :: Map Text Text
docxAnchorMap = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor Text
newAnchor Map Text Text
anchorMap})
        Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
newAnchor, ["anchor"], []) Inlines
forall a. Monoid a => a
mempty
parPartToInlines' (Drawing fp :: String
fp title :: Text
title alt :: Text
alt bs :: ByteString
bs ext :: Extent
ext) = do
  (StateT DState m () -> ReaderT DEnv (StateT DState m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DState m () -> ReaderT DEnv (StateT DState m) ())
-> (m () -> StateT DState m ())
-> m ()
-> ReaderT DEnv (StateT DState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> StateT DState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (m () -> ReaderT DEnv (StateT DState m) ())
-> m () -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
P.insertMedia String
fp Maybe Text
forall a. Maybe a
Nothing ByteString
bs
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith (Extent -> Attr
extentToAttr Extent
ext) (String -> Text
T.pack String
fp) Text
title (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
alt
parPartToInlines' Chart =
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith ("", ["chart"], []) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text "[CHART]"
parPartToInlines' (InternalHyperLink anchor :: Text
anchor runs :: [Run]
runs) = do
  Inlines
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
anchor) "" Inlines
ils
parPartToInlines' (ExternalHyperLink target :: Text
target runs :: [Run]
runs) = do
  Inlines
ils <- [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
target "" Inlines
ils
parPartToInlines' (PlainOMath exps :: [Exp]
exps) =
  Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DocxContext m Inlines)
-> Inlines -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
math (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeTeX [Exp]
exps
parPartToInlines' (Field info :: FieldInfo
info runs :: [Run]
runs) =
  case FieldInfo
info of
    HyperlinkField url :: Text
url -> ParPart -> DocxContext m Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines' (ParPart -> DocxContext m Inlines)
-> ParPart -> DocxContext m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> [Run] -> ParPart
ExternalHyperLink Text
url [Run]
runs
    UnknownField -> [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> DocxContext m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Run -> DocxContext m Inlines)
-> [Run] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Run -> DocxContext m Inlines
forall (m :: * -> *). PandocMonad m => Run -> DocxContext m Inlines
runToInlines [Run]
runs
parPartToInlines' NullParPart = Inlines -> DocxContext m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

isAnchorSpan :: Inline -> Bool
isAnchorSpan :: Inline -> Bool
isAnchorSpan (Span (_, classes :: [Text]
classes, kvs :: [(Text, Text)]
kvs) _) =
  [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== ["anchor"] Bool -> Bool -> Bool
&&
  [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
kvs
isAnchorSpan _ = Bool
False

dummyAnchors :: [T.Text]
dummyAnchors :: [Text]
dummyAnchors = ["_GoBack"]

makeHeaderAnchor :: PandocMonad m => Blocks -> DocxContext m Blocks
makeHeaderAnchor :: Blocks -> DocxContext m Blocks
makeHeaderAnchor bs :: Blocks
bs = (Block -> ReaderT DEnv (StateT DState m) Block)
-> Blocks -> DocxContext m Blocks
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Block -> ReaderT DEnv (StateT DState m) Block
forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' Blocks
bs

makeHeaderAnchor' :: PandocMonad m => Block -> DocxContext m Block
-- 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' :: Block -> DocxContext m Block
makeHeaderAnchor' (Header n :: Int
n (ident :: Text
ident, classes :: [Text]
classes, kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils)
  | (c :: Inline
c:_) <- (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
isAnchorSpan [Inline]
ils
  , (Span (anchIdent :: Text
anchIdent, ["anchor"], _) cIls :: [Inline]
cIls) <- Inline
c = do
    Map Text Text
hdrIDMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    Extensions
exts <- ReaderOptions -> Extensions
readerExtensions (ReaderOptions -> Extensions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
-> ReaderT DEnv (StateT DState m) Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks 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 ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
                   else Text
ident
        newIls :: [Inline]
newIls = (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
f [Inline]
ils where f :: Inline -> [Inline]
f il :: Inline
il | Inline
il Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
c   = [Inline]
cIls
                                            | Bool
otherwise = [Inline
il]
    (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s {docxAnchorMap :: Map Text Text
docxAnchorMap = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchIdent Text
newIdent Map Text Text
hdrIDMap}
    Block -> DocxContext m Block
forall (m :: * -> *). PandocMonad m => Block -> DocxContext m Block
makeHeaderAnchor' (Block -> DocxContext m Block) -> Block -> DocxContext m Block
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 n :: Int
n (ident :: Text
ident, classes :: [Text]
classes, kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils) =
  do
    Map Text Text
hdrIDMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
    Extensions
exts <- ReaderOptions -> Extensions
readerExtensions (ReaderOptions -> Extensions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
-> ReaderT DEnv (StateT DState m) Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks 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 ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
M.elems Map Text Text
hdrIDMap)
                   else Text
ident
    (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s {docxAnchorMap :: Map Text Text
docxAnchorMap = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
newIdent Text
newIdent Map Text Text
hdrIDMap}
    Block -> DocxContext m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> DocxContext m Block) -> Block -> DocxContext m Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
newIdent, [Text]
classes, [(Text, Text)]
kvs) [Inline]
ils
makeHeaderAnchor' blk :: Block
blk = Block -> DocxContext m Block
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 blks :: Blocks
blks
  | (Para ils :: [Inline]
ils :< seeq :: Seq Block
seeq) <- Seq Block -> ViewL Block
forall a. Seq a -> ViewL a
viewl (Seq Block -> ViewL Block) -> Seq Block -> ViewL Block
forall a b. (a -> b) -> a -> b
$ Blocks -> Seq Block
forall a. Many a -> Seq a
unMany Blocks
blks
  , Seq Block -> Bool
forall a. Seq a -> Bool
Seq.null Seq Block
seeq =
      Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [Inline]
ils
singleParaToPlain blks :: Blocks
blks = Blocks
blks

cellToBlocks :: PandocMonad m => Cell -> DocxContext m Blocks
cellToBlocks :: Cell -> DocxContext m Blocks
cellToBlocks (Cell bps :: [BodyPart]
bps) = do
  Blocks
blks <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks] -> DocxContext m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> DocxContext m Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
bps
  Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToDefinitions ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToBullets ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blks

rowToBlocksList :: PandocMonad m => Row -> DocxContext m [Blocks]
rowToBlocksList :: Row -> DocxContext m [Blocks]
rowToBlocksList (Row cells :: [Cell]
cells) = do
  [Blocks]
blksList <- (Cell -> ReaderT DEnv (StateT DState m) Blocks)
-> [Cell] -> DocxContext m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Cell -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *). PandocMonad m => Cell -> DocxContext m Blocks
cellToBlocks [Cell]
cells
  [Blocks] -> DocxContext m [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks] -> DocxContext m [Blocks])
-> [Blocks] -> DocxContext m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Blocks
singleParaToPlain [Blocks]
blksList

-- like trimInlines, but also take out linebreaks
trimSps :: Inlines -> Inlines
trimSps :: Inlines -> Inlines
trimSps (Many ils :: Seq Inline
ils) = Seq Inline -> Inlines
forall a. Seq a -> Many a
Many (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> Seq Inline -> Seq Inline
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL Inline -> Bool
isSp (Seq Inline -> Seq Inline) -> Seq Inline -> Seq Inline
forall a b. (a -> b) -> a -> b
$(Inline -> Bool) -> Seq Inline -> Seq Inline
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileR Inline -> Bool
isSp Seq Inline
ils
  where isSp :: Inline -> Bool
isSp Space     = Bool
True
        isSp SoftBreak = Bool
True
        isSp LineBreak = Bool
True
        isSp _         = Bool
False

extraInfo :: (Eq (StyleName a), PandocMonad m, HasStyleName a)
          => (Attr -> i -> i) -> a -> DocxContext m (i -> i)
extraInfo :: (Attr -> i -> i) -> a -> DocxContext m (i -> i)
extraInfo f :: Attr -> i -> i
f s :: a
s = do
  ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
  (i -> i) -> DocxContext m (i -> i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((i -> i) -> DocxContext m (i -> i))
-> (i -> i) -> DocxContext m (i -> i)
forall a b. (a -> b) -> a -> b
$ if | Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_styles ReaderOptions
opts
              -> Attr -> i -> i
f ("", [], [("custom-style", StyleName a -> Text
forall a. FromStyleName a => a -> Text
fromStyleName (StyleName a -> Text) -> StyleName a -> Text
forall a b. (a -> b) -> a -> b
$ a -> StyleName a
forall a. HasStyleName a => a -> StyleName a
getStyleName a
s)])
              | Bool
otherwise -> i -> i
forall a. a -> a
id

parStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform :: ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform pPr :: ParagraphStyle
pPr
  | (c :: ParStyle
c:cs :: [ParStyle]
cs) <- ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr
  , ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
c ParaStyleName -> [ParaStyleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
divsToKeep = do
      let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pStyle :: [ParStyle]
pStyle = [ParStyle]
cs }
      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
      (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks))
-> (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith ("", [ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName (ParaStyleName -> Text) -> ParaStyleName -> Text
forall a b. (a -> b) -> a -> b
$ ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
c], []) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform
  | (c :: ParStyle
c:cs :: [ParStyle]
cs) <- ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr,
    ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
c ParaStyleName -> [ParaStyleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParaStyleName]
listParagraphStyles = do
      let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pStyle :: [ParStyle]
pStyle = [ParStyle]
cs, indentation :: Maybe ParIndentation
indentation = Maybe ParIndentation
forall a. Maybe a
Nothing}
      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
      (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks))
-> (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith ("", [ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName (ParaStyleName -> Text) -> ParaStyleName -> Text
forall a b. (a -> b) -> a -> b
$ ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle
c], []) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform
  | (c :: ParStyle
c:cs :: [ParStyle]
cs) <- ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr = do
      let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pStyle :: [ParStyle]
pStyle = [ParStyle]
cs }
      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
      Blocks -> Blocks
ei <- (Attr -> Blocks -> Blocks)
-> ParStyle -> DocxContext m (Blocks -> Blocks)
forall a (m :: * -> *) i.
(Eq (StyleName a), PandocMonad m, HasStyleName a) =>
(Attr -> i -> i) -> a -> DocxContext m (i -> i)
extraInfo Attr -> Blocks -> Blocks
divWith ParStyle
c
      (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks))
-> (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
ei (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if ParStyle -> Bool
isBlockQuote ParStyle
c then Blocks -> Blocks
blockQuote else Blocks -> Blocks
forall a. a -> a
id) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform
  | [ParStyle] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr)
  , Just left :: Integer
left <- ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
leftParIndent = do
    let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { indentation :: Maybe ParIndentation
indentation = Maybe ParIndentation
forall a. Maybe a
Nothing }
        hang :: Integer
hang = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> Maybe ParIndentation
indentation ParagraphStyle
pPr Maybe ParIndentation
-> (ParIndentation -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParIndentation -> Maybe Integer
hangingParIndent
    Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
    (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks))
-> (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall a b. (a -> b) -> a -> b
$ if (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
hang) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0
             then Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
transform
             else Blocks -> Blocks
transform
parStyleToTransform _ = (Blocks -> Blocks) -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks -> Blocks
forall a. a -> a
id

normalizeToClassName :: (FromStyleName a) => a -> T.Text
normalizeToClassName :: a -> Text
normalizeToClassName = (Char -> Char) -> Text -> Text
T.map Char -> Char
go (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. FromStyleName a => a -> Text
fromStyleName
  where go :: Char -> Char
go c :: Char
c | Char -> Bool
isSpace Char
c = '-'
             | Bool
otherwise = Char
c

bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks
bodyPartToBlocks :: BodyPart -> DocxContext m Blocks
bodyPartToBlocks (Paragraph pPr :: ParagraphStyle
pPr parparts :: [ParPart]
parparts)
  | Just True <- ParagraphStyle -> Maybe Bool
pBidi ParagraphStyle
pPr = do
      let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr { pBidi :: Maybe Bool
pBidi = Maybe Bool
forall a. Maybe a
Nothing }
      (DEnv -> DEnv) -> DocxContext m Blocks -> DocxContext m Blocks
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\s :: DEnv
s -> DEnv
s{ docxInBidi :: Bool
docxInBidi = Bool
True })
        (BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts))
  | ParagraphStyle -> Bool
isCodeDiv ParagraphStyle
pPr = do
      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr
      Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$
        Blocks -> Blocks
transform (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
        Text -> Blocks
codeBlock (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        (ParPart -> Text) -> [ParPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParPart -> Text
parPartToText [ParPart]
parparts
  | Just (style :: ParaStyleName
style, n :: Int
n) <- ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading ParagraphStyle
pPr = do
    Inlines
ils <-(DEnv -> DEnv)
-> ReaderT DEnv (StateT DState m) Inlines
-> ReaderT DEnv (StateT DState m) Inlines
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\s :: DEnv
s-> DEnv
s{docxInHeaderBlock :: Bool
docxInHeaderBlock=Bool
True})
           ([Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts)
    Blocks -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> DocxContext m Blocks
makeHeaderAnchor (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$
      Attr -> Int -> Inlines -> Blocks
headerWith ("", (ParaStyleName -> Text) -> [ParaStyleName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
normalizeToClassName ([ParaStyleName] -> [Text])
-> ([ParaStyleName] -> [ParaStyleName])
-> [ParaStyleName]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParaStyleName -> [ParaStyleName] -> [ParaStyleName]
forall a. Eq a => a -> [a] -> [a]
delete ParaStyleName
style ([ParaStyleName] -> [Text]) -> [ParaStyleName] -> [Text]
forall a b. (a -> b) -> a -> b
$ [ParStyle] -> [StyleName ParStyle]
forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames (ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr), []) Int
n Inlines
ils
  | Bool
otherwise = do
    Inlines
ils <- Inlines -> Inlines
trimSps (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
smushInlines ([Inlines] -> Inlines)
-> ReaderT DEnv (StateT DState m) [Inlines]
-> ReaderT DEnv (StateT DState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParPart -> ReaderT DEnv (StateT DState m) Inlines)
-> [ParPart] -> ReaderT DEnv (StateT DState m) [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParPart -> ReaderT DEnv (StateT DState m) Inlines
forall (m :: * -> *).
PandocMonad m =>
ParPart -> DocxContext m Inlines
parPartToInlines [ParPart]
parparts
    Inlines
prevParaIls <- (DState -> Inlines) -> ReaderT DEnv (StateT DState m) Inlines
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Inlines
docxPrevPara
    Inlines
dropIls <- (DState -> Inlines) -> ReaderT DEnv (StateT DState m) Inlines
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Inlines
docxDropCap
    let ils' :: Inlines
ils' = Inlines
dropIls Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils
    let (paraOrPlain :: Inlines -> Blocks
paraOrPlain, pPr' :: ParagraphStyle
pPr')
          | [ParaStyleName] -> ParagraphStyle -> Bool
hasStylesInheritedFrom ["Compact"] ParagraphStyle
pPr = (Inlines -> Blocks
plain, ParaStyleName -> ParagraphStyle -> ParagraphStyle
removeStyleNamed "Compact" ParagraphStyle
pPr)
          | Bool
otherwise = (Inlines -> Blocks
para, ParagraphStyle
pPr)
    if ParagraphStyle -> Bool
dropCap ParagraphStyle
pPr'
      then do (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s { docxDropCap :: Inlines
docxDropCap = Inlines
ils' }
              Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
      else do (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s { docxDropCap :: Inlines
docxDropCap = Inlines
forall a. Monoid a => a
mempty }
              let ils'' :: Inlines
ils'' = Inlines
prevParaIls Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                          (if Inlines -> Bool
forall a. Many a -> Bool
isNull Inlines
prevParaIls then Inlines
forall a. Monoid a => a
mempty else Inlines
space) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                          Inlines
ils'
                  handleInsertion :: DocxContext m Blocks
handleInsertion = do
                    (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = Inlines
forall a. Monoid a => a
mempty}
                    Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
                    Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
paraOrPlain Inlines
ils''
              ReaderOptions
opts <- (DEnv -> ReaderOptions)
-> ReaderT DEnv (StateT DState m) ReaderOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DEnv -> ReaderOptions
docxOptions
              if  | Inlines -> Bool
forall a. Many a -> Bool
isNull Inlines
ils'' Bool -> Bool -> Bool
&& Bool -> Bool
not (Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs ReaderOptions
opts) ->
                    Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
                  | Just (TrackedChange Insertion _) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
AcceptChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts ->
                      DocxContext m Blocks
handleInsertion
                  | Just (TrackedChange Insertion _) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
RejectChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts -> do
                      (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = Inlines
ils''}
                      Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
                  | Just (TrackedChange Insertion cInfo :: ChangeInfo
cInfo) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
AllChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts
                  , ChangeInfo _ cAuthor :: Text
cAuthor cDate :: Text
cDate <- ChangeInfo
cInfo -> do
                      let attr :: Attr
attr = ("", ["paragraph-insertion"], [("author", Text
cAuthor), ("date", Text
cDate)])
                          insertMark :: Inlines
insertMark = Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
                      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
                      Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
                        Inlines -> Blocks
paraOrPlain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
ils'' Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
insertMark
                  | Just (TrackedChange Deletion _) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
AcceptChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts -> do
                      (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s {docxPrevPara :: Inlines
docxPrevPara = Inlines
ils''}
                      Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
                  | Just (TrackedChange Deletion _) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
RejectChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts ->
                      DocxContext m Blocks
handleInsertion
                  | Just (TrackedChange Deletion cInfo :: ChangeInfo
cInfo) <- ParagraphStyle -> Maybe TrackedChange
pChange ParagraphStyle
pPr'
                  , TrackChanges
AllChanges <- ReaderOptions -> TrackChanges
readerTrackChanges ReaderOptions
opts
                  , ChangeInfo _ cAuthor :: Text
cAuthor cDate :: Text
cDate <- ChangeInfo
cInfo -> do
                      let attr :: Attr
attr = ("", ["paragraph-deletion"], [("author", Text
cAuthor), ("date", Text
cDate)])
                          insertMark :: Inlines
insertMark = Attr -> Inlines -> Inlines
spanWith Attr
attr Inlines
forall a. Monoid a => a
mempty
                      Blocks -> Blocks
transform <- ParagraphStyle -> DocxContext m (Blocks -> Blocks)
forall (m :: * -> *).
PandocMonad m =>
ParagraphStyle -> DocxContext m (Blocks -> Blocks)
parStyleToTransform ParagraphStyle
pPr'
                      Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
transform (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
                        Inlines -> Blocks
paraOrPlain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
ils'' Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
insertMark
                  | Bool
otherwise -> DocxContext m Blocks
handleInsertion
bodyPartToBlocks (ListItem pPr :: ParagraphStyle
pPr numId :: Text
numId lvl :: Text
lvl (Just levelInfo :: Level
levelInfo) parparts :: [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 <- (DState -> Map (Text, Text) Integer)
-> ReaderT DEnv (StateT DState m) (Map (Text, Text) Integer)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map (Text, Text) Integer
docxListState
  let startFromState :: Maybe Integer
startFromState = (Text, Text) -> Map (Text, Text) Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
numId, Text
lvl) Map (Text, Text) Integer
listState
      Level _ fmt :: Text
fmt txt :: Text
txt startFromLevelInfo :: Maybe Integer
startFromLevelInfo = Level
levelInfo
      start :: Integer
start = case Maybe Integer
startFromState of
        Just n :: Integer
n -> Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
        Nothing -> Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Integer
startFromLevelInfo
      kvs :: [(Text, Text)]
kvs = [ ("level", Text
lvl)
            , ("num-id", Text
numId)
            , ("format", Text
fmt)
            , ("text", Text
txt)
            , ("start", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
start)
            ]
  (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \st :: 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 expireKeys :: [(Text, Text)]
expireKeys = [ (Text
numid', Text
lvl')
                     |  (numid' :: Text
numid', lvl' :: Text
lvl') <- Map (Text, Text) Integer -> [(Text, Text)]
forall k a. Map k a -> [k]
M.keys Map (Text, Text) Integer
listState
                     , Text
lvl' Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
> Text
lvl
                     ]
    in ((Text, Text)
 -> Map (Text, Text) Integer -> Map (Text, Text) Integer)
-> Map (Text, Text) Integer
-> [(Text, Text)]
-> Map (Text, Text) Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text)
-> Map (Text, Text) Integer -> Map (Text, Text) Integer
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ((Text, Text)
-> Integer -> Map (Text, Text) Integer -> Map (Text, Text) Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
numId, Text
lvl) Integer
start Map (Text, Text) Integer
listState) [(Text, Text)]
expireKeys }
  Blocks
blks <- BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr [ParPart]
parparts)
  Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith ("", ["list-item"], [(Text, Text)]
kvs) Blocks
blks
bodyPartToBlocks (ListItem pPr :: ParagraphStyle
pPr _ _ _ parparts :: [ParPart]
parparts) =
  let pPr' :: ParagraphStyle
pPr' = ParagraphStyle
pPr {pStyle :: [ParStyle]
pStyle = ParaStyleName -> ParStyle
constructBogusParStyleData "list-paragraph"ParStyle -> [ParStyle] -> [ParStyle]
forall a. a -> [a] -> [a]
: ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
pPr}
  in
    BodyPart -> DocxContext m Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks (BodyPart -> DocxContext m Blocks)
-> BodyPart -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
pPr' [ParPart]
parparts
bodyPartToBlocks (Tbl _ _ _ []) =
  Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para Inlines
forall a. Monoid a => a
mempty
bodyPartToBlocks (Tbl cap :: Text
cap _ look :: TblLook
look parts :: [Row]
parts@(r :: Row
r:rs :: [Row]
rs)) = do
  let caption :: Inlines
caption = Text -> Inlines
text Text
cap
      (hdr :: Maybe Row
hdr, rows :: [Row]
rows) = case TblLook -> Bool
firstRowFormatting TblLook
look of
        True | [Row] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Row]
rs -> (Maybe Row
forall a. Maybe a
Nothing, [Row
r])
             | Bool
otherwise -> (Row -> Maybe Row
forall a. a -> Maybe a
Just Row
r, [Row]
rs)
        False -> (Maybe Row
forall a. Maybe a
Nothing, Row
rRow -> [Row] -> [Row]
forall a. a -> [a] -> [a]
:[Row]
rs)

  [[Blocks]]
cells <- (Row -> ReaderT DEnv (StateT DState m) [Blocks])
-> [Row] -> ReaderT DEnv (StateT DState m) [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Row -> ReaderT DEnv (StateT DState m) [Blocks]
forall (m :: * -> *).
PandocMonad m =>
Row -> DocxContext m [Blocks]
rowToBlocksList [Row]
rows

  let width :: Int
width = Int -> ([Int] -> Int) -> Maybe [Int] -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe [Int] -> Int) -> Maybe [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe [Int]
forall a. [a] -> Maybe [a]
nonEmpty ([Int] -> Maybe [Int]) -> [Int] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ (Row -> Int) -> [Row] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Int
rowLength [Row]
parts
      -- Data.List.NonEmpty is not available with ghc 7.10 so we roll out
      -- our own, see
      -- https://github.com/jgm/pandoc/pull/4361#issuecomment-365416155
      nonEmpty :: [a] -> Maybe [a]
nonEmpty [] = Maybe [a]
forall a. Maybe a
Nothing
      nonEmpty l :: [a]
l  = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
l
      rowLength :: Row -> Int
      rowLength :: Row -> Int
rowLength (Row c :: [Cell]
c) = [Cell] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell]
c

  -- pad cells.  New Text.Pandoc.Builder will do that for us,
  -- so this is for compatibility while we switch over.
  let cells' :: [[Blocks]]
cells' = ([Blocks] -> [Blocks]) -> [[Blocks]] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map (\row :: [Blocks]
row -> Int -> [Blocks] -> [Blocks]
forall a. Int -> [a] -> [a]
take Int
width ([Blocks]
row [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ Blocks -> [Blocks]
forall a. a -> [a]
repeat Blocks
forall a. Monoid a => a
mempty)) [[Blocks]]
cells

  [Blocks]
hdrCells <- case Maybe Row
hdr of
    Just r' :: Row
r' -> Row -> ReaderT DEnv (StateT DState m) [Blocks]
forall (m :: * -> *).
PandocMonad m =>
Row -> DocxContext m [Blocks]
rowToBlocksList Row
r'
    Nothing -> [Blocks] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks] -> ReaderT DEnv (StateT DState m) [Blocks])
-> [Blocks] -> ReaderT DEnv (StateT DState m) [Blocks]
forall a b. (a -> b) -> a -> b
$ Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate Int
width Blocks
forall a. Monoid a => a
mempty

      -- The two following variables (horizontal column alignment and
      -- relative column widths) go to the default at the
      -- moment. Width information is in the TblGrid field of the Tbl,
      -- so should be possible. Alignment might be more difficult,
      -- since there doesn't seem to be a column entity in docx.
  let alignments :: [Alignment]
alignments = Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
width Alignment
AlignDefault
      widths :: [Double]
widths = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
width 0 :: [Double]

  Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
-> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
table Inlines
caption ([Alignment] -> [Double] -> [(Alignment, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
alignments [Double]
widths) [Blocks]
hdrCells [[Blocks]]
cells'
bodyPartToBlocks (OMathPara e :: [Exp]
e) =
  Blocks -> DocxContext m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DocxContext m Blocks) -> Blocks -> DocxContext m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
displayMath ([Exp] -> Text
writeTeX [Exp]
e)


-- replace targets with generated anchors.
rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline
rewriteLink' :: Inline -> DocxContext m Inline
rewriteLink' l :: Inline
l@(Link attr :: Attr
attr ils :: [Inline]
ils (Text -> Maybe (Char, Text)
T.uncons -> Just ('#',target :: Text
target), title :: Text
title)) = do
  Map Text Text
anchorMap <- (DState -> Map Text Text)
-> ReaderT DEnv (StateT DState m) (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Map Text Text
docxAnchorMap
  case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
target Map Text Text
anchorMap of
    Just newTarget :: Text
newTarget -> do
      (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s{docxAnchorSet :: Set Text
docxAnchorSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
newTarget (DState -> Set Text
docxAnchorSet DState
s)}
      Inline -> DocxContext m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> DocxContext m Inline) -> Inline -> DocxContext m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
ils ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newTarget, Text
title)
    Nothing        -> do
      (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DState -> DState) -> ReaderT DEnv (StateT DState m) ())
-> (DState -> DState) -> ReaderT DEnv (StateT DState m) ()
forall a b. (a -> b) -> a -> b
$ \s :: DState
s -> DState
s{docxAnchorSet :: Set Text
docxAnchorSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
target (DState -> Set Text
docxAnchorSet DState
s)}
      Inline -> DocxContext m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
l
rewriteLink' il :: Inline
il = Inline -> DocxContext m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
il

rewriteLinks :: PandocMonad m => [Block] -> DocxContext m [Block]
rewriteLinks :: [Block] -> DocxContext m [Block]
rewriteLinks = (Block -> ReaderT DEnv (StateT DState m) Block)
-> [Block] -> DocxContext m [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Inline -> ReaderT DEnv (StateT DState m) Inline)
-> Block -> ReaderT DEnv (StateT DState m) Block
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> ReaderT DEnv (StateT DState m) Inline
forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m Inline
rewriteLink')

removeOrphanAnchors'' :: PandocMonad m => Inline -> DocxContext m [Inline]
removeOrphanAnchors'' :: Inline -> DocxContext m [Inline]
removeOrphanAnchors'' s :: Inline
s@(Span (ident :: Text
ident, classes :: [Text]
classes, _) ils :: [Inline]
ils)
  | "anchor" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
      Set Text
anchorSet <- (DState -> Set Text) -> ReaderT DEnv (StateT DState m) (Set Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DState -> Set Text
docxAnchorSet
      [Inline] -> DocxContext m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> DocxContext m [Inline])
-> [Inline] -> DocxContext m [Inline]
forall a b. (a -> b) -> a -> b
$ if Text
ident Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
anchorSet
               then [Inline
s]
               else [Inline]
ils
removeOrphanAnchors'' il :: Inline
il = [Inline] -> DocxContext m [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline
il]

removeOrphanAnchors' :: PandocMonad m => [Inline] -> DocxContext m [Inline]
removeOrphanAnchors' :: [Inline] -> DocxContext m [Inline]
removeOrphanAnchors' ils :: [Inline]
ils = ([[Inline]] -> [Inline])
-> ReaderT DEnv (StateT DState m) [[Inline]]
-> DocxContext m [Inline]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT DEnv (StateT DState m) [[Inline]]
 -> DocxContext m [Inline])
-> ReaderT DEnv (StateT DState m) [[Inline]]
-> DocxContext m [Inline]
forall a b. (a -> b) -> a -> b
$ (Inline -> DocxContext m [Inline])
-> [Inline] -> ReaderT DEnv (StateT DState m) [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> DocxContext m [Inline]
forall (m :: * -> *).
PandocMonad m =>
Inline -> DocxContext m [Inline]
removeOrphanAnchors'' [Inline]
ils

removeOrphanAnchors :: PandocMonad m => [Block] -> DocxContext m [Block]
removeOrphanAnchors :: [Block] -> DocxContext m [Block]
removeOrphanAnchors = (Block -> ReaderT DEnv (StateT DState m) Block)
-> [Block] -> DocxContext m [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Inline] -> ReaderT DEnv (StateT DState m) [Inline])
-> Block -> ReaderT DEnv (StateT DState m) Block
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM [Inline] -> ReaderT DEnv (StateT DState m) [Inline]
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> DocxContext m [Inline]
removeOrphanAnchors')

bodyToOutput :: PandocMonad m => Body -> DocxContext m (Meta, [Block])
bodyToOutput :: Body -> DocxContext m (Meta, [Block])
bodyToOutput (Body bps :: [BodyPart]
bps) = do
  let (metabps :: [BodyPart]
metabps, blkbps :: [BodyPart]
blkbps) = [BodyPart] -> ([BodyPart], [BodyPart])
sepBodyParts [BodyPart]
bps
  Meta
meta <- [BodyPart] -> DocxContext m Meta
forall (m :: * -> *).
PandocMonad m =>
[BodyPart] -> DocxContext m Meta
bodyPartsToMeta [BodyPart]
metabps
  Blocks
blks <- [Blocks] -> Blocks
smushBlocks ([Blocks] -> Blocks)
-> ReaderT DEnv (StateT DState m) [Blocks]
-> ReaderT DEnv (StateT DState m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyPart -> ReaderT DEnv (StateT DState m) Blocks)
-> [BodyPart] -> ReaderT DEnv (StateT DState m) [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BodyPart -> ReaderT DEnv (StateT DState m) Blocks
forall (m :: * -> *).
PandocMonad m =>
BodyPart -> DocxContext m Blocks
bodyPartToBlocks [BodyPart]
blkbps
  [Block]
blks' <- [Block] -> DocxContext m [Block]
forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
rewriteLinks ([Block] -> DocxContext m [Block])
-> [Block] -> DocxContext m [Block]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToDefinitions ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
blocksToBullets ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blks
  [Block]
blks'' <- [Block] -> DocxContext m [Block]
forall (m :: * -> *).
PandocMonad m =>
[Block] -> DocxContext m [Block]
removeOrphanAnchors [Block]
blks'
  (Meta, [Block]) -> DocxContext m (Meta, [Block])
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta
meta, [Block]
blks'')

docxToOutput :: PandocMonad m
             => ReaderOptions
             -> Docx
             -> m (Meta, [Block])
docxToOutput :: ReaderOptions -> Docx -> m (Meta, [Block])
docxToOutput opts :: ReaderOptions
opts (Docx (Document _ body :: Body
body)) =
  let dEnv :: DEnv
dEnv   = DEnv
forall a. Default a => a
def { docxOptions :: ReaderOptions
docxOptions  = ReaderOptions
opts} in
   DocxContext m (Meta, [Block])
-> DEnv -> DState -> m (Meta, [Block])
forall (m :: * -> *) a.
PandocMonad m =>
DocxContext m a -> DEnv -> DState -> m a
evalDocxContext (Body -> DocxContext m (Meta, [Block])
forall (m :: * -> *).
PandocMonad m =>
Body -> DocxContext m (Meta, [Block])
bodyToOutput Body
body) DEnv
dEnv DState
forall a. Default a => a
def