    {-# LANGUAGE PatternGuards       #-}
    {-# LANGUAGE RankNTypes          #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns        #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {- |
       Module      : Text.Pandoc.Writers.Docx
       Copyright   : Copyright (C) 2012-2020 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    Conversion of 'Pandoc' documents to docx.
    -}
    module Text.Pandoc.Writers.Docx ( writeDocx ) where
    import Codec.Archive.Zip
    import Control.Applicative ((<|>))
    import Control.Monad.Except (catchError, throwError)
    import Control.Monad.Reader
    import Control.Monad.State.Strict
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import Data.Char (isSpace, ord, isLetter)
    import Data.List (intercalate, isPrefixOf, isSuffixOf)
    import Data.String (fromString)
    import qualified Data.Map as M
    import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList)
    import qualified Data.Set as Set
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Data.Time.Clock.POSIX
    import Data.Digest.Pure.SHA (sha1, showDigest)
    import Skylighting
    import System.Random (randomR, StdGen, mkStdGen)
    import Text.Pandoc.BCP47 (getLang, renderLang)
    import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
    import qualified Text.Pandoc.Class.PandocMonad as P
    import Data.Time
    import Text.Pandoc.UTF8 (fromTextLazy)
    import Text.Pandoc.Definition
    import Text.Pandoc.Generic
    import Text.Pandoc.Highlighting (highlight)
    import Text.Pandoc.Error
    import Text.Pandoc.ImageSize
    import Text.Pandoc.Logging
    import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
                             getMimeTypeDef)
    import Text.Pandoc.Options
    import Text.Pandoc.Writers.Docx.StyleMap
    import Text.Pandoc.Shared
    import Text.Pandoc.Walk
    import Text.Pandoc.Writers.Math
    import Text.Pandoc.Writers.Shared
    import Text.Printf (printf)
    import Text.TeXMath
    import Text.XML.Light as XML
    import Text.XML.Light.Cursor as XMLC
    import Text.Pandoc.Writers.OOXML

    data ListMarker = NoMarker
                    | BulletMarker
                    | NumberMarker ListNumberStyle ListNumberDelim Int
                    deriving (Int -> ListMarker -> ShowS
    [ListMarker] -> ShowS
    ListMarker -> String
    (Int -> ListMarker -> ShowS)
    -> (ListMarker -> String)
    -> ([ListMarker] -> ShowS)
    -> Show ListMarker
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ListMarker] -> ShowS
    $cshowList :: [ListMarker] -> ShowS
    show :: ListMarker -> String
    $cshow :: ListMarker -> String
    showsPrec :: Int -> ListMarker -> ShowS
    $cshowsPrec :: Int -> ListMarker -> ShowS
    Show, ReadPrec [ListMarker]
    ReadPrec ListMarker
    Int -> ReadS ListMarker
    ReadS [ListMarker]
    (Int -> ReadS ListMarker)
    -> ReadS [ListMarker]
    -> ReadPrec ListMarker
    -> ReadPrec [ListMarker]
    -> Read ListMarker
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [ListMarker]
    $creadListPrec :: ReadPrec [ListMarker]
    readPrec :: ReadPrec ListMarker
    $creadPrec :: ReadPrec ListMarker
    readList :: ReadS [ListMarker]
    $creadList :: ReadS [ListMarker]
    readsPrec :: Int -> ReadS ListMarker
    $creadsPrec :: Int -> ReadS ListMarker
    Read, ListMarker -> ListMarker -> Bool
    (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool) -> Eq ListMarker
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ListMarker -> ListMarker -> Bool
    $c/= :: ListMarker -> ListMarker -> Bool
    == :: ListMarker -> ListMarker -> Bool
    $c== :: ListMarker -> ListMarker -> Bool
    Eq, Eq ListMarker
    Eq ListMarker =>
    (ListMarker -> ListMarker -> Ordering)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> ListMarker)
    -> (ListMarker -> ListMarker -> ListMarker)
    -> Ord ListMarker
    ListMarker -> ListMarker -> Bool
    ListMarker -> ListMarker -> Ordering
    ListMarker -> ListMarker -> ListMarker
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: ListMarker -> ListMarker -> ListMarker
    $cmin :: ListMarker -> ListMarker -> ListMarker
    max :: ListMarker -> ListMarker -> ListMarker
    $cmax :: ListMarker -> ListMarker -> ListMarker
    >= :: ListMarker -> ListMarker -> Bool
    $c>= :: ListMarker -> ListMarker -> Bool
    > :: ListMarker -> ListMarker -> Bool
    $c> :: ListMarker -> ListMarker -> Bool
    <= :: ListMarker -> ListMarker -> Bool
    $c<= :: ListMarker -> ListMarker -> Bool
    < :: ListMarker -> ListMarker -> Bool
    $c< :: ListMarker -> ListMarker -> Bool
    compare :: ListMarker -> ListMarker -> Ordering
    $ccompare :: ListMarker -> ListMarker -> Ordering
    $cp1Ord :: Eq ListMarker
    Ord)

    listMarkerToId :: ListMarker -> String
    listMarkerToId :: ListMarker -> String
    listMarkerToId NoMarker = "990"
    listMarkerToId BulletMarker = "991"
    listMarkerToId (NumberMarker sty :: ListNumberStyle
    sty delim :: ListNumberDelim
    delim n :: Int
    n) =
      '9' Char -> ShowS
    forall a. a -> [a] -> [a]
    : '9' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    styNum Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    delimNum Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    n
      where styNum :: Char
    styNum = case ListNumberStyle
    sty of
                          DefaultStyle -> '2'
                          Example      -> '3'
                          Decimal      -> '4'
                          LowerRoman   -> '5'
                          UpperRoman   -> '6'
                          LowerAlpha   -> '7'
                          UpperAlpha   -> '8'
            delimNum :: Char
    delimNum = case ListNumberDelim
    delim of
                          DefaultDelim -> '0'
                          Period       -> '1'
                          OneParen     -> '2'
                          TwoParens    -> '3'

    data EnvProps = EnvProps{ EnvProps -> Maybe Element
    styleElement  :: Maybe Element
                            , EnvProps -> [Element]
    otherElements :: [Element]
                            }

    instance Semigroup EnvProps where
      EnvProps Nothing es :: [Element]
    es <> :: EnvProps -> EnvProps -> EnvProps
    <> EnvProps s :: Maybe Element
    s es' :: [Element]
    es' = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    s ([Element]
    es [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    es')
      EnvProps s :: Maybe Element
    s       es :: [Element]
    es <> EnvProps _ es' :: [Element]
    es' = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    s ([Element]
    es [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    es')

    instance Monoid EnvProps where
      mempty :: EnvProps
    mempty = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    forall a. Maybe a
    Nothing []
      mappend :: EnvProps -> EnvProps -> EnvProps
    mappend = EnvProps -> EnvProps -> EnvProps
    forall a. Semigroup a => a -> a -> a
    (<>)

    squashProps :: EnvProps -> [Element]
    squashProps :: EnvProps -> [Element]
    squashProps (EnvProps Nothing es :: [Element]
    es) = [Element]
    es
    squashProps (EnvProps (Just e :: Element
    e) es :: [Element]
    es) = Element
    e Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    es

    data WriterEnv = WriterEnv{ WriterEnv -> EnvProps
    envTextProperties :: EnvProps
                              , WriterEnv -> EnvProps
    envParaProperties :: EnvProps
                              , WriterEnv -> Bool
    envRTL            :: Bool
                              , WriterEnv -> Int
    envListLevel      :: Int
                              , WriterEnv -> Int
    envListNumId      :: Int
                              , WriterEnv -> Bool
    envInDel          :: Bool
                              , WriterEnv -> Text
    envChangesAuthor  :: T.Text
                              , WriterEnv -> Text
    envChangesDate    :: T.Text
                              , WriterEnv -> Integer
    envPrintWidth     :: Integer
                              }

    defaultWriterEnv :: WriterEnv
    defaultWriterEnv :: WriterEnv
    defaultWriterEnv = WriterEnv :: EnvProps
    -> EnvProps
    -> Bool
    -> Int
    -> Int
    -> Bool
    -> Text
    -> Text
    -> Integer
    -> WriterEnv
    WriterEnv{ envTextProperties :: EnvProps
    envTextProperties = EnvProps
    forall a. Monoid a => a
    mempty
                                , envParaProperties :: EnvProps
    envParaProperties = EnvProps
    forall a. Monoid a => a
    mempty
                                , envRTL :: Bool
    envRTL = Bool
    False
                                , envListLevel :: Int
    envListLevel = -1
                                , envListNumId :: Int
    envListNumId = 1
                                , envInDel :: Bool
    envInDel = Bool
    False
                                , envChangesAuthor :: Text
    envChangesAuthor  = "unknown"
                                , envChangesDate :: Text
    envChangesDate    = "1969-12-31T19:00:00Z"
                                , envPrintWidth :: Integer
    envPrintWidth     = 1
                                }

    data WriterState = WriterState{
             WriterState -> [Element]
    stFootnotes      :: [Element]
           , WriterState -> [([(Text, Text)], [Inline])]
    stComments       :: [([(T.Text, T.Text)], [Inline])]
           , WriterState -> Set Text
    stSectionIds     :: Set.Set T.Text
           , WriterState -> Map String String
    stExternalLinks  :: M.Map String String
           , WriterState -> Map String (String, String, Maybe Text, ByteString)
    stImages         :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
           , WriterState -> [ListMarker]
    stLists          :: [ListMarker]
           , WriterState -> Int
    stInsId          :: Int
           , WriterState -> Int
    stDelId          :: Int
           , WriterState -> StyleMaps
    stStyleMaps      :: StyleMaps
           , WriterState -> Bool
    stFirstPara      :: Bool
           , WriterState -> Bool
    stInTable        :: Bool
           , WriterState -> Bool
    stInList         :: Bool
           , WriterState -> [Inline]
    stTocTitle       :: [Inline]
           , WriterState -> Set ParaStyleName
    stDynamicParaProps :: Set.Set ParaStyleName
           , WriterState -> Set CharStyleName
    stDynamicTextProps :: Set.Set CharStyleName
           , WriterState -> Int
    stCurId          :: Int
           }

    defaultWriterState :: WriterState
    defaultWriterState :: WriterState
    defaultWriterState = WriterState :: [Element]
    -> [([(Text, Text)], [Inline])]
    -> Set Text
    -> Map String String
    -> Map String (String, String, Maybe Text, ByteString)
    -> [ListMarker]
    -> Int
    -> Int
    -> StyleMaps
    -> Bool
    -> Bool
    -> Bool
    -> [Inline]
    -> Set ParaStyleName
    -> Set CharStyleName
    -> Int
    -> WriterState
    WriterState{
            stFootnotes :: [Element]
    stFootnotes      = [Element]
    defaultFootnotes
          , stComments :: [([(Text, Text)], [Inline])]
    stComments       = []
          , stSectionIds :: Set Text
    stSectionIds     = Set Text
    forall a. Set a
    Set.empty
          , stExternalLinks :: Map String String
    stExternalLinks  = Map String String
    forall k a. Map k a
    M.empty
          , stImages :: Map String (String, String, Maybe Text, ByteString)
    stImages         = Map String (String, String, Maybe Text, ByteString)
    forall k a. Map k a
    M.empty
          , stLists :: [ListMarker]
    stLists          = [ListMarker
    NoMarker]
          , stInsId :: Int
    stInsId          = 1
          , stDelId :: Int
    stDelId          = 1
          , stStyleMaps :: StyleMaps
    stStyleMaps      = CharStyleNameMap -> ParaStyleNameMap -> StyleMaps
    StyleMaps CharStyleNameMap
    forall k a. Map k a
    M.empty ParaStyleNameMap
    forall k a. Map k a
    M.empty
          , stFirstPara :: Bool
    stFirstPara      = Bool
    False
          , stInTable :: Bool
    stInTable        = Bool
    False
          , stInList :: Bool
    stInList         = Bool
    False
          , stTocTitle :: [Inline]
    stTocTitle       = [Text -> Inline
    Str "Table of Contents"]
          , stDynamicParaProps :: Set ParaStyleName
    stDynamicParaProps = Set ParaStyleName
    forall a. Set a
    Set.empty
          , stDynamicTextProps :: Set CharStyleName
    stDynamicTextProps = Set CharStyleName
    forall a. Set a
    Set.empty
          , stCurId :: Int
    stCurId          = 20
          }

    type WS m = ReaderT WriterEnv (StateT WriterState m)

    renumIdMap :: Int -> [Element] -> M.Map String String
    renumIdMap :: Int -> [Element] -> Map String String
    renumIdMap _ [] = Map String String
    forall k a. Map k a
    M.empty
    renumIdMap n :: Int
    n (e :: Element
    e:es :: [Element]
    es)
      | Just oldId :: String
    oldId <- QName -> Element -> Maybe String
    findAttr (String -> Maybe String -> Maybe String -> QName
    QName "Id" Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing) Element
    e =
          String -> String -> Map String String -> Map String String
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    oldId ("rId" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n) (Int -> [Element] -> Map String String
    renumIdMap (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) [Element]
    es)
      | Bool
    otherwise = Int -> [Element] -> Map String String
    renumIdMap Int
    n [Element]
    es

    replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr]
    replaceAttr :: (QName -> Bool) -> String -> [Attr] -> [Attr]
    replaceAttr _ _ [] = []
    replaceAttr f :: QName -> Bool
    f val :: String
    val (a :: Attr
    a:as :: [Attr]
    as) | QName -> Bool
    f (Attr -> QName
    attrKey Attr
    a) =
                                 QName -> String -> Attr
    XML.Attr (Attr -> QName
    attrKey Attr
    a) String
    val Attr -> [Attr] -> [Attr]
    forall a. a -> [a] -> [a]
    : (QName -> Bool) -> String -> [Attr] -> [Attr]
    replaceAttr QName -> Bool
    f String
    val [Attr]
    as
                             | Bool
    otherwise = Attr
    a Attr -> [Attr] -> [Attr]
    forall a. a -> [a] -> [a]
    : (QName -> Bool) -> String -> [Attr] -> [Attr]
    replaceAttr QName -> Bool
    f String
    val [Attr]
    as

    renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element
    renumId :: (QName -> Bool) -> Map String String -> Element -> Element
    renumId f :: QName -> Bool
    f renumMap :: Map String String
    renumMap e :: Element
    e
      | Just oldId :: String
    oldId <- (QName -> Bool) -> Element -> Maybe String
    findAttrBy QName -> Bool
    f Element
    e
      , Just newId :: String
    newId <- String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    oldId Map String String
    renumMap =
        let attrs' :: [Attr]
    attrs' = (QName -> Bool) -> String -> [Attr] -> [Attr]
    replaceAttr QName -> Bool
    f String
    newId (Element -> [Attr]
    elAttribs Element
    e)
        in
         Element
    e { elAttribs :: [Attr]
    elAttribs = [Attr]
    attrs' }
      | Bool
    otherwise = Element
    e

    renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element]
    renumIds :: (QName -> Bool) -> Map String String -> [Element] -> [Element]
    renumIds f :: QName -> Bool
    f renumMap :: Map String String
    renumMap = (Element -> Element) -> [Element] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map ((QName -> Bool) -> Map String String -> Element -> Element
    renumId QName -> Bool
    f Map String String
    renumMap)

    findAttrTextBy :: (QName -> Bool) -> Element -> Maybe T.Text
    findAttrTextBy :: (QName -> Bool) -> Element -> Maybe Text
    findAttrTextBy x :: QName -> Bool
    x = (String -> Text) -> Maybe String -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    T.pack (Maybe String -> Maybe Text)
    -> (Element -> Maybe String) -> Element -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName -> Bool) -> Element -> Maybe String
    findAttrBy QName -> Bool
    x

    lookupAttrTextBy :: (QName -> Bool) -> [XML.Attr] -> Maybe T.Text
    lookupAttrTextBy :: (QName -> Bool) -> [Attr] -> Maybe Text
    lookupAttrTextBy x :: QName -> Bool
    x = (String -> Text) -> Maybe String -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    T.pack (Maybe String -> Maybe Text)
    -> ([Attr] -> Maybe String) -> [Attr] -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName -> Bool) -> [Attr] -> Maybe String
    lookupAttrBy QName -> Bool
    x

    -- | Certain characters are invalid in XML even if escaped.
    -- See #1992
    stripInvalidChars :: T.Text -> T.Text
    stripInvalidChars :: Text -> Text
    stripInvalidChars = (Char -> Bool) -> Text -> Text
    T.filter Char -> Bool
    isValidChar

    -- | See XML reference
    isValidChar :: Char -> Bool
    isValidChar :: Char -> Bool
    isValidChar (Char -> Int
    ord -> Int
    c)
      | Int
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0x9                      = Bool
    True
      | Int
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0xA                      = Bool
    True
      | Int
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0xD                      = Bool
    True
      | 0x20 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c Bool -> Bool -> Bool
    &&  Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0xD7FF     = Bool
    True
      | 0xE000 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c Bool -> Bool -> Bool
    && Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0xFFFD    = Bool
    True
      | 0x10000 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c Bool -> Bool -> Bool
    && Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0x10FFFF = Bool
    True
      | Bool
    otherwise                     = Bool
    False

    writeDocx :: (PandocMonad m)
              => WriterOptions  -- ^ Writer options
              -> Pandoc         -- ^ Document to convert
              -> m BL.ByteString
    writeDocx :: WriterOptions -> Pandoc -> m ByteString
    writeDocx opts :: WriterOptions
    opts doc :: Pandoc
    doc@(Pandoc meta :: Meta
    meta _) = do
      let doc' :: Pandoc
    doc' = (Block -> Block) -> Pandoc -> Pandoc
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Block -> Block
    fixDisplayMath Pandoc
    doc
      Maybe Text
    username <- Text -> m (Maybe Text)
    forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
    P.lookupEnv "USERNAME"
      UTCTime
    utctime <- m UTCTime
    forall (m :: * -> *). PandocMonad m => m UTCTime
    P.getCurrentTime
      Archive
    distArchive <- ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
        Maybe String
    oldUserDataDir <- m (Maybe String)
    forall (m :: * -> *). PandocMonad m => m (Maybe String)
    P.getUserDataDir
        Maybe String -> m ()
    forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
    P.setUserDataDir Maybe String
    forall a. Maybe a
    Nothing
        ByteString
    res <- String -> m ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    P.readDefaultDataFile "reference.docx"
        Maybe String -> m ()
    forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
    P.setUserDataDir Maybe String
    oldUserDataDir
        ByteString -> m ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    res
      Archive
    refArchive <- case WriterOptions -> Maybe String
    writerReferenceDoc WriterOptions
    opts of
                         Just f :: String
    f  -> ByteString -> Archive
    toArchive (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> m ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    P.readFileLazy String
    f
                         Nothing -> ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            String -> m ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    P.readDataFile "reference.docx"

      Element
    parsedDoc <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive "word/document.xml"
      let wname :: (String -> Bool) -> QName -> Bool
    wname f :: String -> Bool
    f qn :: QName
    qn = QName -> Maybe String
    qPrefix QName
    qn Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just "w" Bool -> Bool -> Bool
    && String -> Bool
    f (QName -> String
    qName QName
    qn)
      let mbsectpr :: Maybe Element
    mbsectpr = (QName -> Bool) -> Element -> Maybe Element
    filterElementName ((String -> Bool) -> QName -> Bool
    wname (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="sectPr")) Element
    parsedDoc

      -- Gets the template size
      let mbpgsz :: Maybe Element
    mbpgsz = Maybe Element
    mbsectpr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (QName -> Bool) -> Element -> Maybe Element
    filterElementName ((String -> Bool) -> QName -> Bool
    wname (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="pgSz"))
      let mbAttrSzWidth :: Maybe Text
    mbAttrSzWidth = (Element -> [Attr]
    elAttribs (Element -> [Attr]) -> Maybe Element -> Maybe [Attr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Element
    mbpgsz) Maybe [Attr] -> ([Attr] -> Maybe Text) -> Maybe Text
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (QName -> Bool) -> [Attr] -> Maybe Text
    lookupAttrTextBy ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="w") (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qName)

      let mbpgmar :: Maybe Element
    mbpgmar = Maybe Element
    mbsectpr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (QName -> Bool) -> Element -> Maybe Element
    filterElementName ((String -> Bool) -> QName -> Bool
    wname (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="pgMar"))
      let mbAttrMarLeft :: Maybe Text
    mbAttrMarLeft = (Element -> [Attr]
    elAttribs (Element -> [Attr]) -> Maybe Element -> Maybe [Attr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Element
    mbpgmar) Maybe [Attr] -> ([Attr] -> Maybe Text) -> Maybe Text
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (QName -> Bool) -> [Attr] -> Maybe Text
    lookupAttrTextBy ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="left") (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qName)
      let mbAttrMarRight :: Maybe Text
    mbAttrMarRight = (Element -> [Attr]
    elAttribs (Element -> [Attr]) -> Maybe Element -> Maybe [Attr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Element
    mbpgmar) Maybe [Attr] -> ([Attr] -> Maybe Text) -> Maybe Text
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (QName -> Bool) -> [Attr] -> Maybe Text
    lookupAttrTextBy ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    =="right") (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qName)

      -- Get the available area (converting the size and the margins to int and
      -- doing the difference
      let pgContentWidth :: Maybe Integer
    pgContentWidth = Maybe Text
    mbAttrSzWidth Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Integer
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead
                           Maybe Integer -> (Integer -> Maybe Integer) -> Maybe Integer
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe Text -> Integer -> Maybe Integer
    forall b. (Read b, Num b) => Maybe Text -> b -> Maybe b
    subtrct Maybe Text
    mbAttrMarRight
                           Maybe Integer -> (Integer -> Maybe Integer) -> Maybe Integer
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe Text -> Integer -> Maybe Integer
    forall b. (Read b, Num b) => Maybe Text -> b -> Maybe b
    subtrct Maybe Text
    mbAttrMarLeft
            where
              subtrct :: Maybe Text -> b -> Maybe b
    subtrct mbStr :: Maybe Text
    mbStr x :: b
    x = Maybe Text
    mbStr Maybe Text -> (Text -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe b
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Maybe b -> (b -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\y :: b
    y -> b -> Maybe b
    forall a. a -> Maybe a
    Just (b -> Maybe b) -> b -> Maybe b
    forall a b. (a -> b) -> a -> b
    $ b
    x b -> b -> b
    forall a. Num a => a -> a -> a
    - b
    y)

      -- styles
      Maybe Lang
    mblang <- Maybe Text -> m (Maybe Lang)
    forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
    toLang (Maybe Text -> m (Maybe Lang)) -> Maybe Text -> m (Maybe Lang)
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Meta -> Maybe Text
    getLang WriterOptions
    opts Meta
    meta
      let addLang :: Element -> Element
          addLang :: Element -> Element
    addLang e :: Element
    e = case Maybe Lang
    mblang Maybe Lang -> (Lang -> Maybe Content) -> Maybe Content
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \l :: Lang
    l ->
                             (Content -> Maybe Content
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Content -> Maybe Content)
    -> (Element -> Content) -> Element -> Maybe Content
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> Content
    XMLC.toTree (Cursor -> Content) -> (Element -> Cursor) -> Element -> Content
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Cursor -> Cursor
    go (Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Lang -> Text
    renderLang Lang
    l)
                                     (Cursor -> Cursor) -> (Element -> Cursor) -> Element -> Cursor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Cursor
    XMLC.fromElement) Element
    e of
                        Just (Elem e' :: Element
    e') -> Element
    e'
                        _              -> Element
    e -- return original
            where go :: String -> Cursor -> Cursor
                  go :: String -> Cursor -> Cursor
    go l :: String
    l cursor :: Cursor
    cursor = case (Cursor -> Bool) -> Cursor -> Maybe Cursor
    XMLC.findRec (Content -> Bool
    isLangElt (Content -> Bool) -> (Cursor -> Content) -> Cursor -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> Content
    current) Cursor
    cursor of
                                  Nothing -> Cursor
    cursor
                                  Just t :: Cursor
    t  -> (Content -> Content) -> Cursor -> Cursor
    XMLC.modifyContent (String -> Content -> Content
    setval String
    l) Cursor
    t
                  setval :: String -> Content -> Content
                  setval :: String -> Content -> Content
    setval l :: String
    l (Elem e' :: Element
    e') = Element -> Content
    Elem (Element -> Content) -> Element -> Content
    forall a b. (a -> b) -> a -> b
    $ Element
    e'{ elAttribs :: [Attr]
    elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Attr -> Attr
    setvalattr String
    l) ([Attr] -> [Attr]) -> [Attr] -> [Attr]
    forall a b. (a -> b) -> a -> b
    $
                                                   Element -> [Attr]
    elAttribs Element
    e' }
                  setval _ x :: Content
    x         = Content
    x
                  setvalattr :: String -> XML.Attr -> XML.Attr
                  setvalattr :: String -> Attr -> Attr
    setvalattr l :: String
    l (XML.Attr qn :: QName
    qn@(QName "val" _ _) _) = QName -> String -> Attr
    XML.Attr QName
    qn String
    l
                  setvalattr _ x :: Attr
    x                                 = Attr
    x
                  isLangElt :: Content -> Bool
    isLangElt (Elem e' :: Element
    e') = QName -> String
    qName (Element -> QName
    elName Element
    e') String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "lang"
                  isLangElt _         = Bool
    False

      let stylepath :: String
    stylepath = "word/styles.xml"
      Element
    styledoc <- Element -> Element
    addLang (Element -> Element) -> m Element -> m Element
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    stylepath

      -- parse styledoc for heading styles
      let styleMaps :: StyleMaps
    styleMaps = Archive -> StyleMaps
    getStyleMaps Archive
    refArchive

      let tocTitle :: [Inline]
    tocTitle = case Text -> Meta -> [Inline]
    lookupMetaInlines "toc-title" Meta
    meta of
                       [] -> WriterState -> [Inline]
    stTocTitle WriterState
    defaultWriterState
                       ls :: [Inline]
    ls -> [Inline]
    ls

      let initialSt :: WriterState
    initialSt = WriterState
    defaultWriterState {
              stStyleMaps :: StyleMaps
    stStyleMaps  = StyleMaps
    styleMaps
            , stTocTitle :: [Inline]
    stTocTitle   = [Inline]
    tocTitle
            }

      let isRTLmeta :: Bool
    isRTLmeta = case Text -> Meta -> Maybe MetaValue
    lookupMeta "dir" Meta
    meta of
            Just (MetaString "rtl")        -> Bool
    True
            Just (MetaInlines [Str "rtl"]) -> Bool
    True
            _                              -> Bool
    False

      let env :: WriterEnv
    env = WriterEnv
    defaultWriterEnv {
              envRTL :: Bool
    envRTL = Bool
    isRTLmeta
            , envChangesAuthor :: Text
    envChangesAuthor = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe "unknown" Maybe Text
    username
            , envChangesDate :: Text
    envChangesDate   = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%FT%XZ" UTCTime
    utctime
            , envPrintWidth :: Integer
    envPrintWidth = Integer -> (Integer -> Integer) -> Maybe Integer -> Integer
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe 420 (Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `quot` 20) Maybe Integer
    pgContentWidth
            }

      ((contents :: [Element]
    contents, footnotes :: [Element]
    footnotes, comments :: [Element]
    comments), st :: WriterState
    st) <- StateT WriterState m ([Element], [Element], [Element])
    -> WriterState
    -> m (([Element], [Element], [Element]), WriterState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT
                             (ReaderT
      WriterEnv (StateT WriterState m) ([Element], [Element], [Element])
    -> WriterEnv
    -> StateT WriterState m ([Element], [Element], [Element])
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT
                              (WriterOptions
    -> Pandoc
    -> ReaderT
         WriterEnv (StateT WriterState m) ([Element], [Element], [Element])
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> WS m ([Element], [Element], [Element])
    writeOpenXML WriterOptions
    opts{writerWrapText :: WrapOption
    writerWrapText = WrapOption
    WrapNone} Pandoc
    doc')
                              WriterEnv
    env)
                             WriterState
    initialSt
      let epochtime :: Integer
    epochtime = POSIXTime -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Integer) -> POSIXTime -> Integer
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> POSIXTime
    utcTimeToPOSIXSeconds UTCTime
    utctime
      let imgs :: [(String, String, Maybe Text, ByteString)]
    imgs = Map String (String, String, Maybe Text, ByteString)
    -> [(String, String, Maybe Text, ByteString)]
    forall k a. Map k a -> [a]
    M.elems (Map String (String, String, Maybe Text, ByteString)
     -> [(String, String, Maybe Text, ByteString)])
    -> Map String (String, String, Maybe Text, ByteString)
    -> [(String, String, Maybe Text, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Map String (String, String, Maybe Text, ByteString)
    stImages WriterState
    st

      -- create entries for images in word/media/...
      let toImageEntry :: (a, String, c, ByteString) -> Entry
    toImageEntry (_,path :: String
    path,_,img :: ByteString
    img) = String -> Integer -> ByteString -> Entry
    toEntry ("word/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    path) Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    toLazy ByteString
    img
      let imageEntries :: [Entry]
    imageEntries = ((String, String, Maybe Text, ByteString) -> Entry)
    -> [(String, String, Maybe Text, ByteString)] -> [Entry]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, Maybe Text, ByteString) -> Entry
    forall a c. (a, String, c, ByteString) -> Entry
    toImageEntry [(String, String, Maybe Text, ByteString)]
    imgs

      let stdAttributes :: [(String, String)]
    stdAttributes =
                [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
                ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
                ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")
                ,("xmlns:o","urn:schemas-microsoft-com:office:office")
                ,("xmlns:v","urn:schemas-microsoft-com:vml")
                ,("xmlns:w10","urn:schemas-microsoft-com:office:word")
                ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
                ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
                ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]

      Element
    parsedRels <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive "word/_rels/document.xml.rels"
      let isHeaderNode :: Element -> Bool
    isHeaderNode e :: Element
    e = QName -> Element -> Maybe String
    findAttr (String -> Maybe String -> Maybe String -> QName
    QName "Type" Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing) Element
    e Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"
      let isFooterNode :: Element -> Bool
    isFooterNode e :: Element
    e = QName -> Element -> Maybe String
    findAttr (String -> Maybe String -> Maybe String -> QName
    QName "Type" Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing) Element
    e Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer"
      let headers :: [Element]
    headers = (Element -> Bool) -> Element -> [Element]
    filterElements Element -> Bool
    isHeaderNode Element
    parsedRels
      let footers :: [Element]
    footers = (Element -> Bool) -> Element -> [Element]
    filterElements Element -> Bool
    isFooterNode Element
    parsedRels

      let extractTarget :: Element -> Maybe String
    extractTarget = QName -> Element -> Maybe String
    findAttr (String -> Maybe String -> Maybe String -> QName
    QName "Target" Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)

      -- we create [Content_Types].xml and word/_rels/document.xml.rels
      -- from scratch rather than reading from reference.docx,
      -- because Word sometimes changes these files when a reference.docx is modified,
      -- e.g. deleting the reference to footnotes.xml or removing default entries
      -- for image content types.

      -- [Content_Types].xml
      let mkOverrideNode :: (String, String) -> Element
    mkOverrideNode (part' :: String
    part', contentType' :: String
    contentType') = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Override"
                   [("PartName",String
    part'),("ContentType",String
    contentType')] ()
      let mkImageOverride :: (a, String, Maybe Text, d) -> Element
    mkImageOverride (_, imgpath :: String
    imgpath, mbMimeType :: Maybe Text
    mbMimeType, _) =
              (String, String) -> Element
    mkOverrideNode ("/word/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    imgpath,
                              String -> (Text -> String) -> Maybe Text -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "application/octet-stream" Text -> String
    T.unpack Maybe Text
    mbMimeType)
      let mkMediaOverride :: String -> Element
    mkMediaOverride imgpath :: String
    imgpath =
              (String, String) -> Element
    mkOverrideNode ('/'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    imgpath, Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    getMimeTypeDef String
    imgpath)
      let overrides :: [Element]
    overrides = ((String, String) -> Element) -> [(String, String)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> Element
    mkOverrideNode (
                      [("/word/webSettings.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")
                      ,("/word/numbering.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.numbering+xml")
                      ,("/word/settings.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.settings+xml")
                      ,("/word/theme/theme1.xml",
                        "application/vnd.openxmlformats-officedocument.theme+xml")
                      ,("/word/fontTable.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.fontTable+xml")
                      ,("/docProps/app.xml",
                        "application/vnd.openxmlformats-officedocument.extended-properties+xml")
                      ,("/docProps/core.xml",
                        "application/vnd.openxmlformats-package.core-properties+xml")
                      ,("/docProps/custom.xml",
                        "application/vnd.openxmlformats-officedocument.custom-properties+xml")
                      ,("/word/styles.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml")
                      ,("/word/document.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")
                      ,("/word/comments.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml")
                      ,("/word/footnotes.xml",
                        "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
                      ] [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++
                      (Element -> (String, String)) -> [Element] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\x :: Element
    x -> (String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ("/word/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ Element -> Maybe String
    extractTarget Element
    x,
                           "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) [Element]
    headers [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++
                      (Element -> (String, String)) -> [Element] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\x :: Element
    x -> (String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ("/word/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ Element -> Maybe String
    extractTarget Element
    x,
                           "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) [Element]
    footers) [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                        ((String, String, Maybe Text, ByteString) -> Element)
    -> [(String, String, Maybe Text, ByteString)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, Maybe Text, ByteString) -> Element
    forall a d. (a, String, Maybe Text, d) -> Element
    mkImageOverride [(String, String, Maybe Text, ByteString)]
    imgs [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                        [ String -> Element
    mkMediaOverride (Entry -> String
    eRelativePath Entry
    e) | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                                            , "word/media/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e ]

      let defaultnodes :: [Element]
    defaultnodes = [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Default"
                  [("Extension","xml"),("ContentType","application/xml")] (),
                 String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Default"
                  [("Extension","rels"),("ContentType","application/vnd.openxmlformats-package.relationships+xml")] ()]
      let contentTypesDoc :: Element
    contentTypesDoc = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Types" [("xmlns","http://schemas.openxmlformats.org/package/2006/content-types")] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ [Element]
    defaultnodes [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    overrides
      let contentTypesEntry :: Entry
    contentTypesEntry = String -> Integer -> ByteString -> Entry
    toEntry "[Content_Types].xml" Integer
    epochtime
            (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    contentTypesDoc

      -- word/_rels/document.xml.rels
      let toBaseRel :: (String, String, String) -> Element
    toBaseRel (url' :: String
    url', id' :: String
    id', target' :: String
    target') = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationship"
                                              [("Type",String
    url')
                                              ,("Id",String
    id')
                                              ,("Target",String
    target')] ()
      let baserels' :: [Element]
    baserels' = ((String, String, String) -> Element)
    -> [(String, String, String)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, String) -> Element
    toBaseRel
                        [("http://schemas.openxmlformats.org/officeDocument/2006/relationships/numbering",
                          "rId1",
                          "numbering.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles",
                          "rId2",
                          "styles.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/settings",
                          "rId3",
                          "settings.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/webSettings",
                          "rId4",
                          "webSettings.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/fontTable",
                          "rId5",
                          "fontTable.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/theme",
                          "rId6",
                          "theme/theme1.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
                          "rId7",
                          "footnotes.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
                          "rId8",
                          "comments.xml")
                        ]

      let idMap :: Map String String
    idMap = Int -> [Element] -> Map String String
    renumIdMap ([Element] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    baserels' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) ([Element]
    headers [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    footers)
      let renumHeaders :: [Element]
    renumHeaders = (QName -> Bool) -> Map String String -> [Element] -> [Element]
    renumIds (\q :: QName
    q -> QName -> String
    qName QName
    q String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "Id") Map String String
    idMap [Element]
    headers
      let renumFooters :: [Element]
    renumFooters = (QName -> Bool) -> Map String String -> [Element] -> [Element]
    renumIds (\q :: QName
    q -> QName -> String
    qName QName
    q String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "Id") Map String String
    idMap [Element]
    footers
      let baserels :: [Element]
    baserels = [Element]
    baserels' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    renumHeaders [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    renumFooters
      let toImgRel :: (String, String, c, d) -> Element
    toImgRel (ident :: String
    ident,path :: String
    path,_,_) =  String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",String
    ident),("Target",String
    path)] ()
      let imgrels :: [Element]
    imgrels = ((String, String, Maybe Text, ByteString) -> Element)
    -> [(String, String, Maybe Text, ByteString)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, Maybe Text, ByteString) -> Element
    forall c d. (String, String, c, d) -> Element
    toImgRel [(String, String, Maybe Text, ByteString)]
    imgs
      let toLinkRel :: (String, String) -> Element
    toLinkRel (src :: String
    src,ident :: String
    ident) =  String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",String
    ident),("Target",String
    src),("TargetMode","External") ] ()
      let linkrels :: [Element]
    linkrels = ((String, String) -> Element) -> [(String, String)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> Element
    toLinkRel ([(String, String)] -> [Element])
    -> [(String, String)] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map String String -> [(String, String)])
    -> Map String String -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Map String String
    stExternalLinks WriterState
    st
      let reldoc :: Element
    reldoc = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ [Element]
    baserels [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    imgrels [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    linkrels
      let relEntry :: Entry
    relEntry = String -> Integer -> ByteString -> Entry
    toEntry "word/_rels/document.xml.rels" Integer
    epochtime
            (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    reldoc

      -- adjust contents to add sectPr from reference.docx
      let sectpr :: Element
    sectpr = case Maybe Element
    mbsectpr of
            Just sectpr' :: Element
    sectpr' -> let cs :: [Element]
    cs = (QName -> Bool) -> Map String String -> [Element] -> [Element]
    renumIds
                                     (\q :: QName
    q -> QName -> String
    qName QName
    q String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "id" Bool -> Bool -> Bool
    && QName -> Maybe String
    qPrefix QName
    q Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just "r")
                                     Map String String
    idMap
                                     (Element -> [Element]
    elChildren Element
    sectpr')
                            in
                             [Attr] -> Element -> Element
    add_attrs (Element -> [Attr]
    elAttribs Element
    sectpr') (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:sectPr" [] [Element]
    cs
            Nothing      -> String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:sectPr" [] ()

      -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr'
      let contents' :: [Element]
    contents' = [Element]
    contents [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element
    sectpr]
      let docContents :: Element
    docContents = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:document" [(String, String)]
    stdAttributes
                        (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:body" [] [Element]
    contents'

      -- word/document.xml
      let contentEntry :: Entry
    contentEntry = String -> Integer -> ByteString -> Entry
    toEntry "word/document.xml" Integer
    epochtime
                         (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    docContents

      -- footnotes
      let notes :: Element
    notes = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnotes" [(String, String)]
    stdAttributes [Element]
    footnotes
      let footnotesEntry :: Entry
    footnotesEntry = String -> Integer -> ByteString -> Entry
    toEntry "word/footnotes.xml" Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    notes

      -- footnote rels
      let footnoteRelEntry :: Entry
    footnoteRelEntry = String -> Integer -> ByteString -> Entry
    toEntry "word/_rels/footnotes.xml.rels" Integer
    epochtime
            (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml (Element -> ByteString) -> Element -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
            [Element]
    linkrels

      -- comments
      let commentsEntry :: Entry
    commentsEntry = String -> Integer -> ByteString -> Entry
    toEntry "word/comments.xml" Integer
    epochtime
            (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml (Element -> ByteString) -> Element -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:comments" [(String, String)]
    stdAttributes [Element]
    comments

      -- styles

      -- We only want to inject paragraph and text properties that
      -- are not already in the style map. Note that keys in the stylemap
      -- are normalized as lowercase.
      let newDynamicParaProps :: [ParaStyleName]
    newDynamicParaProps = (ParaStyleName -> Bool) -> [ParaStyleName] -> [ParaStyleName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
            (\sty :: ParaStyleName
    sty -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ParaStyleName -> ParaStyleNameMap -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName ParaStyleName
    sty (ParaStyleNameMap -> Bool) -> ParaStyleNameMap -> Bool
    forall a b. (a -> b) -> a -> b
    $ StyleMaps -> ParaStyleNameMap
    smParaStyle StyleMaps
    styleMaps)
            (Set ParaStyleName -> [ParaStyleName]
    forall a. Set a -> [a]
    Set.toList (Set ParaStyleName -> [ParaStyleName])
    -> Set ParaStyleName -> [ParaStyleName]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Set ParaStyleName
    stDynamicParaProps WriterState
    st)

          newDynamicTextProps :: [CharStyleName]
    newDynamicTextProps = (CharStyleName -> Bool) -> [CharStyleName] -> [CharStyleName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
            (\sty :: CharStyleName
    sty -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ CharStyleName -> CharStyleNameMap -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName CharStyleName
    sty (CharStyleNameMap -> Bool) -> CharStyleNameMap -> Bool
    forall a b. (a -> b) -> a -> b
    $ StyleMaps -> CharStyleNameMap
    smCharStyle StyleMaps
    styleMaps)
            (Set CharStyleName -> [CharStyleName]
    forall a. Set a -> [a]
    Set.toList (Set CharStyleName -> [CharStyleName])
    -> Set CharStyleName -> [CharStyleName]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Set CharStyleName
    stDynamicTextProps WriterState
    st)

      let newstyles :: [Element]
    newstyles = (ParaStyleName -> Element) -> [ParaStyleName] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map ParaStyleName -> Element
    newParaPropToOpenXml [ParaStyleName]
    newDynamicParaProps [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                      (CharStyleName -> Element) -> [CharStyleName] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map CharStyleName -> Element
    newTextPropToOpenXml [CharStyleName]
    newDynamicTextProps [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                      (case WriterOptions -> Maybe Style
    writerHighlightStyle WriterOptions
    opts of
                            Nothing  -> []
                            Just sty :: Style
    sty -> StyleMaps -> Style -> [Element]
    styleToOpenXml StyleMaps
    styleMaps Style
    sty)
      let styledoc' :: Element
    styledoc' = Element
    styledoc{ elContent :: [Content]
    elContent = Element -> [Content]
    elContent Element
    styledoc [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++
                                               (Element -> Content) -> [Element] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Content
    Elem [Element]
    newstyles }
      let styleEntry :: Entry
    styleEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    stylepath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    styledoc'

      -- construct word/numbering.xml
      let numpath :: String
    numpath = "word/numbering.xml"
      Element
    numbering <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    numpath
      [Element]
    newNumElts <- [ListMarker] -> m [Element]
    forall (m :: * -> *). PandocMonad m => [ListMarker] -> m [Element]
    mkNumbering (WriterState -> [ListMarker]
    stLists WriterState
    st)
      let pandocAdded :: Element -> Bool
    pandocAdded e :: Element
    e =
           case (QName -> Bool) -> Element -> Maybe Text
    findAttrTextBy ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "abstractNumId") (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qName) Element
    e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead of
             Just numid :: Int
    numid -> Int
    numid Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (990 :: Int)
             Nothing    ->
               case (QName -> Bool) -> Element -> Maybe Text
    findAttrTextBy ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "numId") (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qName) Element
    e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead of
                 Just numid :: Int
    numid -> Int
    numid Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (1000 :: Int)
                 Nothing    -> Bool
    False
      let oldElts :: [Element]
    oldElts = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Element -> Bool) -> Element -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Bool
    pandocAdded) ([Element] -> [Element]) -> [Element] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ [Content] -> [Element]
    onlyElems (Element -> [Content]
    elContent Element
    numbering)
      let allElts :: [Element]
    allElts = [Element]
    oldElts [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    newNumElts
      let numEntry :: Entry
    numEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    numpath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    numbering{ elContent :: [Content]
    elContent =
                           -- we want all the abstractNums first, then the nums,
                           -- otherwise things break:
                           [Element -> Content
    Elem Element
    e | Element
    e <- [Element]
    allElts
                                   , QName -> String
    qName (Element -> QName
    elName Element
    e) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "abstractNum" ] [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++
                           [Element -> Content
    Elem Element
    e | Element
    e <- [Element]
    allElts
                                   , QName -> String
    qName (Element -> QName
    elName Element
    e) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "num" ] }

      let keywords :: [Text]
    keywords = case Text -> Meta -> Maybe MetaValue
    lookupMeta "keywords" Meta
    meta of
                           Just (MetaList xs :: [MetaValue]
    xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map MetaValue -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [MetaValue]
    xs
                           _                  -> []

      -- docProps/core.xml
      let docPropsPath :: String
    docPropsPath = "docProps/core.xml"
      let extraCoreProps :: [Text]
    extraCoreProps = ["subject","lang","category","description"]
      let extraCorePropsMap :: Map Text String
    extraCorePropsMap = [(Text, String)] -> Map Text String
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, String)] -> Map Text String)
    -> [(Text, String)] -> Map Text String
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [String] -> [(Text, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    extraCoreProps
                           ["dc:subject","dc:language","cp:category","dc:description"]
      let lookupMetaString' :: T.Text -> Meta -> T.Text
          lookupMetaString' :: Text -> Meta -> Text
    lookupMetaString' key' :: Text
    key' meta' :: Meta
    meta' =
            case Text
    key' of
                 "description"    -> Text -> [Text] -> Text
    T.intercalate "_x000d_\n" ((Block -> Text) -> [Block] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Block -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([Block] -> [Text]) -> [Block] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Meta -> [Block]
    lookupMetaBlocks "description" Meta
    meta')
                 key'' :: Text
    key''            -> Text -> Meta -> Text
    lookupMetaString Text
    key'' Meta
    meta'

      let docProps :: Element
    docProps = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "cp:coreProperties"
              [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
              ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
              ,("xmlns:dcterms","http://purl.org/dc/terms/")
              ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
              ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
              ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Text -> Element
    mktnode "dc:title" [] ([Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([Inline] -> Text) -> [Inline] -> Text
    forall a b. (a -> b) -> a -> b
    $ Meta -> [Inline]
    docTitle Meta
    meta)
              Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : String -> [(String, String)] -> Text -> Element
    mktnode "dc:creator" [] (Text -> [Text] -> Text
    T.intercalate "; " (([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Meta -> [[Inline]]
    docAuthors Meta
    meta))
              Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [ String -> [(String, String)] -> Text -> Element
    mktnode (String -> Text -> Map Text String -> String
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault "" Text
    k Map Text String
    extraCorePropsMap) [] (Text -> Meta -> Text
    lookupMetaString' Text
    k Meta
    meta)
                | Text
    k <- Map Text MetaValue -> [Text]
    forall k a. Map k a -> [k]
    M.keys (Meta -> Map Text MetaValue
    unMeta Meta
    meta), Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    extraCoreProps]
              [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ String -> [(String, String)] -> String -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "cp:keywords" [] (Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    T.intercalate ", " [Text]
    keywords)
              Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : (\x :: String
    x -> [ String -> [(String, String)] -> String -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] String
    x
                       , String -> [(String, String)] -> String -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] String
    x
                       ]) (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%FT%XZ" UTCTime
    utctime)
      let docPropsEntry :: Entry
    docPropsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    docPropsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    docProps

      -- docProps/custom.xml
      let customProperties :: [(String, String)]
          customProperties :: [(String, String)]
    customProperties = [(Text -> String
    T.unpack Text
    k, Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Meta -> Text
    lookupMetaString Text
    k Meta
    meta) | Text
    k <- Map Text MetaValue -> [Text]
    forall k a. Map k a -> [k]
    M.keys (Meta -> Map Text MetaValue
    unMeta Meta
    meta)
                             , Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (["title", "author", "keywords"]
                                           [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text]
    extraCoreProps)]
      let mkCustomProp :: (String, t) -> a -> Element
    mkCustomProp (k :: String
    k, v :: t
    v) pid :: a
    pid = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "property"
             [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
             ,("pid", a -> String
    forall a. Show a => a -> String
    show a
    pid)
             ,("name", String
    k)] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> t -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "vt:lpwstr" [] t
    v
      let customPropsPath :: String
    customPropsPath = "docProps/custom.xml"
      let customProps :: Element
    customProps = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Properties"
              [("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
              ,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
              ] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> Int -> Element)
    -> [(String, String)] -> [Int] -> [Element]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (String, String) -> Int -> Element
    forall a t. (Show a, Node t) => (String, t) -> a -> Element
    mkCustomProp [(String, String)]
    customProperties [(2 :: Int)..]
      let customPropsEntry :: Entry
    customPropsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    customPropsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    customProps

      let relsPath :: String
    relsPath = "_rels/.rels"
      let rels :: Element
    rels = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationships" [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
            ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ ([(String, String)] -> Element)
    -> [[(String, String)]] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (\attrs :: [(String, String)]
    attrs -> String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "Relationship" [(String, String)]
    attrs ())
            [ [("Id","rId1")
              ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")
              ,("Target","word/document.xml")]
            , [("Id","rId4")
              ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties")
              ,("Target","docProps/app.xml")]
            , [("Id","rId3")
              ,("Type","http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties")
              ,("Target","docProps/core.xml")]
            , [("Id","rId5")
              ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties")
              ,("Target","docProps/custom.xml")]
            ]
      let relsEntry :: Entry
    relsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    relsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    rels

      -- we use dist archive for settings.xml, because Word sometimes
      -- adds references to footnotes or endnotes we don't have...
      -- we do, however, copy some settings over from reference
      let settingsPath :: String
    settingsPath = "word/settings.xml"
          settingsList :: [String]
    settingsList = [ "w:autoHyphenation"
                         , "w:consecutiveHyphenLimit"
                         , "w:hyphenationZone"
                         , "w:doNotHyphenateCap"
                         , "w:evenAndOddHeaders"
                         , "w:proofState"
                         ]
      Entry
    settingsEntry <- Archive -> Archive -> String -> Integer -> [String] -> m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> Integer -> [String] -> m Entry
    copyChildren Archive
    refArchive Archive
    distArchive String
    settingsPath Integer
    epochtime [String]
    settingsList

      let entryFromArchive :: Archive -> String -> m Entry
    entryFromArchive arch :: Archive
    arch path :: String
    path =
             m Entry -> (Entry -> m Entry) -> Maybe Entry -> m Entry
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (PandocError -> m Entry
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m Entry) -> PandocError -> m Entry
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError
                               (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    path String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " missing in reference docx")
                   Entry -> m Entry
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                   (String -> Archive -> Maybe Entry
    findEntryByPath String
    path Archive
    arch Maybe Entry -> Maybe Entry -> Maybe Entry
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` String -> Archive -> Maybe Entry
    findEntryByPath String
    path Archive
    distArchive)
      Entry
    docPropsAppEntry <- Archive -> String -> m Entry
    forall (m :: * -> *).
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive "docProps/app.xml"
      Entry
    themeEntry <- Archive -> String -> m Entry
    forall (m :: * -> *).
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive "word/theme/theme1.xml"
      Entry
    fontTableEntry <- Archive -> String -> m Entry
    forall (m :: * -> *).
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive "word/fontTable.xml"
      Entry
    webSettingsEntry <- Archive -> String -> m Entry
    forall (m :: * -> *).
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive "word/webSettings.xml"
      [Entry]
    headerFooterEntries <- (String -> m Entry) -> [String] -> m [Entry]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Archive -> String -> m Entry
    forall (m :: * -> *).
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive) ([String] -> m [Entry]) -> [String] -> m [Entry]
    forall a b. (a -> b) -> a -> b
    $
                         (Element -> Maybe String) -> [Element] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (ShowS -> Maybe String -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ("word/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) (Maybe String -> Maybe String)
    -> (Element -> Maybe String) -> Element -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Maybe String
    extractTarget)
                         ([Element]
    headers [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    footers)
      let miscRelEntries :: [Entry]
    miscRelEntries = [ Entry
    e | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                           , "word/_rels/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e
                           , ".xml.rels" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` Entry -> String
    eRelativePath Entry
    e
                           , Entry -> String
    eRelativePath Entry
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "word/_rels/document.xml.rels"
                           , Entry -> String
    eRelativePath Entry
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "word/_rels/footnotes.xml.rels" ]
      let otherMediaEntries :: [Entry]
    otherMediaEntries = [ Entry
    e | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                              , "word/media/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e ]

      -- Create archive
      let archive :: Archive
    archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Entry -> Archive -> Archive
    addEntryToArchive Archive
    emptyArchive ([Entry] -> Archive) -> [Entry] -> Archive
    forall a b. (a -> b) -> a -> b
    $
                      Entry
    contentTypesEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    relsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    contentEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    relEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    footnoteRelEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    numEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    styleEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    footnotesEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    commentsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    docPropsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    docPropsAppEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    customPropsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    themeEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    fontTableEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    settingsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    webSettingsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      [Entry]
    imageEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    headerFooterEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++
                      [Entry]
    miscRelEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    otherMediaEntries
      ByteString -> m ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> m ByteString) -> ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ Archive -> ByteString
    fromArchive Archive
    archive

    newParaPropToOpenXml :: ParaStyleName -> Element
    newParaPropToOpenXml :: ParaStyleName -> Element
    newParaPropToOpenXml (ParaStyleName -> Text
    forall a. FromStyleName a => a -> Text
    fromStyleName -> Text
    s) =
      let styleId :: Text
    styleId = (Char -> Bool) -> Text -> Text
    T.filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) Text
    s
      in String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:style" [ ("w:type", "paragraph")
                          , ("w:customStyle", "1")
                          , ("w:styleId", Text -> String
    T.unpack Text
    styleId)]
         [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:name" [("w:val", Text -> String
    T.unpack Text
    s)] ()
         , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:basedOn" [("w:val","BodyText")] ()
         , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:qFormat" [] ()
         ]

    newTextPropToOpenXml :: CharStyleName -> Element
    newTextPropToOpenXml :: CharStyleName -> Element
    newTextPropToOpenXml (CharStyleName -> Text
    forall a. FromStyleName a => a -> Text
    fromStyleName -> Text
    s) =
      let styleId :: Text
    styleId = (Char -> Bool) -> Text -> Text
    T.filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) Text
    s
      in String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:style" [ ("w:type", "character")
                          , ("w:customStyle", "1")
                          , ("w:styleId", Text -> String
    T.unpack Text
    styleId)]
         [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:name" [("w:val", Text -> String
    T.unpack Text
    s)] ()
         , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:basedOn" [("w:val","BodyTextChar")] ()
         ]

    styleToOpenXml :: StyleMaps -> Style -> [Element]
    styleToOpenXml :: StyleMaps -> Style -> [Element]
    styleToOpenXml sm :: StyleMaps
    sm style :: Style
    style =
      Maybe Element -> [Element]
    forall a. Maybe a -> [a]
    maybeToList Maybe Element
    parStyle [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ (TokenType -> Maybe Element) -> [TokenType] -> [Element]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TokenType -> Maybe Element
    toStyle [TokenType]
    alltoktypes
      where alltoktypes :: [TokenType]
    alltoktypes = TokenType -> TokenType -> [TokenType]
    forall a. Enum a => a -> a -> [a]
    enumFromTo TokenType
    KeywordTok TokenType
    NormalTok
            toStyle :: TokenType -> Maybe Element
    toStyle toktype :: TokenType
    toktype | CharStyleName -> CharStyleNameMap -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName (String -> CharStyleName
    forall a. IsString a => String -> a
    fromString (String -> CharStyleName) -> String -> CharStyleName
    forall a b. (a -> b) -> a -> b
    $ TokenType -> String
    forall a. Show a => a -> String
    show TokenType
    toktype) (StyleMaps -> CharStyleNameMap
    smCharStyle StyleMaps
    sm) = Maybe Element
    forall a. Maybe a
    Nothing
                            | Bool
    otherwise = Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
                              String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:style" [("w:type","character"),
                               ("w:customStyle","1"),("w:styleId",TokenType -> String
    forall a. Show a => a -> String
    show TokenType
    toktype)]
                                 [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:name" [("w:val",TokenType -> String
    forall a. Show a => a -> String
    show TokenType
    toktype)] ()
                                 , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:basedOn" [("w:val","VerbatimChar")] ()
                                 , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:color" [("w:val",TokenType -> String
    tokCol TokenType
    toktype)] ()
                                     | TokenType -> String
    tokCol TokenType
    toktype String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "auto" ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:shd" [("w:val","clear"),("w:fill",TokenType -> String
    tokBg TokenType
    toktype)] ()
                                     | TokenType -> String
    tokBg TokenType
    toktype String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "auto" ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:b" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenBold TokenType
    toktype ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:i" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenItalic TokenType
    toktype ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:u" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenUnderline TokenType
    toktype ]
                                 ]
            tokStyles :: Map TokenType TokenStyle
    tokStyles = Style -> Map TokenType TokenStyle
    tokenStyles Style
    style
            tokFeature :: (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature f :: TokenStyle -> Bool
    f toktype :: TokenType
    toktype = Bool -> (TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False TokenStyle -> Bool
    f (Maybe TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
    forall a b. (a -> b) -> a -> b
    $ TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles
            tokCol :: TokenType -> String
    tokCol toktype :: TokenType
    toktype = String -> (Color -> String) -> Maybe Color -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "auto" (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 1 ShowS -> (Color -> String) -> Color -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> String
    forall a. FromColor a => Color -> a
    fromColor)
                             (Maybe Color -> String) -> Maybe Color -> String
    forall a b. (a -> b) -> a -> b
    $ (TokenStyle -> Maybe Color
    tokenColor (TokenStyle -> Maybe Color) -> Maybe TokenStyle -> Maybe Color
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles)
                               Maybe Color -> Maybe Color -> Maybe Color
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Style -> Maybe Color
    defaultColor Style
    style
            tokBg :: TokenType -> String
    tokBg toktype :: TokenType
    toktype = String -> (Color -> String) -> Maybe Color -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "auto" (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 1 ShowS -> (Color -> String) -> Color -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> String
    forall a. FromColor a => Color -> a
    fromColor)
                             (Maybe Color -> String) -> Maybe Color -> String
    forall a b. (a -> b) -> a -> b
    $ (TokenStyle -> Maybe Color
    tokenBackground (TokenStyle -> Maybe Color) -> Maybe TokenStyle -> Maybe Color
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles)
                               Maybe Color -> Maybe Color -> Maybe Color
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Style -> Maybe Color
    backgroundColor Style
    style
            parStyle :: Maybe Element
    parStyle | ParaStyleName -> ParaStyleNameMap -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName "Source Code" (StyleMaps -> ParaStyleNameMap
    smParaStyle StyleMaps
    sm) = Maybe Element
    forall a. Maybe a
    Nothing
                     | Bool
    otherwise = Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
                       String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:style" [("w:type","paragraph"),
                               ("w:customStyle","1"),("w:styleId","SourceCode")]
                                 [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:name" [("w:val","Source Code")] ()
                                 , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:basedOn" [("w:val","Normal")] ()
                                 , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:link" [("w:val","VerbatimChar")] ()
                                 , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" []
                                   ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:wordWrap" [("w:val","off")] ()
                                   Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
                             [Element] -> (Color -> [Element]) -> Maybe Color -> [Element]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\col :: Color
    col -> [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:shd" [("w:val","clear"),("w:fill",Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 1 ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Color -> String
    forall a. FromColor a => Color -> a
    fromColor Color
    col)] ()]) (Style -> Maybe Color
    backgroundColor Style
    style)
                                 ]

    copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry
    copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> m Entry
    copyChildren refArchive :: Archive
    refArchive distArchive :: Archive
    distArchive path :: String
    path timestamp :: Integer
    timestamp elNames :: [String]
    elNames = do
      Element
    ref  <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    path
      Element
    dist <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    distArchive Archive
    distArchive String
    path
      Entry -> m Entry
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Entry -> m Entry) -> Entry -> m Entry
    forall a b. (a -> b) -> a -> b
    $ String -> Integer -> ByteString -> Entry
    toEntry String
    path Integer
    timestamp (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    dist{
          elContent :: [Content]
    elContent = Element -> [Content]
    elContent Element
    dist [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ Element -> [Content]
    copyContent Element
    ref
        }
      where
        strName :: QName -> String
    strName QName{qName :: QName -> String
    qName=String
    name, qPrefix :: QName -> Maybe String
    qPrefix=Maybe String
    prefix}
          | Just p :: String
    p <- Maybe String
    prefix = String
    pString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++":"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    name
          | Bool
    otherwise        = String
    name
        shouldCopy :: QName -> Bool
    shouldCopy = (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    elNames) (String -> Bool) -> (QName -> String) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    strName
        cleanElem :: Element -> Content
    cleanElem el :: Element
    el@Element{elName :: Element -> QName
    elName=QName
    name} = Element -> Content
    Elem Element
    el{elName :: QName
    elName=QName
    name{qURI :: Maybe String
    qURI=Maybe String
    forall a. Maybe a
    Nothing}}
        copyContent :: Element -> [Content]
    copyContent = (Element -> Content) -> [Element] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Content
    cleanElem ([Element] -> [Content])
    -> (Element -> [Element]) -> Element -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName -> Bool) -> Element -> [Element]
    filterChildrenName QName -> Bool
    shouldCopy

    -- this is the lowest number used for a list numId
    baseListId :: Int
    baseListId :: Int
    baseListId = 1000

    mkNumbering :: (PandocMonad m) => [ListMarker] -> m [Element]
    mkNumbering :: [ListMarker] -> m [Element]
    mkNumbering lists :: [ListMarker]
    lists = do
      [Element]
    elts <- StateT StdGen m [Element] -> StdGen -> m [Element]
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ((ListMarker -> StateT StdGen m Element)
    -> [ListMarker] -> StateT StdGen m [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ListMarker -> StateT StdGen m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ListMarker -> StateT StdGen m Element
    mkAbstractNum ([ListMarker] -> [ListMarker]
    forall a. Ord a => [a] -> [a]
    ordNub [ListMarker]
    lists)) (Int -> StdGen
    mkStdGen 1848)
      [Element] -> m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> m [Element]) -> [Element] -> m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    elts [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ (ListMarker -> Int -> Element)
    -> [ListMarker] -> [Int] -> [Element]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ListMarker -> Int -> Element
    mkNum [ListMarker]
    lists [Int
    baseListId..(Int
    baseListId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [ListMarker] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ListMarker]
    lists Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)]

    maxListLevel :: Int
    maxListLevel :: Int
    maxListLevel = 8

    mkNum :: ListMarker -> Int -> Element
    mkNum :: ListMarker -> Int -> Element
    mkNum marker :: ListMarker
    marker numid :: Int
    numid =
      String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:num" [("w:numId",Int -> String
    forall a. Show a => a -> String
    show Int
    numid)]
       ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:abstractNumId" [("w:val",ListMarker -> String
    listMarkerToId ListMarker
    marker)] ()
       Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : case ListMarker
    marker of
           NoMarker     -> []
           BulletMarker -> []
           NumberMarker _ _ start :: Int
    start ->
              (Int -> Element) -> [Int] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (\lvl :: Int
    lvl -> String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:lvlOverride" [("w:ilvl",Int -> String
    forall a. Show a => a -> String
    show (Int
    lvl :: Int))]
                  (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:startOverride" [("w:val",Int -> String
    forall a. Show a => a -> String
    show Int
    start)] ())
                    [0..Int
    maxListLevel]

    mkAbstractNum :: (PandocMonad m) => ListMarker -> StateT StdGen m Element
    mkAbstractNum :: ListMarker -> StateT StdGen m Element
    mkAbstractNum marker :: ListMarker
    marker = do
      StdGen
    gen <- StateT StdGen m StdGen
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (nsid :: Integer
    nsid, gen' :: StdGen
    gen') = (Integer, Integer) -> StdGen -> (Integer, StdGen)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (0x10000000 :: Integer, 0xFFFFFFFF :: Integer) StdGen
    gen
      StdGen -> StateT StdGen m ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put StdGen
    gen'
      Element -> StateT StdGen m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> StateT StdGen m Element)
    -> Element -> StateT StdGen m Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:abstractNum" [("w:abstractNumId",ListMarker -> String
    listMarkerToId ListMarker
    marker)]
        ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:nsid" [("w:val", String -> Integer -> String
    forall r. PrintfType r => String -> r
    printf "%8x" Integer
    nsid)] ()
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:multiLevelType" [("w:val","multilevel")] ()
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : (Int -> Element) -> [Int] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (ListMarker -> Int -> Element
    mkLvl ListMarker
    marker)
          [0..Int
    maxListLevel]

    mkLvl :: ListMarker -> Int -> Element
    mkLvl :: ListMarker -> Int -> Element
    mkLvl marker :: ListMarker
    marker lvl :: Int
    lvl =
      String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:lvl" [("w:ilvl",Int -> String
    forall a. Show a => a -> String
    show Int
    lvl)] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
        [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:start" [("w:val",String
    start)] ()
          | ListMarker
    marker ListMarker -> ListMarker -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ListMarker
    NoMarker Bool -> Bool -> Bool
    && ListMarker
    marker ListMarker -> ListMarker -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ListMarker
    BulletMarker ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
        [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:numFmt" [("w:val",String
    fmt)] ()
        , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:lvlText" [("w:val",String
    lvltxt)] ()
        , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:lvlJc" [("w:val","left")] ()
        , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" []
          [ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tabs" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tab" [("w:val","num"),("w:pos",Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    step)] ()
          , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:ind" [("w:left",Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    step Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    hang),("w:hanging",Int -> String
    forall a. Show a => a -> String
    show Int
    hang)] ()
          ]
        ]
        where (fmt :: String
    fmt, lvltxt :: String
    lvltxt, start :: String
    start) =
                case ListMarker
    marker of
                     NoMarker             -> ("bullet"," ","1")
                     BulletMarker         -> ("bullet",Int -> String
    forall t p. (IsString p, Integral t) => t -> p
    bulletFor Int
    lvl,"1")
                     NumberMarker st :: ListNumberStyle
    st de :: ListNumberDelim
    de n :: Int
    n -> (ListNumberStyle -> Int -> String
    forall p t. (IsString p, Integral t) => ListNumberStyle -> t -> p
    styleFor ListNumberStyle
    st Int
    lvl
                                             ,ListNumberDelim -> ShowS
    patternFor ListNumberDelim
    de ("%" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1))
                                             ,Int -> String
    forall a. Show a => a -> String
    show Int
    n)
              step :: Int
    step = 720
              hang :: Int
    hang = 480
              bulletFor :: t -> p
    bulletFor 0 = "\x2022"  -- filled circle
              bulletFor 1 = "\x2013"  -- en dash
              bulletFor 2 = "\x2022"  -- hyphen bullet
              bulletFor 3 = "\x2013"
              bulletFor 4 = "\x2022"
              bulletFor 5 = "\x2013"
              bulletFor x :: t
    x = t -> p
    bulletFor (t
    x t -> t -> t
    forall a. Integral a => a -> a -> a
    `mod` 6)
              styleFor :: ListNumberStyle -> t -> p
    styleFor UpperAlpha _   = "upperLetter"
              styleFor LowerAlpha _   = "lowerLetter"
              styleFor UpperRoman _   = "upperRoman"
              styleFor LowerRoman _   = "lowerRoman"
              styleFor Decimal _      = "decimal"
              styleFor DefaultStyle 0 = "decimal"
              styleFor DefaultStyle 1 = "lowerLetter"
              styleFor DefaultStyle 2 = "lowerRoman"
              styleFor DefaultStyle 3 = "decimal"
              styleFor DefaultStyle 4 = "lowerLetter"
              styleFor DefaultStyle 5 = "lowerRoman"
              styleFor DefaultStyle x :: t
    x = ListNumberStyle -> t -> p
    styleFor ListNumberStyle
    DefaultStyle (t
    x t -> t -> t
    forall a. Integral a => a -> a -> a
    `mod` 6)
              styleFor _ _            = "decimal"
              patternFor :: ListNumberDelim -> ShowS
    patternFor OneParen s :: String
    s  = String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"
              patternFor TwoParens s :: String
    s = "(" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"
              patternFor _ s :: String
    s         = String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "."

    getNumId :: (PandocMonad m) => WS m Int
    getNumId :: WS m Int
    getNumId = (((Int
    baseListId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +) (Int -> Int) -> ([ListMarker] -> Int) -> [ListMarker] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ListMarker] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) ([ListMarker] -> Int)
    -> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
    -> WS m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (WriterState -> [ListMarker])
    -> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [ListMarker]
    stLists

    makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
    makeTOC :: WriterOptions -> WS m [Element]
    makeTOC opts :: WriterOptions
    opts = do
      let depth :: String
    depth = "1-"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show (WriterOptions -> Int
    writerTOCDepth WriterOptions
    opts)
      let tocCmd :: String
    tocCmd = "TOC \\o \""String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    depthString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++"\" \\h \\z \\u"
      [Inline]
    tocTitle <- (WriterState -> [Inline])
    -> ReaderT WriterEnv (StateT WriterState m) [Inline]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [Inline]
    stTocTitle
      [Element]
    title <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "TOC Heading") (WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [[Inline] -> Block
    Para [Inline]
    tocTitle])
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:sdt" [] [
          String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:sdtPr" [] (
            String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:docPartObj" []
              [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:docPartGallery" [("w:val","Table of Contents")] (),
              String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:docPartUnique" [] ()]
             -- w:docPartObj
          ), -- w:sdtPr
          String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:sdtContent" [] ([Element]
    title[Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++[
            String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] (
              String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" [] [
                String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:fldChar" [("w:fldCharType","begin"),("w:dirty","true")] (),
                String -> [(String, String)] -> String -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:instrText" [("xml:space","preserve")] String
    tocCmd,
                String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:fldChar" [("w:fldCharType","separate")] (),
                String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:fldChar" [("w:fldCharType","end")] ()
              ] -- w:r
            ) -- w:p
          ])
        ]] -- w:sdt

    -- | Convert Pandoc document to two lists of
    -- OpenXML elements (the main document and footnotes).
    writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element],[Element])
    writeOpenXML :: WriterOptions -> Pandoc -> WS m ([Element], [Element], [Element])
    writeOpenXML opts :: WriterOptions
    opts (Pandoc meta :: Meta
    meta blocks :: [Block]
    blocks) = do
      let tit :: [Inline]
    tit = Meta -> [Inline]
    docTitle Meta
    meta
      let auths :: [[Inline]]
    auths = Meta -> [[Inline]]
    docAuthors Meta
    meta
      let dat :: [Inline]
    dat = Meta -> [Inline]
    docDate Meta
    meta
      let abstract' :: [Block]
    abstract' = Text -> Meta -> [Block]
    lookupMetaBlocks "abstract" Meta
    meta
      let subtitle' :: [Inline]
    subtitle' = Text -> Meta -> [Inline]
    lookupMetaInlines "subtitle" Meta
    meta
      let includeTOC :: Bool
    includeTOC = WriterOptions -> Bool
    writerTableOfContents WriterOptions
    opts Bool -> Bool -> Bool
    || Text -> Meta -> Bool
    lookupMetaBool "toc" Meta
    meta
      [Element]
    title <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Title") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [[Inline] -> Block
    Para [Inline]
    tit | Bool -> Bool
    not ([Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    tit)]
      [Element]
    subtitle <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Subtitle") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [[Inline] -> Block
    Para [Inline]
    subtitle' | Bool -> Bool
    not ([Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    subtitle')]
      [Element]
    authors <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Author") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts ([Block] -> WS m [Element]) -> [Block] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $
           ([Inline] -> Block) -> [[Inline]] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Block
    Para [[Inline]]
    auths
      [Element]
    date <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Date") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [[Inline] -> Block
    Para [Inline]
    dat | Bool -> Bool
    not ([Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    dat)]
      [Element]
    abstract <- if [Block] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Block]
    abstract'
                     then [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                     else WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Abstract") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    abstract'
      let convertSpace :: [Inline] -> [Inline]
    convertSpace (Str x :: Text
    x : Space : Str y :: Text
    y : xs :: [Inline]
    xs) = Text -> Inline
    Str (Text
    x Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    y) Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : [Inline]
    xs
          convertSpace (Str x :: Text
    x : Str y :: Text
    y : xs :: [Inline]
    xs)         = Text -> Inline
    Str (Text
    x Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    y) Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : [Inline]
    xs
          convertSpace xs :: [Inline]
    xs                           = [Inline]
    xs
      let blocks' :: [Block]
    blocks' = ([Inline] -> [Inline]) -> [Block] -> [Block]
    forall a b. (Data a, Data b) => (a -> a) -> b -> b
    bottomUp [Inline] -> [Inline]
    convertSpace [Block]
    blocks
      [Element]
    doc' <- WS m ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara WS m () -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    blocks'
      [Element]
    notes' <- [Element] -> [Element]
    forall a. [a] -> [a]
    reverse ([Element] -> [Element]) -> WS m [Element] -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterState -> [Element]) -> WS m [Element]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [Element]
    stFootnotes
      [([(Text, Text)], [Inline])]
    comments <- [([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])]
    forall a. [a] -> [a]
    reverse ([([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])])
    -> ReaderT
         WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
    -> ReaderT
         WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterState -> [([(Text, Text)], [Inline])])
    -> ReaderT
         WriterEnv (StateT WriterState m) [([(Text, Text)], [Inline])]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [([(Text, Text)], [Inline])]
    stComments
      let toComment :: ([(Text, Text)], [Inline])
    -> ReaderT WriterEnv (StateT WriterState m) Element
    toComment (kvs :: [(Text, Text)]
    kvs, ils :: [Inline]
    ils) = do
            [Element]
    annotation <- WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    ils
            Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a b. (a -> b) -> a -> b
    $
              String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:comment" [('w'Char -> ShowS
    forall a. a -> [a] -> [a]
    :':'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Text -> String
    T.unpack Text
    k,Text -> String
    T.unpack Text
    v) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs]
                [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                  [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" []
                    [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pStyle" [("w:val", "CommentText")] () ]
                  , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
                    [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" []
                      [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rStyle" [("w:val", "CommentReference")] ()
                      , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:annotationRef" [] ()
                      ]
                    ]
                  ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    annotation
                ]
      [Element]
    comments' <- (([(Text, Text)], [Inline]) -> WS m Element)
    -> [([(Text, Text)], [Inline])] -> WS m [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ([(Text, Text)], [Inline]) -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ([(Text, Text)], [Inline])
    -> ReaderT WriterEnv (StateT WriterState m) Element
    toComment [([(Text, Text)], [Inline])]
    comments
      [Element]
    toc <- if Bool
    includeTOC
                then WriterOptions -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> WS m [Element]
    makeTOC WriterOptions
    opts
                else [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      let meta' :: [Element]
    meta' = [Element]
    title [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    subtitle [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    authors [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    date [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    abstract [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    toc
      ([Element], [Element], [Element])
    -> WS m ([Element], [Element], [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element]
    meta' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    doc', [Element]
    notes', [Element]
    comments')

    -- | Convert a list of Pandoc blocks to OpenXML.
    blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML :: WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML opts :: WriterOptions
    opts bls :: [Block]
    bls = [[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (Block -> WS m [Element])
    -> [Block] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts) [Block]
    bls

    pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
    pStyleM :: ParaStyleName -> WS m Element
    pStyleM styleName :: ParaStyleName
    styleName = do
      ParaStyleNameMap
    pStyleMap <- (WriterState -> ParaStyleNameMap)
    -> ReaderT WriterEnv (StateT WriterState m) ParaStyleNameMap
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StyleMaps -> ParaStyleNameMap
    smParaStyle (StyleMaps -> ParaStyleNameMap)
    -> (WriterState -> StyleMaps) -> WriterState -> ParaStyleNameMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterState -> StyleMaps
    stStyleMaps)
      let sty' :: StyleId ParStyle
    sty' = ParaStyleName -> ParaStyleNameMap -> StyleId ParStyle
    forall sn sty.
    (Ord sn, FromStyleName sn, IsString (StyleId sty),
     HasStyleId sty) =>
    sn -> Map sn sty -> StyleId sty
    getStyleIdFromName ParaStyleName
    styleName ParaStyleNameMap
    pStyleMap
      Element -> WS m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> WS m Element) -> Element -> WS m Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pStyle" [("w:val", Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ ParaStyleId -> Text
    forall a. FromStyleId a => a -> Text
    fromStyleId ParaStyleId
    sty')] ()

    rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
    rStyleM :: CharStyleName -> WS m Element
    rStyleM styleName :: CharStyleName
    styleName = do
      CharStyleNameMap
    cStyleMap <- (WriterState -> CharStyleNameMap)
    -> ReaderT WriterEnv (StateT WriterState m) CharStyleNameMap
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StyleMaps -> CharStyleNameMap
    smCharStyle (StyleMaps -> CharStyleNameMap)
    -> (WriterState -> StyleMaps) -> WriterState -> CharStyleNameMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterState -> StyleMaps
    stStyleMaps)
      let sty' :: StyleId CharStyle
    sty' = CharStyleName -> CharStyleNameMap -> StyleId CharStyle
    forall sn sty.
    (Ord sn, FromStyleName sn, IsString (StyleId sty),
     HasStyleId sty) =>
    sn -> Map sn sty -> StyleId sty
    getStyleIdFromName CharStyleName
    styleName CharStyleNameMap
    cStyleMap
      Element -> WS m Element
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> WS m Element) -> Element -> WS m Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rStyle" [("w:val", Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ CharStyleId -> Text
    forall a. FromStyleId a => a -> Text
    fromStyleId CharStyleId
    sty')] ()

    getUniqueId :: (PandocMonad m) => WS m String
    -- the + 20 is to ensure that there are no clashes with the rIds
    -- already in word/document.xml.rel
    getUniqueId :: WS m String
    getUniqueId = do
      Int
    n <- (WriterState -> Int)
    -> ReaderT WriterEnv (StateT WriterState m) Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Int
    stCurId
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{stCurId :: Int
    stCurId = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1}
      String -> WS m String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> WS m String) -> String -> WS m String
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    n

    -- | Key for specifying user-defined docx styles.
    dynamicStyleKey :: T.Text
    dynamicStyleKey :: Text
    dynamicStyleKey = "custom-style"

    -- | Convert a Pandoc block element to OpenXML.
    blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element]
    blockToOpenXML :: WriterOptions -> Block -> WS m [Element]
    blockToOpenXML opts :: WriterOptions
    opts blk :: Block
    blk = WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
    withDirection (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML' WriterOptions
    opts Block
    blk

    blockToOpenXML' :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element]
    blockToOpenXML' :: WriterOptions -> Block -> WS m [Element]
    blockToOpenXML' _ Null = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    blockToOpenXML' opts :: WriterOptions
    opts (Div (ident :: Text
    ident,_classes :: [Text]
    _classes,kvs :: [(Text, Text)]
    kvs) bs :: [Block]
    bs) = do
      WS m [Element] -> WS m [Element]
    stylemod <- case Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    dynamicStyleKey [(Text, Text)]
    kvs of
                       Just (String -> ParaStyleName
    forall a. IsString a => String -> a
    fromString (String -> ParaStyleName)
    -> (Text -> String) -> Text -> ParaStyleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack -> ParaStyleName
    sty) -> do
                          (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s ->
                            WriterState
    s{stDynamicParaProps :: Set ParaStyleName
    stDynamicParaProps = ParaStyleName -> Set ParaStyleName -> Set ParaStyleName
    forall a. Ord a => a -> Set a -> Set a
    Set.insert ParaStyleName
    sty
                                 (WriterState -> Set ParaStyleName
    stDynamicParaProps WriterState
    s)}
                          (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM ParaStyleName
    sty)
                       _ -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return WS m [Element] -> WS m [Element]
    forall a. a -> a
    id
      WS m [Element] -> WS m [Element]
    dirmod <- case Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "dir" [(Text, Text)]
    kvs of
                     Just "rtl" -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env { envRTL :: Bool
    envRTL = Bool
    True })
                     Just "ltr" -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env { envRTL :: Bool
    envRTL = Bool
    False })
                     _ -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return WS m [Element] -> WS m [Element]
    forall a. a -> a
    id
      let (hs :: [Block]
    hs, bs' :: [Block]
    bs') = if Text
    ident Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == "refs"
                         then (Block -> Bool) -> [Block] -> ([Block], [Block])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Block -> Bool
    isHeaderBlock [Block]
    bs
                         else ([], [Block]
    bs)
      let bibmod :: WS m a -> WS m a
    bibmod = if Text
    ident Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == "refs"
                      then WS m Element -> WS m a -> WS m a
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Bibliography")
                      else WS m a -> WS m a
    forall a. a -> a
    id
      [Element]
    header <- WS m [Element] -> WS m [Element]
    dirmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    stylemod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    hs
      [Element]
    contents <- WS m [Element] -> WS m [Element]
    dirmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    forall a. WS m a -> WS m a
    bibmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    stylemod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    bs'
      Text -> [Element] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Element] -> WS m [Element]
    wrapBookmark Text
    ident ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    header [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    contents
    blockToOpenXML' opts :: WriterOptions
    opts (Header lev :: Int
    lev (ident :: Text
    ident,_,_) lst :: [Inline]
    lst) = do
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      [Element]
    paraProps <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM (String -> ParaStyleName
    forall a. IsString a => String -> a
    fromString (String -> ParaStyleName) -> String -> ParaStyleName
    forall a b. (a -> b) -> a -> b
    $ "Heading "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    lev)) (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $
                        Bool -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
    getParaProps Bool
    False
      [Element]
    contents <- WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
      if Text -> Bool
    T.null Text
    ident
         then [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ([Element]
    paraProps [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    contents)]
         else do
           let bookmarkName :: Text
    bookmarkName = Text
    ident
           (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s{ stSectionIds :: Set Text
    stSectionIds = Text -> Set Text -> Set Text
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Text
    bookmarkName
                                          (Set Text -> Set Text) -> Set Text -> Set Text
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Set Text
    stSectionIds WriterState
    s }
           [Element]
    bookmarkedContents <- Text -> [Element] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Element] -> WS m [Element]
    wrapBookmark Text
    bookmarkName [Element]
    contents
           [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ([Element]
    paraProps [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    bookmarkedContents)]
    blockToOpenXML' opts :: WriterOptions
    opts (Plain lst :: [Inline]
    lst) = do
      Bool
    isInTable <- (WriterState -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Bool
    stInTable
      Bool
    isInList <- (WriterState -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Bool
    stInList
      let block :: WS m [Element]
    block = WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    lst)
      Element
    prop <- ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Compact"
      if Bool
    isInTable Bool -> Bool -> Bool
    || Bool
    isInList
         then Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withParaProp Element
    prop WS m [Element]
    block
         else WS m [Element]
    block
    -- title beginning with fig: indicates that the image is a figure
    blockToOpenXML' opts :: WriterOptions
    opts (Para [Image attr :: Attr
    attr alt :: [Inline]
    alt (src :: Text
    src,Text -> Text -> Maybe Text
    T.stripPrefix "fig:" -> Just tit :: Text
    tit)]) = do
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      Element
    prop <- ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM (ParaStyleName -> WS m Element) -> ParaStyleName -> WS m Element
    forall a b. (a -> b) -> a -> b
    $
            if [Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    alt
            then "Figure"
            else "Captioned Figure"
      [Element]
    paraProps <- (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env { envParaProperties :: EnvProps
    envParaProperties = Maybe Element -> [Element] -> EnvProps
    EnvProps (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    prop) [] EnvProps -> EnvProps -> EnvProps
    forall a. Semigroup a => a -> a -> a
    <> WriterEnv -> EnvProps
    envParaProperties WriterEnv
    env }) (Bool -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
    getParaProps Bool
    False)
      [Element]
    contents <- WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    attr [Inline]
    alt (Text
    src,Text
    tit)]
      [Element]
    captionNode <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Image Caption")
                     (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    alt)
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ([Element]
    paraProps [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    contents) Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    captionNode
    blockToOpenXML' opts :: WriterOptions
    opts (Para lst :: [Inline]
    lst)
      | [Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    lst Bool -> Bool -> Bool
    && Bool -> Bool
    not (Extension -> WriterOptions -> Bool
    forall a. HasSyntaxExtensions a => Extension -> a -> Bool
    isEnabled Extension
    Ext_empty_paragraphs WriterOptions
    opts) = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      | Bool
    otherwise = do
          Bool
    isFirstPara <- (WriterState -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Bool
    stFirstPara
          let displayMathPara :: Bool
    displayMathPara = case [Inline]
    lst of
                                     [x :: Inline
    x] -> Inline -> Bool
    isDisplayMath Inline
    x
                                     _   -> Bool
    False
          [Element]
    paraProps <- Bool -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Bool -> WS m [Element]
    getParaProps Bool
    displayMathPara
          Element
    bodyTextStyle <- if Bool
    isFirstPara
                           then ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "First Paragraph"
                           else ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Body Text"
          let paraProps' :: [Element]
    paraProps' = case [Element]
    paraProps of
                []               -> [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" [] [Element
    bodyTextStyle]]
                ps :: [Element]
    ps               -> [Element]
    ps
          (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s { stFirstPara :: Bool
    stFirstPara = Bool
    False }
          [Element]
    contents <- WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
          [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ([Element]
    paraProps' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    contents)]
    blockToOpenXML' opts :: WriterOptions
    opts (LineBlock lns :: [[Inline]]
    lns) = WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts (Block -> WS m [Element]) -> Block -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [[Inline]] -> Block
    linesToPara [[Inline]]
    lns
    blockToOpenXML' _ b :: Block
    b@(RawBlock format :: Format
    format str :: Text
    str)
      | Format
    format Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Format
    Format "openxml" = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Element
    x | Elem x :: Element
    x <- Text -> [Content]
    forall s. XmlSource s => s -> [Content]
    parseXML Text
    str ]
      | Bool
    otherwise                  = do
          LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
    -> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ Block -> LogMessage
    BlockNotRendered Block
    b
          [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    blockToOpenXML' opts :: WriterOptions
    opts (BlockQuote blocks :: [Block]
    blocks) = do
      [Element]
    p <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Block Text")
           (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    blocks
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    p
    blockToOpenXML' opts :: WriterOptions
    opts (CodeBlock attrs :: Attr
    attrs@(ident :: Text
    ident, _, _) str :: Text
    str) = do
      [Element]
    p <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Source Code") (WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts (Block -> WS m [Element]) -> Block -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Block
    Para [Attr -> Text -> Inline
    Code Attr
    attrs Text
    str])
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      Text -> [Element] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Element] -> WS m [Element]
    wrapBookmark Text
    ident [Element]
    p
    blockToOpenXML' _ HorizontalRule = do
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [
        String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pict" []
        (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "v:rect" [("style","width:0;height:1.5pt"),
                           ("o:hralign","center"),
                           ("o:hrstd","t"),("o:hr","t")] () ]
    blockToOpenXML' opts :: WriterOptions
    opts (Table caption :: [Inline]
    caption aligns :: [Alignment]
    aligns widths :: [Double]
    widths headers :: [[Block]]
    headers rows :: [[[Block]]]
    rows) = do
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s { stInTable :: Bool
    stInTable = Bool
    True }
      let captionStr :: Text
    captionStr = [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    caption
      [Element]
    caption' <- if [Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    caption
                     then [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                     else WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Table Caption")
                          (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    caption)
      let alignmentFor :: Alignment -> Element
    alignmentFor al :: Alignment
    al = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:jc" [("w:val",Alignment -> String
    alignmentToString Alignment
    al)] ()
      -- Table cells require a <w:p> element, even an empty one!
      -- Not in the spec but in Word 2007, 2010. See #4953.
      let cellToOpenXML :: (Alignment, [Block])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML (al :: Alignment
    al, cell :: [Block]
    cell) = do
            [Element]
    es <- Element
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withParaProp (Alignment -> Element
    alignmentFor Alignment
    al) (ReaderT WriterEnv (StateT WriterState m) [Element]
     -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions
    -> [Block] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    cell
            if (Element -> Bool) -> [Element] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\e :: Element
    e -> QName -> String
    qName (Element -> QName
    elName Element
    e) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "p") [Element]
    es
               then [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    es
               else [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    es [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] ()]
      [[Element]]
    headers' <- ((Alignment, [Block]) -> WS m [Element])
    -> [(Alignment, [Block])]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Alignment, [Block]) -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    (Alignment, [Block])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML ([(Alignment, [Block])]
     -> ReaderT WriterEnv (StateT WriterState m) [[Element]])
    -> [(Alignment, [Block])]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall a b. (a -> b) -> a -> b
    $ [Alignment] -> [[Block]] -> [(Alignment, [Block])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Alignment]
    aligns [[Block]]
    headers
      [[[Element]]]
    rows' <- ([[Block]] -> ReaderT WriterEnv (StateT WriterState m) [[Element]])
    -> [[[Block]]]
    -> ReaderT WriterEnv (StateT WriterState m) [[[Element]]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (((Alignment, [Block]) -> WS m [Element])
    -> [(Alignment, [Block])]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Alignment, [Block]) -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    (Alignment, [Block])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML ([(Alignment, [Block])]
     -> ReaderT WriterEnv (StateT WriterState m) [[Element]])
    -> ([[Block]] -> [(Alignment, [Block])])
    -> [[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Alignment] -> [[Block]] -> [(Alignment, [Block])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Alignment]
    aligns) [[[Block]]]
    rows
      let borderProps :: Element
    borderProps = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tcPr" []
                        [ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tcBorders" []
                          (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:bottom" [("w:val","single")] ()
                        , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:vAlign" [("w:val","bottom")] () ]
      Element
    compactStyle <- ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Compact"
      let emptyCell :: [Element]
    emptyCell = [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" [] [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" [] [Element
    compactStyle]]]
      let mkcell :: Bool -> [Element] -> Element
    mkcell border :: Bool
    border contents :: [Element]
    contents = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tc" []
                                ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ [ Element
    borderProps | Bool
    border ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                if [Element] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    contents
                                   then [Element]
    emptyCell
                                   else [Element]
    contents
      let mkrow :: Bool -> [[Element]] -> Element
    mkrow border :: Bool
    border cells :: [[Element]]
    cells = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tr" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                            [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:trPr" [] [
                              String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:cnfStyle" [("w:firstRow","1")] ()] | Bool
    border]
                            [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ ([Element] -> Element) -> [[Element]] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> [Element] -> Element
    mkcell Bool
    border) [[Element]]
    cells
      let textwidth :: Double
    textwidth = 7920  -- 5.5 in in twips, 1/20 pt
      let fullrow :: Double
    fullrow = 5000 -- 100% specified in pct
      let rowwidth :: Double
    rowwidth = Double
    fullrow Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * [Double] -> Double
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Double]
    widths
      let mkgridcol :: Double -> Element
    mkgridcol w :: Double
    w = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:gridCol"
                           [("w:w", Integer -> String
    forall a. Show a => a -> String
    show (Double -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double
    textwidth Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    w) :: Integer))] ()
      let hasHeader :: Bool
    hasHeader = Bool -> Bool
    not (([Block] -> Bool) -> [[Block]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Block] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Block]]
    headers)
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s { stInTable :: Bool
    stInTable = Bool
    False }
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $
        [Element]
    caption' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
        [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tbl" []
          ( String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblPr" []
            (   String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblStyle" [("w:val","Table")] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
                String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblW" [("w:type", "pct"), ("w:w", Double -> String
    forall a. Show a => a -> String
    show Double
    rowwidth)] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
                String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblLook" [("w:firstRow",if Bool
    hasHeader then "1" else "0") ] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
              [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblCaption" [("w:val", Text -> String
    T.unpack Text
    captionStr)] ()
              | Bool -> Bool
    not ([Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    caption) ] )
          Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:tblGrid" []
            (if (Double -> Bool) -> [Double] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    ==0) [Double]
    widths
                then []
                else (Double -> Element) -> [Double] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map Double -> Element
    mkgridcol [Double]
    widths)
          Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [ Bool -> [[Element]] -> Element
    mkrow Bool
    True [[Element]]
    headers' | Bool
    hasHeader ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
          ([[Element]] -> Element) -> [[[Element]]] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> [[Element]] -> Element
    mkrow Bool
    False) [[[Element]]]
    rows'
          )]
    blockToOpenXML' opts :: WriterOptions
    opts el :: Block
    el
      | BulletList lst :: [[Block]]
    lst <- Block
    el = ListMarker -> [[Block]] -> WS m [Element]
    forall (m :: * -> *) (t :: * -> *).
    (PandocMonad m, Traversable t) =>
    ListMarker
    -> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    addOpenXMLList ListMarker
    BulletMarker [[Block]]
    lst
      | OrderedList (start :: Int
    start, numstyle :: ListNumberStyle
    numstyle, numdelim :: ListNumberDelim
    numdelim) lst :: [[Block]]
    lst <- Block
    el
      = ListMarker -> [[Block]] -> WS m [Element]
    forall (m :: * -> *) (t :: * -> *).
    (PandocMonad m, Traversable t) =>
    ListMarker
    -> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    addOpenXMLList (ListNumberStyle -> ListNumberDelim -> Int -> ListMarker
    NumberMarker ListNumberStyle
    numstyle ListNumberDelim
    numdelim Int
    start) [[Block]]
    lst
      where
        addOpenXMLList :: ListMarker
    -> t [Block] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    addOpenXMLList marker :: ListMarker
    marker lst :: t [Block]
    lst = do
          ListMarker -> WS m ()
    forall (m :: * -> *). PandocMonad m => ListMarker -> WS m ()
    addList ListMarker
    marker
          Int
    numid  <- WS m Int
    forall (m :: * -> *). PandocMonad m => WS m Int
    getNumId
          [Element]
    l <- ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
    asList (ReaderT WriterEnv (StateT WriterState m) [Element]
     -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b. (a -> b) -> a -> b
    $ t [Element] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (t [Element] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) (t [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ([Block] -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> t [Block]
    -> ReaderT WriterEnv (StateT WriterState m) (t [Element])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions
    -> Int
    -> [Block]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Int -> [Block] -> WS m [Element]
    listItemToOpenXML WriterOptions
    opts Int
    numid) t [Block]
    lst
          WS m ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
          [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    l
    blockToOpenXML' opts :: WriterOptions
    opts (DefinitionList items :: [([Inline], [[Block]])]
    items) = do
      [Element]
    l <- [[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (([Inline], [[Block]]) -> WS m [Element])
    -> [([Inline], [[Block]])]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> ([Inline], [[Block]]) -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> ([Inline], [[Block]]) -> WS m [Element]
    definitionListItemToOpenXML WriterOptions
    opts) [([Inline], [[Block]])]
    items
      ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    l

    definitionListItemToOpenXML  :: (PandocMonad m) => WriterOptions -> ([Inline],[[Block]]) -> WS m [Element]
    definitionListItemToOpenXML :: WriterOptions -> ([Inline], [[Block]]) -> WS m [Element]
    definitionListItemToOpenXML opts :: WriterOptions
    opts (term :: [Inline]
    term,defs :: [[Block]]
    defs) = do
      [Element]
    term' <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Definition Term")
               (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    term)
      [Element]
    defs' <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Definition")
               (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ([Block] -> WS m [Element])
    -> [[Block]]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts) [[Block]]
    defs
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    term' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    defs'

    addList :: (PandocMonad m) => ListMarker -> WS m ()
    addList :: ListMarker -> WS m ()
    addList marker :: ListMarker
    marker = do
      [ListMarker]
    lists <- (WriterState -> [ListMarker])
    -> ReaderT WriterEnv (StateT WriterState m) [ListMarker]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [ListMarker]
    stLists
      (WriterState -> WriterState) -> WS m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState) -> WS m ())
    -> (WriterState -> WriterState) -> WS m ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stLists :: [ListMarker]
    stLists = [ListMarker]
    lists [ListMarker] -> [ListMarker] -> [ListMarker]
    forall a. [a] -> [a] -> [a]
    ++ [ListMarker
    marker] }

    listItemToOpenXML :: (PandocMonad m) => WriterOptions -> Int -> [Block] -> WS m [Element]
    listItemToOpenXML :: WriterOptions -> Int -> [Block] -> WS m [Element]
    listItemToOpenXML _ _ []                   = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    listItemToOpenXML opts :: WriterOptions
    opts numid :: Int
    numid (first :: Block
    first:rest :: [Block]
    rest) = do
      Bool
    oldInList <- (WriterState -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Bool
    stInList
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stInList :: Bool
    stInList = Bool
    True }
      [Element]
    first' <- Int -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
    withNumId Int
    numid (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Block -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> WS m [Element]
    blockToOpenXML WriterOptions
    opts Block
    first
      -- baseListId is the code for no list marker:
      [Element]
    rest'  <- Int -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a. PandocMonad m => Int -> WS m a -> WS m a
    withNumId Int
    baseListId (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts [Block]
    rest
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stInList :: Bool
    stInList = Bool
    oldInList }
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    first' [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    rest'

    alignmentToString :: Alignment -> [Char]
    alignmentToString :: Alignment -> String
    alignmentToString alignment :: Alignment
    alignment = case Alignment
    alignment of
                                     AlignLeft    -> "left"
                                     AlignRight   -> "right"
                                     AlignCenter  -> "center"
                                     AlignDefault -> "left"

    -- | Convert a list of inline elements to OpenXML.
    inlinesToOpenXML :: (PandocMonad m) => WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML :: WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML opts :: WriterOptions
    opts lst :: [Inline]
    lst = [[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (Inline -> WS m [Element])
    -> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Inline -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML WriterOptions
    opts) [Inline]
    lst

    withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
    withNumId :: Int -> WS m a -> WS m a
    withNumId numid :: Int
    numid = (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
    -> (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall a b. (a -> b) -> a -> b
    $ \env :: WriterEnv
    env -> WriterEnv
    env{ envListNumId :: Int
    envListNumId = Int
    numid }

    asList :: (PandocMonad m) => WS m a -> WS m a
    asList :: WS m a -> WS m a
    asList = (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
    -> (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall a b. (a -> b) -> a -> b
    $ \env :: WriterEnv
    env -> WriterEnv
    env{ envListLevel :: Int
    envListLevel = WriterEnv -> Int
    envListLevel WriterEnv
    env Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 }

    isStyle :: Element -> Bool
    isStyle :: Element -> Bool
    isStyle e :: Element
    e = [(String, String)] -> String -> String -> Element -> Bool
    isElem [] "w" "rStyle" Element
    e Bool -> Bool -> Bool
    ||
                [(String, String)] -> String -> String -> Element -> Bool
    isElem [] "w" "pStyle" Element
    e

    getTextProps :: (PandocMonad m) => WS m [Element]
    getTextProps :: WS m [Element]
    getTextProps = do
      EnvProps
    props <- (WriterEnv -> EnvProps)
    -> ReaderT WriterEnv (StateT WriterState m) EnvProps
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> EnvProps
    envTextProperties
      let squashed :: [Element]
    squashed = EnvProps -> [Element]
    squashProps EnvProps
    props
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" [] [Element]
    squashed | (Bool -> Bool
    not (Bool -> Bool) -> ([Element] -> Bool) -> [Element] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Element] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [Element]
    squashed]

    withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
    withTextProp :: Element -> WS m a -> WS m a
    withTextProp d :: Element
    d p :: WS m a
    p =
      (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env {envTextProperties :: EnvProps
    envTextProperties = EnvProps
    ep EnvProps -> EnvProps -> EnvProps
    forall a. Semigroup a => a -> a -> a
    <> WriterEnv -> EnvProps
    envTextProperties WriterEnv
    env}) WS m a
    p
      where ep :: EnvProps
    ep = if Element -> Bool
    isStyle Element
    d then Maybe Element -> [Element] -> EnvProps
    EnvProps (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    d) [] else Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    forall a. Maybe a
    Nothing [Element
    d]

    withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
    withTextPropM :: WS m Element -> WS m a -> WS m a
    withTextPropM = (((Element -> WS m a) -> WS m a)
    -> (WS m a -> Element -> WS m a) -> WS m a -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Element -> WS m a -> WS m a) -> WS m a -> Element -> WS m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Element -> WS m a -> WS m a
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp) (((Element -> WS m a) -> WS m a) -> WS m a -> WS m a)
    -> (WS m Element -> (Element -> WS m a) -> WS m a)
    -> WS m Element
    -> WS m a
    -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WS m Element -> (Element -> WS m a) -> WS m a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=)

    getParaProps :: PandocMonad m => Bool -> WS m [Element]
    getParaProps :: Bool -> WS m [Element]
    getParaProps displayMathPara :: Bool
    displayMathPara = do
      EnvProps
    props <- (WriterEnv -> EnvProps)
    -> ReaderT WriterEnv (StateT WriterState m) EnvProps
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> EnvProps
    envParaProperties
      Int
    listLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envListLevel
      Int
    numid <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envListNumId
      let listPr :: [Element]
    listPr = [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:numPr" []
                    [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:ilvl" [("w:val",Int -> String
    forall a. Show a => a -> String
    show Int
    listLevel)] ()
                    , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:numId" [("w:val",Int -> String
    forall a. Show a => a -> String
    show Int
    numid)] () ] | Int
    listLevel Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 0 Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    displayMathPara]
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ case [Element]
    listPr [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ EnvProps -> [Element]
    squashProps EnvProps
    props of
                    [] -> []
                    ps :: [Element]
    ps -> [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:pPr" [] [Element]
    ps]

    withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
    withParaProp :: Element -> WS m a -> WS m a
    withParaProp d :: Element
    d p :: WS m a
    p =
      (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env {envParaProperties :: EnvProps
    envParaProperties = EnvProps
    ep EnvProps -> EnvProps -> EnvProps
    forall a. Semigroup a => a -> a -> a
    <> WriterEnv -> EnvProps
    envParaProperties WriterEnv
    env}) WS m a
    p
      where ep :: EnvProps
    ep = if Element -> Bool
    isStyle Element
    d then Maybe Element -> [Element] -> EnvProps
    EnvProps (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    d) [] else Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    forall a. Maybe a
    Nothing [Element
    d]

    withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
    withParaPropM :: WS m Element -> WS m a -> WS m a
    withParaPropM = (((Element -> WS m a) -> WS m a)
    -> (WS m a -> Element -> WS m a) -> WS m a -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Element -> WS m a -> WS m a) -> WS m a -> Element -> WS m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Element -> WS m a -> WS m a
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withParaProp) (((Element -> WS m a) -> WS m a) -> WS m a -> WS m a)
    -> (WS m Element -> (Element -> WS m a) -> WS m a)
    -> WS m Element
    -> WS m a
    -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WS m Element -> (Element -> WS m a) -> WS m a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=)

    formattedString :: PandocMonad m => T.Text -> WS m [Element]
    formattedString :: Text -> WS m [Element]
    formattedString str :: Text
    str =
      -- properly handle soft hyphens
      case (Char -> Bool) -> Text -> [Text]
    splitTextBy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='\173') Text
    str of
          [w :: Text
    w] -> Text -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
    formattedString' Text
    w
          ws :: [Text]
    ws  -> do
             [Element]
    sh <- [Element] -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => [Element] -> WS m [Element]
    formattedRun [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:softHyphen" [] ()]
             [Element] -> [[Element]] -> [Element]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Element]
    sh ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Text -> WS m [Element])
    -> [Text] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Text -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
    formattedString' [Text]
    ws

    formattedString' :: PandocMonad m => T.Text -> WS m [Element]
    formattedString' :: Text -> WS m [Element]
    formattedString' str :: Text
    str = do
      Bool
    inDel <- (WriterEnv -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Bool
    envInDel
      [Element] -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => [Element] -> WS m [Element]
    formattedRun [ String -> [(String, String)] -> Text -> Element
    mktnode (if Bool
    inDel then "w:delText" else "w:t")
                     [("xml:space","preserve")] (Text -> Text
    stripInvalidChars Text
    str) ]

    formattedRun :: PandocMonad m => [Element] -> WS m [Element]
    formattedRun :: [Element] -> WS m [Element]
    formattedRun els :: [Element]
    els = do
      [Element]
    props <- WS m [Element]
    forall (m :: * -> *). PandocMonad m => WS m [Element]
    getTextProps
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ [Element]
    props [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    els ]

    setFirstPara :: PandocMonad m => WS m ()
    setFirstPara :: WS m ()
    setFirstPara =  (WriterState -> WriterState) -> WS m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState) -> WS m ())
    -> (WriterState -> WriterState) -> WS m ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s { stFirstPara :: Bool
    stFirstPara = Bool
    True }

    -- | Convert an inline element to OpenXML.
    inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML :: WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML opts :: WriterOptions
    opts il :: Inline
    il = WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a. PandocMonad m => WS m a -> WS m a
    withDirection (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Inline -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML' WriterOptions
    opts Inline
    il

    inlineToOpenXML' :: PandocMonad m => WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML' :: WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML' _ (Str str :: Text
    str) =
      Text -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
    formattedString Text
    str
    inlineToOpenXML' opts :: WriterOptions
    opts Space = WriterOptions -> Inline -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML WriterOptions
    opts (Text -> Inline
    Str " ")
    inlineToOpenXML' opts :: WriterOptions
    opts SoftBreak = WriterOptions -> Inline -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML WriterOptions
    opts (Text -> Inline
    Str " ")
    inlineToOpenXML' opts :: WriterOptions
    opts (Span (_,["underline"],_) ils :: [Inline]
    ils) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:u" [("w:val","single")] ()) (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $
        WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    ils
    inlineToOpenXML' _ (Span (ident :: Text
    ident,["comment-start"],kvs :: [(Text, Text)]
    kvs) ils :: [Inline]
    ils) = do
      -- prefer the "id" in kvs, since that is the one produced by the docx
      -- reader.
      let ident' :: Text
    ident' = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    ident (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "id" [(Text, Text)]
    kvs)
          kvs' :: [(Text, Text)]
    kvs' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (("id" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, Text) -> Text
    forall a b. (a, b) -> a
    fst) [(Text, Text)]
    kvs
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stComments :: [([(Text, Text)], [Inline])]
    stComments = (("id",Text
    ident')(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    :[(Text, Text)]
    kvs', [Inline]
    ils) ([(Text, Text)], [Inline])
    -> [([(Text, Text)], [Inline])] -> [([(Text, Text)], [Inline])]
    forall a. a -> [a] -> [a]
    : WriterState -> [([(Text, Text)], [Inline])]
    stComments WriterState
    st }
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:commentRangeStart" [("w:id", Text -> String
    T.unpack Text
    ident')] () ]
    inlineToOpenXML' _ (Span (ident :: Text
    ident,["comment-end"],kvs :: [(Text, Text)]
    kvs) _) =
      -- prefer the "id" in kvs, since that is the one produced by the docx
      -- reader.
      let ident' :: Text
    ident' = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    ident (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "id" [(Text, Text)]
    kvs)
      in
        [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:commentRangeEnd" [("w:id", Text -> String
    T.unpack Text
    ident')] ()
               , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
                 [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" []
                   [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rStyle" [("w:val", "CommentReference")] () ]
                 , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:commentReference" [("w:id", Text -> String
    T.unpack Text
    ident')] () ]
               ]
    inlineToOpenXML' opts :: WriterOptions
    opts (Span (ident :: Text
    ident,classes :: [Text]
    classes,kvs :: [(Text, Text)]
    kvs) ils :: [Inline]
    ils) = do
      WS m [Element] -> WS m [Element]
    stylemod <- case Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    dynamicStyleKey [(Text, Text)]
    kvs of
                       Just (String -> CharStyleName
    forall a. IsString a => String -> a
    fromString (String -> CharStyleName)
    -> (Text -> String) -> Text -> CharStyleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack -> CharStyleName
    sty) -> do
                          (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s ->
                            WriterState
    s{stDynamicTextProps :: Set CharStyleName
    stDynamicTextProps = CharStyleName -> Set CharStyleName -> Set CharStyleName
    forall a. Ord a => a -> Set a -> Set a
    Set.insert CharStyleName
    sty
                                  (WriterState -> Set CharStyleName
    stDynamicTextProps WriterState
    s)}
                          (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withTextPropM (CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM CharStyleName
    sty)
                       _ -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return WS m [Element] -> WS m [Element]
    forall a. a -> a
    id
      let dirmod :: ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    dirmod = case Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "dir" [(Text, Text)]
    kvs of
                     Just "rtl" -> (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env { envRTL :: Bool
    envRTL = Bool
    True })
                     Just "ltr" -> (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env { envRTL :: Bool
    envRTL = Bool
    False })
                     _          -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    forall a. a -> a
    id
          off :: String -> WS m a -> WS m a
    off x :: String
    x = Element -> WS m a -> WS m a
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode String
    x [("w:val","0")] ())
          pmod :: WS m a -> WS m a
    pmod =  (if "csl-no-emph" Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    classes then String -> WS m a -> WS m a
    forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
    off "w:i" else WS m a -> WS m a
    forall a. a -> a
    id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  (if "csl-no-strong" Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    classes then String -> WS m a -> WS m a
    forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
    off "w:b" else WS m a -> WS m a
    forall a. a -> a
    id) (WS m a -> WS m a) -> (WS m a -> WS m a) -> WS m a -> WS m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  (if "csl-no-smallcaps" Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    classes
                      then String -> WS m a -> WS m a
    forall (m :: * -> *) a. PandocMonad m => String -> WS m a -> WS m a
    off "w:smallCaps"
                      else WS m a -> WS m a
    forall a. a -> a
    id)
          getChangeAuthorDate :: ReaderT WriterEnv (StateT WriterState m) (Text, Text)
    getChangeAuthorDate = do
            Text
    defaultAuthor <- (WriterEnv -> Text)
    -> ReaderT WriterEnv (StateT WriterState m) Text
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Text
    envChangesAuthor
            Text
    defaultDate <- (WriterEnv -> Text)
    -> ReaderT WriterEnv (StateT WriterState m) Text
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Text
    envChangesDate
            let author :: Text
    author = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    defaultAuthor (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "author" [(Text, Text)]
    kvs)
                date :: Text
    date   = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    defaultDate (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "date" [(Text, Text)]
    kvs)
            (Text, Text)
    -> ReaderT WriterEnv (StateT WriterState m) (Text, Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    author, Text
    date)
      WS m [Element] -> WS m [Element]
    insmod <- if "insertion" Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    classes
                   then do
                     (author :: Text
    author, date :: Text
    date) <- ReaderT WriterEnv (StateT WriterState m) (Text, Text)
    getChangeAuthorDate
                     Int
    insId <- (WriterState -> Int)
    -> ReaderT WriterEnv (StateT WriterState m) Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Int
    stInsId
                     (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s{stInsId :: Int
    stInsId = Int
    insId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1}
                     (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ \f :: WS m [Element]
    f -> do
                       [Element]
    x <- WS m [Element]
    f
                       [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:ins"
                                  [("w:id", Int -> String
    forall a. Show a => a -> String
    show Int
    insId),
                                  ("w:author", Text -> String
    T.unpack Text
    author),
                                  ("w:date", Text -> String
    T.unpack Text
    date)] [Element]
    x ]
                   else (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return WS m [Element] -> WS m [Element]
    forall a. a -> a
    id
      WS m [Element] -> WS m [Element]
    delmod <- if "deletion" Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    classes
                   then do
                     (author :: Text
    author, date :: Text
    date) <- ReaderT WriterEnv (StateT WriterState m) (Text, Text)
    getChangeAuthorDate
                     Int
    delId <- (WriterState -> Int)
    -> ReaderT WriterEnv (StateT WriterState m) Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Int
    stDelId
                     (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s{stDelId :: Int
    stDelId = Int
    delId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1}
                     (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((WS m [Element] -> WS m [Element])
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          (WS m [Element] -> WS m [Element]))
    -> (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall a b. (a -> b) -> a -> b
    $ \f :: WS m [Element]
    f -> (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env->WriterEnv
    env{envInDel :: Bool
    envInDel=Bool
    True}) (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ do
                       [Element]
    x <- WS m [Element]
    f
                       [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:del"
                               [("w:id", Int -> String
    forall a. Show a => a -> String
    show Int
    delId),
                               ("w:author", Text -> String
    T.unpack Text
    author),
                               ("w:date", Text -> String
    T.unpack Text
    date)] [Element]
    x]
                   else (WS m [Element] -> WS m [Element])
    -> ReaderT
         WriterEnv (StateT WriterState m) (WS m [Element] -> WS m [Element])
    forall (m :: * -> *) a. Monad m => a -> m a
    return WS m [Element] -> WS m [Element]
    forall a. a -> a
    id
      [Element]
    contents <- WS m [Element] -> WS m [Element]
    insmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    delmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    forall a.
    ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    dirmod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    stylemod (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WS m [Element] -> WS m [Element]
    forall a.
    ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    pmod
                         (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    ils
      Text -> [Element] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Element] -> WS m [Element]
    wrapBookmark Text
    ident [Element]
    contents
    inlineToOpenXML' opts :: WriterOptions
    opts (Strong lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:b" [] ()) (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (Emph lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:i" [] ()) (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (Subscript lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:vertAlign" [("w:val","subscript")] ())
      (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (Superscript lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:vertAlign" [("w:val","superscript")] ())
      (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (SmallCaps lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:smallCaps" [] ())
      (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (Strikeout lst :: [Inline]
    lst) =
      Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withTextProp (String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:strike" [] ())
      (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' _ LineBreak = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    br]
    inlineToOpenXML' _ il :: Inline
    il@(RawInline f :: Format
    f str :: Text
    str)
      | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Format
    Format "openxml" = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Element
    x | Elem x :: Element
    x <- Text -> [Content]
    forall s. XmlSource s => s -> [Content]
    parseXML Text
    str ]
      | Bool
    otherwise             = do
          LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
    -> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ Inline -> LogMessage
    InlineNotRendered Inline
    il
          [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    inlineToOpenXML' opts :: WriterOptions
    opts (Quoted quoteType :: QuoteType
    quoteType lst :: [Inline]
    lst) =
      WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts ([Inline] -> WS m [Element]) -> [Inline] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Text -> Inline
    Str Text
    open] [Inline] -> [Inline] -> [Inline]
    forall a. [a] -> [a] -> [a]
    ++ [Inline]
    lst [Inline] -> [Inline] -> [Inline]
    forall a. [a] -> [a] -> [a]
    ++ [Text -> Inline
    Str Text
    close]
        where (open :: Text
    open, close :: Text
    close) = case QuoteType
    quoteType of
                                SingleQuote -> ("\x2018", "\x2019")
                                DoubleQuote -> ("\x201C", "\x201D")
    inlineToOpenXML' opts :: WriterOptions
    opts (Math mathType :: MathType
    mathType str :: Text
    str) = do
      Bool
    -> ReaderT WriterEnv (StateT WriterState m) ()
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (MathType
    mathType MathType -> MathType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MathType
    DisplayMath) ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara
      Either Inline Element
    res <- (StateT WriterState m (Either Inline Element)
    -> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT WriterState m (Either Inline Element)
     -> ReaderT
          WriterEnv (StateT WriterState m) (Either Inline Element))
    -> (m (Either Inline Element)
        -> StateT WriterState m (Either Inline Element))
    -> m (Either Inline Element)
    -> ReaderT WriterEnv (StateT WriterState m) (Either Inline Element)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (Either Inline Element)
    -> StateT WriterState m (Either Inline Element)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift) ((DisplayType -> [Exp] -> Element)
    -> MathType -> Text -> m (Either Inline Element)
    forall (m :: * -> *) a.
    PandocMonad m =>
    (DisplayType -> [Exp] -> a)
    -> MathType -> Text -> m (Either Inline a)
    convertMath DisplayType -> [Exp] -> Element
    writeOMML MathType
    mathType Text
    str)
      case Either Inline Element
    res of
           Right r :: Element
    r -> [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element
    r]
           Left il :: Inline
    il -> WriterOptions -> Inline -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> WS m [Element]
    inlineToOpenXML' WriterOptions
    opts Inline
    il
    inlineToOpenXML' opts :: WriterOptions
    opts (Cite _ lst :: [Inline]
    lst) = WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    lst
    inlineToOpenXML' opts :: WriterOptions
    opts (Code attrs :: Attr
    attrs str :: Text
    str) = do
      let alltoktypes :: [TokenType]
    alltoktypes = [TokenType
    KeywordTok ..]
      [(TokenType, Element)]
    tokTypesMap <- (TokenType
     -> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element))
    -> [TokenType]
    -> ReaderT WriterEnv (StateT WriterState m) [(TokenType, Element)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\tt :: TokenType
    tt -> (,) TokenType
    tt (Element -> (TokenType, Element))
    -> WS m Element
    -> ReaderT WriterEnv (StateT WriterState m) (TokenType, Element)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM (String -> CharStyleName
    forall a. IsString a => String -> a
    fromString (String -> CharStyleName) -> String -> CharStyleName
    forall a b. (a -> b) -> a -> b
    $ TokenType -> String
    forall a. Show a => a -> String
    show TokenType
    tt)) [TokenType]
    alltoktypes
      let unhighlighted :: WS m [Element]
    unhighlighted = [Element] -> [[Element]] -> [Element]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Element
    br] ([[Element]] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    -> WS m [Element]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
                           (Text -> WS m [Element])
    -> [Text] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Text -> WS m [Element]
    forall (m :: * -> *). PandocMonad m => Text -> WS m [Element]
    formattedString (Text -> [Text]
    T.lines Text
    str)
          formatOpenXML :: p -> [[(TokenType, Text)]] -> [Element]
    formatOpenXML _fmtOpts :: p
    _fmtOpts = [Element] -> [[Element]] -> [Element]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Element
    br] ([[Element]] -> [Element])
    -> ([[(TokenType, Text)]] -> [[Element]])
    -> [[(TokenType, Text)]]
    -> [Element]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(TokenType, Text)] -> [Element])
    -> [[(TokenType, Text)]] -> [[Element]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((TokenType, Text) -> Element) -> [(TokenType, Text)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (TokenType, Text) -> Element
    toHlTok)
          toHlTok :: (TokenType, Text) -> Element
    toHlTok (toktype :: TokenType
    toktype,tok :: Text
    tok) =
            String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
              [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                Maybe Element -> [Element]
    forall a. Maybe a -> [a]
    maybeToList (TokenType -> [(TokenType, Element)] -> Maybe Element
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup TokenType
    toktype [(TokenType, Element)]
    tokTypesMap)
                , String -> [(String, String)] -> String -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:t" [("xml:space","preserve")] (Text -> String
    T.unpack Text
    tok) ]
      WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withTextPropM (CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM "Verbatim Char")
        (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ if Maybe Style -> Bool
    forall a. Maybe a -> Bool
    isNothing (WriterOptions -> Maybe Style
    writerHighlightStyle WriterOptions
    opts)
              then WS m [Element]
    unhighlighted
              else case SyntaxMap
    -> (FormatOptions -> [[(TokenType, Text)]] -> [Element])
    -> Attr
    -> Text
    -> Either Text [Element]
    forall a.
    SyntaxMap
    -> (FormatOptions -> [[(TokenType, Text)]] -> a)
    -> Attr
    -> Text
    -> Either Text a
    highlight (WriterOptions -> SyntaxMap
    writerSyntaxMap WriterOptions
    opts)
                          FormatOptions -> [[(TokenType, Text)]] -> [Element]
    forall p. p -> [[(TokenType, Text)]] -> [Element]
    formatOpenXML Attr
    attrs Text
    str of
                        Right h :: [Element]
    h  -> [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    h
                        Left msg :: Text
    msg -> do
                          Bool
    -> ReaderT WriterEnv (StateT WriterState m) ()
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    msg) (ReaderT WriterEnv (StateT WriterState m) ()
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> ReaderT WriterEnv (StateT WriterState m) ()
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
    -> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> LogMessage
    CouldNotHighlight Text
    msg
                          WS m [Element]
    unhighlighted
    inlineToOpenXML' opts :: WriterOptions
    opts (Note bs :: [Block]
    bs) = do
      [Element]
    notes <- (WriterState -> [Element]) -> WS m [Element]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> [Element]
    stFootnotes
      String
    notenum <- WS m String
    forall (m :: * -> *). PandocMonad m => WS m String
    getUniqueId
      Element
    footnoteStyle <- CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM "Footnote Reference"
      let notemarker :: Element
    notemarker = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
                       [ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" [] Element
    footnoteStyle
                       , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnoteRef" [] () ]
      let notemarkerXml :: Inline
    notemarkerXml = Format -> Text -> Inline
    RawInline (Text -> Format
    Format "openxml") (Text -> Inline) -> Text -> Inline
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Element -> String
    ppElement Element
    notemarker
      let insertNoteRef :: [Block] -> [Block]
    insertNoteRef (Plain ils :: [Inline]
    ils : xs :: [Block]
    xs) = [Inline] -> Block
    Plain (Inline
    notemarkerXml Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : Inline
    Space Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : [Inline]
    ils) Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    xs
          insertNoteRef (Para ils :: [Inline]
    ils  : xs :: [Block]
    xs) = [Inline] -> Block
    Para  (Inline
    notemarkerXml Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : Inline
    Space Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : [Inline]
    ils) Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    xs
          insertNoteRef xs :: [Block]
    xs               = [Inline] -> Block
    Para [Inline
    notemarkerXml] Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    xs

      [Element]
    contents <- (WriterEnv -> WriterEnv) -> WS m [Element] -> WS m [Element]
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\env :: WriterEnv
    env -> WriterEnv
    env{ envListLevel :: Int
    envListLevel = -1
                                    , envParaProperties :: EnvProps
    envParaProperties = EnvProps
    forall a. Monoid a => a
    mempty
                                    , envTextProperties :: EnvProps
    envTextProperties = EnvProps
    forall a. Monoid a => a
    mempty })
                  (WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM (ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM "Footnote Text") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Block] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> WS m [Element]
    blocksToOpenXML WriterOptions
    opts
                    ([Block] -> WS m [Element]) -> [Block] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Block] -> [Block]
    insertNoteRef [Block]
    bs)
      let newnote :: Element
    newnote = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnote" [("w:id", String
    notenum)] [Element]
    contents
      (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \s :: WriterState
    s -> WriterState
    s{ stFootnotes :: [Element]
    stFootnotes = Element
    newnote Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    notes }
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
               [ String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rPr" [] Element
    footnoteStyle
               , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnoteReference" [("w:id", String
    notenum)] () ] ]
    -- internal link:
    inlineToOpenXML' opts :: WriterOptions
    opts (Link _ txt :: [Inline]
    txt (Text -> Maybe (Char, Text)
    T.uncons -> Just ('#', xs :: Text
    xs),_)) = do
      [Element]
    contents <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withTextPropM (CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM "Hyperlink") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    txt
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:hyperlink" [("w:anchor", Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    toBookmarkName Text
    xs)] [Element]
    contents ]
    -- external link:
    inlineToOpenXML' opts :: WriterOptions
    opts (Link _ txt :: [Inline]
    txt (src :: Text
    src,_)) = do
      [Element]
    contents <- WS m Element -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withTextPropM (CharStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    CharStyleName -> WS m Element
    rStyleM "Hyperlink") (WS m [Element] -> WS m [Element])
    -> WS m [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    txt
      Map String String
    extlinks <- (WriterState -> Map String String)
    -> ReaderT WriterEnv (StateT WriterState m) (Map String String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map String String
    stExternalLinks
      String
    id' <- case String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text -> String
    T.unpack Text
    src) Map String String
    extlinks of
                Just i :: String
    i   -> String -> WS m String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    i
                Nothing  -> do
                  String
    i <- ("rId"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> WS m String -> WS m String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` WS m String
    forall (m :: * -> *). PandocMonad m => WS m String
    getUniqueId
                  (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st{ stExternalLinks :: Map String String
    stExternalLinks =
                            String -> String -> Map String String -> Map String String
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (Text -> String
    T.unpack Text
    src) String
    i Map String String
    extlinks }
                  String -> WS m String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    i
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:hyperlink" [("r:id",String
    id')] [Element]
    contents ]
    inlineToOpenXML' opts :: WriterOptions
    opts (Image attr :: Attr
    attr@(imgident :: Text
    imgident, _, _) alt :: [Inline]
    alt (src :: Text
    src, title :: Text
    title)) = do
      Integer
    pageWidth <- (WriterEnv -> Integer)
    -> ReaderT WriterEnv (StateT WriterState m) Integer
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Integer
    envPrintWidth
      Map String (String, String, Maybe Text, ByteString)
    imgs <- (WriterState
     -> Map String (String, String, Maybe Text, ByteString))
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         (Map String (String, String, Maybe Text, ByteString))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map String (String, String, Maybe Text, ByteString)
    stImages
      let
        stImage :: Maybe (String, String, Maybe Text, ByteString)
    stImage = String
    -> Map String (String, String, Maybe Text, ByteString)
    -> Maybe (String, String, Maybe Text, ByteString)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text -> String
    T.unpack Text
    src) Map String (String, String, Maybe Text, ByteString)
    imgs
        generateImgElt :: (String, b, c, ByteString) -> Element
    generateImgElt (ident :: String
    ident, _, _, img :: ByteString
    img) =
          let
            (xpt :: Double
    xpt,ypt :: Double
    ypt) = WriterOptions -> Attr -> ImageSize -> (Double, Double)
    desiredSizeInPoints WriterOptions
    opts Attr
    attr
                   ((Text -> ImageSize)
    -> (ImageSize -> ImageSize) -> Either Text ImageSize -> ImageSize
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ImageSize -> Text -> ImageSize
    forall a b. a -> b -> a
    const ImageSize
    forall a. Default a => a
    def) ImageSize -> ImageSize
    forall a. a -> a
    id (WriterOptions -> ByteString -> Either Text ImageSize
    imageSize WriterOptions
    opts ByteString
    img))
            -- 12700 emu = 1 pt
            (xemu :: Integer
    xemu,yemu :: Integer
    yemu) = (Double, Double) -> Integer -> (Integer, Integer)
    fitToPage (Double
    xpt Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * 12700, Double
    ypt Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * 12700)
                                    (Integer
    pageWidth Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 12700)
            cNvPicPr :: Element
    cNvPicPr = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:cNvPicPr" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                             String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:picLocks" [("noChangeArrowheads","1")
                                                 ,("noChangeAspect","1")] ()
            nvPicPr :: Element
    nvPicPr  = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:nvPicPr" []
                            [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:cNvPr"
                                [("descr",Text -> String
    T.unpack Text
    src),("id","0"),("name","Picture")] ()
                            , Element
    cNvPicPr ]
            blipFill :: Element
    blipFill = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:blipFill" []
              [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:blip" [("r:embed",String
    ident)] ()
              , String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:stretch" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                  String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:fillRect" [] ()
              ]
            xfrm :: Element
    xfrm =    String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:xfrm" []
                            [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:off" [("x","0"),("y","0")] ()
                            , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:ext" [("cx",Integer -> String
    forall a. Show a => a -> String
    show Integer
    xemu)
                                             ,("cy",Integer -> String
    forall a. Show a => a -> String
    show Integer
    yemu)] () ]
            prstGeom :: Element
    prstGeom = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:prstGeom" [("prst","rect")] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                             String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:avLst" [] ()
            ln :: Element
    ln =      String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:ln" [("w","9525")]
                            [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:noFill" [] ()
                            , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:headEnd" [] ()
                            , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:tailEnd" [] () ]
            spPr :: Element
    spPr =    String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:spPr" [("bwMode","auto")]
                            [Element
    xfrm, Element
    prstGeom, String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:noFill" [] (), Element
    ln]
            graphic :: Element
    graphic = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:graphic" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
              String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "a:graphicData"
                [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
                [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "pic:pic" []
                  [ Element
    nvPicPr
                  , Element
    blipFill
                  , Element
    spPr
                  ]
                ]
            imgElt :: Element
    imgElt = String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
              String -> [(String, String)] -> Element -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:drawing" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "wp:inline" []
                  [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "wp:extent" [("cx",Integer -> String
    forall a. Show a => a -> String
    show Integer
    xemu),("cy",Integer -> String
    forall a. Show a => a -> String
    show Integer
    yemu)] ()
                  , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "wp:effectExtent"
                    [("b","0"),("l","0"),("r","0"),("t","0")] ()
                  , String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "wp:docPr"
                    [ ("descr", Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    alt)
                    , ("title", Text -> String
    T.unpack Text
    title)
                    , ("id","1")
                    , ("name","Picture")
                    ] ()
                  , Element
    graphic
                  ]
          in
            Element
    imgElt

      Text -> [Element] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> [Element] -> WS m [Element]
    wrapBookmark Text
    imgident ([Element] -> WS m [Element]) -> WS m [Element] -> WS m [Element]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< case Maybe (String, String, Maybe Text, ByteString)
    stImage of
        Just imgData :: (String, String, Maybe Text, ByteString)
    imgData -> [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, String, Maybe Text, ByteString) -> Element
    forall b c. (String, b, c, ByteString) -> Element
    generateImgElt (String, String, Maybe Text, ByteString)
    imgData]
        Nothing -> ( do --try
          (img :: ByteString
    img, mt :: Maybe Text
    mt) <- Text
    -> ReaderT
         WriterEnv (StateT WriterState m) (ByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (ByteString, Maybe Text)
    P.fetchItem Text
    src
          String
    ident <- ("rId"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> WS m String -> WS m String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` WS m String
    forall (m :: * -> *). PandocMonad m => WS m String
    getUniqueId

          let
            imgext :: Text
    imgext = case Maybe Text
    mt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text
    extensionFromMimeType of
              Just x :: Text
    x    -> "." Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    x
              Nothing   -> case ByteString -> Maybe ImageType
    imageType ByteString
    img of
                Just Png  -> ".png"
                Just Jpeg -> ".jpeg"
                Just Gif  -> ".gif"
                Just Pdf  -> ".pdf"
                Just Eps  -> ".eps"
                Just Svg  -> ".svg"
                Just Emf  -> ".emf"
                Nothing   -> ""
            imgpath :: String
    imgpath = "media/" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ident String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack Text
    imgext
            mbMimeType :: Maybe Text
    mbMimeType = Maybe Text
    mt Maybe Text -> Maybe Text -> Maybe Text
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> Maybe Text
    getMimeType String
    imgpath

            imgData :: (String, String, Maybe Text, ByteString)
    imgData = (String
    ident, String
    imgpath, Maybe Text
    mbMimeType, ByteString
    img)

          if Text -> Bool
    T.null Text
    imgext
             then -- without an extension there is no rule for content type
               WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    alt -- return alt to avoid corrupted docx
             else do
               -- insert mime type to use in constructing [Content_Types].xml
               (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: WriterState
    st -> WriterState
    st { stImages :: Map String (String, String, Maybe Text, ByteString)
    stImages = String
    -> (String, String, Maybe Text, ByteString)
    -> Map String (String, String, Maybe Text, ByteString)
    -> Map String (String, String, Maybe Text, ByteString)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (Text -> String
    T.unpack Text
    src) (String, String, Maybe Text, ByteString)
    imgData (Map String (String, String, Maybe Text, ByteString)
     -> Map String (String, String, Maybe Text, ByteString))
    -> Map String (String, String, Maybe Text, ByteString)
    -> Map String (String, String, Maybe Text, ByteString)
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Map String (String, String, Maybe Text, ByteString)
    stImages WriterState
    st }
               [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, String, Maybe Text, ByteString) -> Element
    forall b c. (String, b, c, ByteString) -> Element
    generateImgElt (String, String, Maybe Text, ByteString)
    imgData]
          )
          WS m [Element] -> (PandocError -> WS m [Element]) -> WS m [Element]
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` ( \e :: PandocError
    e -> do
            LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> ReaderT WriterEnv (StateT WriterState m) ())
    -> LogMessage -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> LogMessage
    CouldNotFetchResource Text
    src (Text -> LogMessage) -> Text -> LogMessage
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (PandocError -> String
    forall a. Show a => a -> String
    show PandocError
    e)
            -- emit alt text
            WriterOptions -> [Inline] -> WS m [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> WS m [Element]
    inlinesToOpenXML WriterOptions
    opts [Inline]
    alt
          )

    br :: Element
    br :: Element
    br = String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" [] [String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:br" [] ()]

    -- Word will insert these footnotes into the settings.xml file
    -- (whether or not they're visible in the document). If they're in the
    -- file, but not in the footnotes.xml file, it will produce
    -- problems. So we want to make sure we insert them into our document.
    defaultFootnotes :: [Element]
    defaultFootnotes :: [Element]
    defaultFootnotes = [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnote"
                         [("w:type", "separator"), ("w:id", "-1")]
                         [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" []
                           [String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
                            [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:separator" [] ()]]]
                       , String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:footnote"
                         [("w:type", "continuationSeparator"), ("w:id", "0")]
                         [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:p" []
                           [ String -> [(String, String)] -> [Element] -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:r" []
                             [ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:continuationSeparator" [] ()]]]]

    withDirection :: PandocMonad m => WS m a -> WS m a
    withDirection :: WS m a -> WS m a
    withDirection x :: WS m a
    x = do
      Bool
    isRTL <- (WriterEnv -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Bool
    envRTL
      EnvProps
    paraProps <- (WriterEnv -> EnvProps)
    -> ReaderT WriterEnv (StateT WriterState m) EnvProps
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> EnvProps
    envParaProperties
      EnvProps
    textProps <- (WriterEnv -> EnvProps)
    -> ReaderT WriterEnv (StateT WriterState m) EnvProps
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> EnvProps
    envTextProperties
      -- We want to clean all bidirection (bidi) and right-to-left (rtl)
      -- properties from the props first. This is because we don't want
      -- them to stack up.
      let paraProps' :: [Element]
    paraProps' = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\e :: Element
    e -> (QName -> String
    qName (QName -> String) -> (Element -> QName) -> Element -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> QName
    elName) Element
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "bidi") (EnvProps -> [Element]
    otherElements EnvProps
    paraProps)
          textProps' :: [Element]
    textProps' = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\e :: Element
    e -> (QName -> String
    qName (QName -> String) -> (Element -> QName) -> Element -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> QName
    elName) Element
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "rtl") (EnvProps -> [Element]
    otherElements EnvProps
    textProps)
          paraStyle :: Maybe Element
    paraStyle = EnvProps -> Maybe Element
    styleElement EnvProps
    paraProps
          textStyle :: Maybe Element
    textStyle = EnvProps -> Maybe Element
    styleElement EnvProps
    textProps
      if Bool
    isRTL
        -- if we are going right-to-left, we (re?)add the properties.
        then ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
    -> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local WS m a
    x ((WriterEnv -> WriterEnv) -> WS m a)
    -> (WriterEnv -> WriterEnv) -> WS m a
    forall a b. (a -> b) -> a -> b
    $
             \env :: WriterEnv
    env -> WriterEnv
    env { envParaProperties :: EnvProps
    envParaProperties = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    paraStyle ([Element] -> EnvProps) -> [Element] -> EnvProps
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:bidi" [] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    paraProps'
                         , envTextProperties :: EnvProps
    envTextProperties = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    textStyle ([Element] -> EnvProps) -> [Element] -> EnvProps
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:rtl" [] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    textProps'
                         }
        else ((WriterEnv -> WriterEnv) -> WS m a -> WS m a)
    -> WS m a -> (WriterEnv -> WriterEnv) -> WS m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local WS m a
    x ((WriterEnv -> WriterEnv) -> WS m a)
    -> (WriterEnv -> WriterEnv) -> WS m a
    forall a b. (a -> b) -> a -> b
    $ \env :: WriterEnv
    env -> WriterEnv
    env { envParaProperties :: EnvProps
    envParaProperties = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    paraStyle [Element]
    paraProps'
                                        , envTextProperties :: EnvProps
    envTextProperties = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    textStyle [Element]
    textProps'
                                        }

    wrapBookmark :: (PandocMonad m) => T.Text -> [Element] -> WS m [Element]
    wrapBookmark :: Text -> [Element] -> WS m [Element]
    wrapBookmark "" contents :: [Element]
    contents = [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element]
    contents
    wrapBookmark ident :: Text
    ident contents :: [Element]
    contents = do
      String
    id' <- WS m String
    forall (m :: * -> *). PandocMonad m => WS m String
    getUniqueId
      let bookmarkStart :: Element
    bookmarkStart = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:bookmarkStart"
                           [("w:id", String
    id')
                           ,("w:name", Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    toBookmarkName Text
    ident)] ()
          bookmarkEnd :: Element
    bookmarkEnd = String -> [(String, String)] -> () -> Element
    forall t. Node t => String -> [(String, String)] -> t -> Element
    mknode "w:bookmarkEnd" [("w:id", String
    id')] ()
      [Element] -> WS m [Element]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> WS m [Element]) -> [Element] -> WS m [Element]
    forall a b. (a -> b) -> a -> b
    $ Element
    bookmarkStart Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    contents [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element
    bookmarkEnd]

    -- Word imposes a 40 character limit on bookmark names and requires
    -- that they begin with a letter.  So we just use a hash of the
    -- identifier when otherwise we'd have an illegal bookmark name.
    toBookmarkName :: T.Text -> T.Text
    toBookmarkName :: Text -> Text
    toBookmarkName s :: Text
    s
      | Just (c :: Char
    c, _) <- Text -> Maybe (Char, Text)
    T.uncons Text
    s
      , Char -> Bool
    isLetter Char
    c
      , Text -> Int
    T.length Text
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 40 = Text
    s
      | Bool
    otherwise = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ 'X' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 1 (Digest SHA1State -> String
    forall t. Digest t -> String
    showDigest (ByteString -> Digest SHA1State
    sha1 (Text -> ByteString
    fromTextLazy (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    TL.fromStrict Text
    s)))