    {-# LANGUAGE PatternGuards       #-}
    {-# LANGUAGE RankNTypes          #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns        #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {- |
       Module      : Text.Pandoc.Writers.Docx
       Copyright   : Copyright (C) 2012-2025 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
        ( Archive(zEntries),
          addEntryToArchive,
          emptyArchive,
          findEntryByPath,
          fromArchive,
          toArchive,
          toEntry,
          Entry(eRelativePath) )
    import Control.Monad (MonadPlus(mplus), foldM)
    import Control.Monad.Except (throwError)
    import Control.Monad.Reader ( ReaderT(runReaderT) )
    import Control.Monad.State.Strict ( StateT(runStateT) )
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import Data.Containers.ListUtils (nubOrd)
    import Data.Char (isSpace)
    import Data.List (isPrefixOf, isSuffixOf)
    import Data.String (fromString)
    import qualified Data.Map as M
    import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
    import qualified Data.Set as Set
    import qualified Data.Text as T
    import Data.Text (Text)
    import Data.Time.Clock.POSIX
    import Skylighting
    import Text.Pandoc.Class (PandocMonad, toLang)
    import qualified Text.Pandoc.Class.PandocMonad as P
    import Text.Pandoc.Data (readDataFile, readDefaultDataFile)
    import Data.Time
    import qualified Text.Pandoc.UTF8 as UTF8
    import Text.Pandoc.Definition
    import Text.Pandoc.Error
    import Text.Pandoc.Highlighting (defaultStyle)
    import Text.Pandoc.MIME (MimeType, getMimeTypeDef)
    import Text.Pandoc.Options
    import Text.Pandoc.Writers.Docx.StyleMap
    import Text.Pandoc.Writers.Docx.Types
    import Text.Pandoc.Writers.Docx.OpenXML (writeOpenXML, maxListLevel)
    import Text.Pandoc.Shared
    import Text.Pandoc.Walk
    import Text.Pandoc.Writers.Shared
    import Text.Pandoc.Writers.OOXML
    import Text.Pandoc.XML.Light as XML
    import Text.Collate.Lang (renderLang, Lang(..))

    writeDocx :: (PandocMonad m)
              => WriterOptions  -- ^ Writer options
              -> Pandoc         -- ^ Document to convert
              -> m BL.ByteString
    writeDocx :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m ByteString
    writeDocx WriterOptions
    opts Pandoc
    doc = do
      -- Phase 1: Document preprocessing
      let Pandoc Meta
    meta [Block]
    blocks = (Block -> Block) -> Pandoc -> Pandoc
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Block -> Block
    fixDisplayMath Pandoc
    doc
      Meta -> m ()
    forall (m :: * -> *). PandocMonad m => Meta -> m ()
    setupTranslations Meta
    meta
      let blocks' :: [Block]
    blocks' = [Int] -> Bool -> Maybe Int -> [Block] -> [Block]
    makeSectionsWithOffsets (WriterOptions -> [Int]
    writerNumberOffset WriterOptions
    opts)
                       Bool
    True Maybe Int
    forall a. Maybe a
    Nothing [Block]
    blocks
      let doc' :: Pandoc
    doc' = Meta -> [Block] -> Pandoc
    Pandoc Meta
    meta [Block]
    blocks'

      -- Phase 2: Archive loading
      (refArchive, distArchive, username, utctime) <- WriterOptions -> m (Archive, Archive, Maybe Text, UTCTime)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> m (Archive, Archive, Maybe Text, UTCTime)
    loadArchives WriterOptions
    opts
      let epochtime = POSIXTime -> Integer
    forall b. Integral b => POSIXTime -> b
    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

      -- Phase 3: Page layout extraction
      (mbsectpr, pgContentWidth) <- extractPageLayout refArchive distArchive

      -- Phase 4: Language & style setup
      mblang <- toLang $ getLang opts meta
      let addLang = Maybe Lang -> Element -> Element
    mkLangTransformer Maybe Lang
    mblang
      styledoc <- addLang <$> parseXml refArchive distArchive "word/styles.xml"
      let styleMaps = Archive -> StyleMaps
    getStyleMaps Archive
    refArchive

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

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

      let env = WriterEnv
    defaultWriterEnv {
              envRTL = isRTLmeta
            , envChangesAuthor = fromMaybe "unknown" username
            , envChangesDate   = T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime
            , envPrintWidth = maybe 420 (`quot` 20) pgContentWidth
            }

      -- Phase 5: Relationship extraction
      (baserels, headers, footers, newMaxRelId) <- extractRelationships refArchive distArchive

      let initialSt = WriterState
    defaultWriterState {
              stStyleMaps  = styleMaps
            , stTocTitle   = tocTitle
            , stCurId      = newMaxRelId + 1
            }

      -- Phase 6: Core content generation
      -- adjust contents to add sectPr from reference.docx
      let sectpr = case Maybe Element
    mbsectpr of
            Just Element
    sectpr' -> [Attr] -> Element -> Element
    add_attrs (Element -> [Attr]
    elAttribs Element
    sectpr') (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:sectPr" []
                                 (Element -> [Element]
    elChildren Element
    sectpr')
            Maybe Element
    Nothing      -> Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:sectPr" []
                              [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:footnotePr" []
                                [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:numRestart" [(Text
    "w:val",Text
    "eachSect")] () ]
                              ]

      ((contents, footnotes, comments), st) <- runStateT
                             (runReaderT
                              (writeOpenXML opts{ writerWrapText = WrapNone }
                                            doc')
                              env{ envSectPr = Just sectpr })
                             initialSt
      let 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

      -- Phase 7: XML document construction
      -- 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.
      let contentTypesEntry = Integer
    -> [(String, String, Maybe Text, ByteString)]
    -> [Element]
    -> [Element]
    -> Archive
    -> Entry
    mkContentTypesEntry Integer
    epochtime [(String, String, Maybe Text, ByteString)]
    imgs [Element]
    headers [Element]
    footers Archive
    refArchive
      let relEntry = Integer
    -> [Element]
    -> [(String, String, Maybe Text, ByteString)]
    -> Map Text Text
    -> Entry
    mkDocumentRelsEntry Integer
    epochtime [Element]
    baserels [(String, String, Maybe Text, ByteString)]
    imgs (WriterState -> Map Text Text
    stExternalLinks WriterState
    st)
      let contentEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "word/document.xml" Integer
    epochtime
                           (ByteString -> ByteString
    BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    UTF8.fromText Text
    contents)
      let footnotesEntry = Integer -> [Element] -> Entry
    mkFootnotesEntry Integer
    epochtime [Element]
    footnotes
      let footnoteRelEntry = Integer -> Map Text Text -> Entry
    mkFootnoteRelsEntry Integer
    epochtime (WriterState -> Map Text Text
    stExternalLinks WriterState
    st)
      let commentsEntry = Integer -> [Element] -> Entry
    mkCommentsEntry Integer
    epochtime [Element]
    comments
      let styleEntry = Integer
    -> Element -> StyleMaps -> WriterState -> WriterOptions -> Entry
    mkStylesEntry Integer
    epochtime Element
    styledoc StyleMaps
    styleMaps WriterState
    st WriterOptions
    opts
      numEntry <- mkNumberingEntry refArchive distArchive epochtime (stLists st)
      let docPropsEntry = Integer -> UTCTime -> Meta -> Entry
    mkCorePropsEntry Integer
    epochtime UTCTime
    utctime Meta
    meta
      let customPropsEntry = Integer -> Meta -> Entry
    mkCustomPropsEntry Integer
    epochtime Meta
    meta
      let relsEntry = Integer -> Entry
    mkPackageRelsEntry Integer
    epochtime

      -- 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
      settingsEntry <- copyChildren refArchive distArchive "word/settings.xml"
                         epochtime settingsElementNames

      -- Phase 8: Archive assembly
      let toImageEntry (a
    _, String
    path, c
    _, ByteString
    img) = String -> Integer -> ByteString -> Entry
    toEntry (String
    "word/" String -> String -> String
    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 = ((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

      refEntries <- collectReferenceEntries refArchive distArchive headers footers

      let archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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
    customPropsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    settingsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      [Entry]
    imageEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    refEntries
      return $ fromArchive 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 Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:style" [ (Text
    "w:type", Text
    "paragraph")
                          , (Text
    "w:customStyle", Text
    "1")
                          , (Text
    "w:styleId", Text
    styleId)]
         [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:name" [(Text
    "w:val", Text
    s)] ()
         , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:basedOn" [(Text
    "w:val",Text
    "BodyText")] ()
         , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "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 Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:style" [ (Text
    "w:type", Text
    "character")
                          , (Text
    "w:customStyle", Text
    "1")
                          , (Text
    "w:styleId", Text
    styleId)]
         [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:name" [(Text
    "w:val", Text
    s)] ()
         , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:basedOn" [(Text
    "w:val",Text
    "BodyTextChar")] ()
         ]

    styleToOpenXml :: StyleMaps -> Style -> [Element]
    styleToOpenXml :: StyleMaps -> Style -> [Element]
    styleToOpenXml StyleMaps
    sm Style
    style =
      Maybe Element -> [Element]
    forall a. Maybe a -> [a]
    maybeToList Maybe Element
    parStyle [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ (TokenType -> Maybe Element) -> [TokenType] -> [Element]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TokenType -> Maybe Element
    toStyle [TokenType]
    alltoktypes
      where alltoktypes :: [TokenType]
    alltoktypes = TokenType -> TokenType -> [TokenType]
    forall a. Enum a => a -> a -> [a]
    enumFromTo TokenType
    KeywordTok TokenType
    NormalTok
            toStyle :: TokenType -> Maybe Element
    toStyle TokenType
    toktype | CharStyleName -> Map CharStyleName CharStyle -> 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 -> Map CharStyleName CharStyle
    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
    $
                              Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:style" [(Text
    "w:type",Text
    "character"),
                               (Text
    "w:customStyle",Text
    "1"),(Text
    "w:styleId", TokenType -> Text
    forall a. Show a => a -> Text
    tshow TokenType
    toktype)]
                                 [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:name" [(Text
    "w:val", TokenType -> Text
    forall a. Show a => a -> Text
    tshow TokenType
    toktype)] ()
                                 , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:basedOn" [(Text
    "w:val",Text
    "VerbatimChar")] ()
                                 , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:rPr" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                                   [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:b" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenBold TokenType
    toktype ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:i" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenItalic TokenType
    toktype ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:color" [(Text
    "w:val", TokenType -> Text
    tokCol TokenType
    toktype)] ()
                                     | TokenType -> Text
    tokCol TokenType
    toktype Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "auto" ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:u" [] () | (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenUnderline TokenType
    toktype ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                                   [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:shd" [(Text
    "w:val",Text
    "clear")
                                                    ,(Text
    "w:fill",TokenType -> Text
    tokBg TokenType
    toktype)] ()
                                     | TokenType -> Text
    tokBg TokenType
    toktype Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "auto" ]
                                 ]
            tokStyles :: Map TokenType TokenStyle
    tokStyles = Style -> Map TokenType TokenStyle
    tokenStyles Style
    style
            tokFeature :: (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    f TokenType
    toktype = Bool -> (TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False TokenStyle -> Bool
    f (Maybe TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
    forall a b. (a -> b) -> a -> b
    $ TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles
            tokCol :: TokenType -> Text
    tokCol TokenType
    toktype = Text -> (Color -> Text) -> Maybe Color -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "auto" (String -> Text
    T.pack (String -> Text) -> (Color -> String) -> Color -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 (String -> String) -> (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 -> Text) -> Maybe Color -> Text
    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 a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Style -> Maybe Color
    defaultColor Style
    style
            tokBg :: TokenType -> Text
    tokBg TokenType
    toktype = Text -> (Color -> Text) -> Maybe Color -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "auto" (String -> Text
    T.pack (String -> Text) -> (Color -> String) -> Color -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 (String -> String) -> (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 -> Text) -> Maybe Color -> Text
    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 a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Style -> Maybe Color
    backgroundColor Style
    style
            parStyle :: Maybe Element
    parStyle | ParaStyleName -> Map ParaStyleName ParStyle -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName ParaStyleName
    "Source Code" (StyleMaps -> Map ParaStyleName ParStyle
    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
    $
                       Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:style" [(Text
    "w:type",Text
    "paragraph"),
                               (Text
    "w:customStyle",Text
    "1"),(Text
    "w:styleId",Text
    "SourceCode")]
                                 [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:name" [(Text
    "w:val",Text
    "Source Code")] ()
                                 , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:basedOn" [(Text
    "w:val",Text
    "Normal")] ()
                                 , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:link" [(Text
    "w:val",Text
    "VerbatimChar")] ()
                                 , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:pPr" []
                                   ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:wordWrap" [(Text
    "w:val",Text
    "off")] ()
                                   Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :
                             [Element] -> (Color -> [Element]) -> Maybe Color -> [Element]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Color
    col -> [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:shd" [(Text
    "w:val",Text
    "clear"),(Text
    "w:fill", String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 (String -> String) -> String -> String
    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 -> [Text] -> m Entry
    copyChildren :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> Integer -> [Text] -> m Entry
    copyChildren Archive
    refArchive Archive
    distArchive String
    path Integer
    timestamp [Text]
    elNames = do
      ref  <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    path
      dist <- parseXml distArchive distArchive path
      els <- foldM (addEl ref dist) [] (reverse elNames)
      return $ toEntry path timestamp
             $ renderXml dist{ elContent = map cleanElem els }
      where
        addEl :: Element -> Element -> [Element] -> Text -> f [Element]
    addEl Element
    ref Element
    dist [Element]
    els Text
    name =
          case (QName -> Bool) -> Element -> Maybe Element
    filterChildName (Text -> QName -> Bool
    hasName Text
    name) Element
    ref Maybe Element -> Maybe Element -> Maybe Element
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                 (QName -> Bool) -> Element -> Maybe Element
    filterChildName (Text -> QName -> Bool
    hasName Text
    name) Element
    dist of
            Just Element
    el -> [Element] -> f [Element]
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Element
    el Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    els)
            Maybe Element
    Nothing -> [Element] -> f [Element]
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Element]
    els
        hasName :: Text -> QName -> Bool
    hasName Text
    name = (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    name) (Text -> Bool) -> (QName -> Text) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Text
    qName
        cleanElem :: Element -> Content
    cleanElem el :: Element
    el@Element{elName :: Element -> QName
    elName=QName
    name} = Element -> Content
    Elem Element
    el{elName=name{qURI=Nothing}}

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

    -- | Standard XML namespace attributes for docx elements
    stdAttributes :: [(Text, Text)]
    stdAttributes :: [(Text, Text)]
    stdAttributes =
      [(Text
    "xmlns:w",Text
    "http://schemas.openxmlformats.org/wordprocessingml/2006/main")
      ,(Text
    "xmlns:m",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/math")
      ,(Text
    "xmlns:r",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
      ,(Text
    "xmlns:o",Text
    "urn:schemas-microsoft-com:office:office")
      ,(Text
    "xmlns:v",Text
    "urn:schemas-microsoft-com:vml")
      ,(Text
    "xmlns:w10",Text
    "urn:schemas-microsoft-com:office:word")
      ,(Text
    "xmlns:a",Text
    "http://schemas.openxmlformats.org/drawingml/2006/main")
      ,(Text
    "xmlns:pic",Text
    "http://schemas.openxmlformats.org/drawingml/2006/picture")
      ,(Text
    "xmlns:wp",Text
    "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]

    -- | Settings elements to copy from reference.docx (order matters)
    settingsElementNames :: [Text]
    settingsElementNames :: [Text]
    settingsElementNames =
      [ Text
    "writeProtection"
      , Text
    "view"
      , Text
    "zoom"
      , Text
    "removePersonalInformation"
      , Text
    "removeDateAndTime"
      , Text
    "doNotDisplayPageBoundaries"
      , Text
    "displayBackgroundShape"
      , Text
    "printPostScriptOverText"
      , Text
    "printFractionalCharacterWidth"
      , Text
    "printFormsData"
      , Text
    "embedTrueTypeFonts"
      , Text
    "embedSystemFonts"
      , Text
    "saveSubsetFonts"
      , Text
    "saveFormsData"
      , Text
    "mirrorMargins"
      , Text
    "alignBordersAndEdges"
      , Text
    "bordersDoNotSurroundHeader"
      , Text
    "bordersDoNotSurroundFooter"
      , Text
    "gutterAtTop"
      , Text
    "hideSpellingErrors"
      , Text
    "hideGrammaticalErrors"
      , Text
    "activeWritingStyle"
      , Text
    "proofState"
      , Text
    "formsDesign"
      , Text
    "attachedTemplate"
      , Text
    "linkStyles"
      , Text
    "stylePaneFormatFilter"
      , Text
    "stylePaneSortMethod"
      , Text
    "documentType"
      , Text
    "mailMerge"
      , Text
    "revisionView"
      , Text
    "trackRevisions"
      , Text
    "doNotTrackMoves"
      , Text
    "doNotTrackFormatting"
      , Text
    "documentProtection"
      , Text
    "autoFormatOverride"
      , Text
    "styleLockTheme"
      , Text
    "styleLockQFSet"
      , Text
    "defaultTabStop"
      , Text
    "autoHyphenation"
      , Text
    "consecutiveHyphenLimit"
      , Text
    "hyphenationZone"
      , Text
    "doNotHyphenateCaps"
      , Text
    "showEnvelope"
      , Text
    "summaryLength"
      , Text
    "clickAndTypeStyle"
      , Text
    "defaultTableStyle"
      , Text
    "evenAndOddHeaders"
      , Text
    "bookFoldRevPrinting"
      , Text
    "bookFoldPrinting"
      , Text
    "bookFoldPrintingSheets"
      , Text
    "drawingGridHorizontalSpacing"
      , Text
    "drawingGridVerticalSpacing"
      , Text
    "displayHorizontalDrawingGridEvery"
      , Text
    "displayVerticalDrawingGridEvery"
      , Text
    "doNotUseMarginsForDrawingGridOrigin"
      , Text
    "drawingGridHorizontalOrigin"
      , Text
    "drawingGridVerticalOrigin"
      , Text
    "doNotShadeFormData"
      , Text
    "noPunctuationKerning"
      , Text
    "characterSpacingControl"
      , Text
    "printTwoOnOne"
      , Text
    "strictFirstAndLastChars"
      , Text
    "noLineBreaksAfter"
      , Text
    "noLineBreaksBefore"
      , Text
    "savePreviewPicture"
      , Text
    "doNotValidateAgainstSchema"
      , Text
    "saveInvalidXml"
      , Text
    "ignoreMixedContent"
      , Text
    "alwaysShowPlaceholderText"
      , Text
    "doNotDemarcateInvalidXml"
      , Text
    "saveXmlDataOnly"
      , Text
    "useXSLTWhenSaving"
      , Text
    "saveThroughXslt"
      , Text
    "showXMLTags"
      , Text
    "alwaysMergeEmptyNamespace"
      , Text
    "updateFields"
      , Text
    "hdrShapeDefaults"
      -- , "footnotePr" -- this can cause problems, see #9522
      -- , "endnotePr"
      , Text
    "compat"
      , Text
    "docVars"
      , Text
    "rsids"
      , Text
    "attachedSchema"
      , Text
    "themeFontLang"
      , Text
    "clrSchemeMapping"
      , Text
    "doNotIncludeSubdocsInStats"
      , Text
    "doNotAutoCompressPictures"
      , Text
    "forceUpgrade"
      , Text
    "captions"
      , Text
    "readModeInkLockDown"
      , Text
    "smartTagType"
      , Text
    "shapeDefaults"
      , Text
    "doNotEmbedSmartTags"
      , Text
    "decimalSymbol"
      , Text
    "listSeparator" ]

    mkNumbering :: [ListMarker] -> [Element]
    mkNumbering :: [ListMarker] -> [Element]
    mkNumbering [ListMarker]
    lists =
      [Element]
    elts [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ (ListMarker -> Int -> Element)
    -> [ListMarker] -> [Int] -> [Element]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ListMarker -> Int -> Element
    mkNum [ListMarker]
    lists [Int
    baseListId..(Int
    baseListId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [ListMarker] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ListMarker]
    lists Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)]
        where elts :: [Element]
    elts = (ListMarker -> Element) -> [ListMarker] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map ListMarker -> Element
    mkAbstractNum ([ListMarker] -> [ListMarker]
    forall a. Ord a => [a] -> [a]
    nubOrd [ListMarker]
    lists)

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

    mkAbstractNum :: ListMarker -> Element
    mkAbstractNum :: ListMarker -> Element
    mkAbstractNum ListMarker
    marker =
      Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:abstractNum" [(Text
    "w:abstractNumId",ListMarker -> Text
    listMarkerToId ListMarker
    marker)]
        ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:nsid" [(Text
    "w:val", Int -> Char -> Text -> Text
    T.justifyRight Int
    8 Char
    '0' (Text
    "A" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ListMarker -> Text
    listMarkerToId ListMarker
    marker))] ()
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:multiLevelType" [(Text
    "w:val",Text
    "multilevel")] ()
        Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : (Int -> Element) -> [Int] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (ListMarker -> Int -> Element
    mkLvl ListMarker
    marker)
          [Int
    0..Int
    maxListLevel]

    mkLvl :: ListMarker -> Int -> Element
    mkLvl :: ListMarker -> Int -> Element
    mkLvl ListMarker
    marker Int
    lvl =
      Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:lvl" [(Text
    "w:ilvl",Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    lvl)] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
        (case ListMarker
    marker of
            NumberMarker{} -> [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:start" [(Text
    "w:val",Text
    start)] ()]
            ListMarker
    _ -> []) [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
        [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:numFmt" [(Text
    "w:val",Text
    fmt)] ()
        , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:lvlText" [(Text
    "w:val", Text
    lvltxt)] ()
        , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:lvlJc" [(Text
    "w:val",Text
    "left")] ()
        , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:pPr" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
            Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:ind" [ (Text
    "w:left",Int -> Text
    forall a. Show a => a -> Text
    tshow (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    step Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    step)
                           , (Text
    "w:hanging",Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    hang)
                           ] ()
        ] [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
        [Element] -> (Text -> [Element]) -> Maybe Text -> [Element]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Text
    font ->
                    [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:rPr" []
                      [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:rFonts" [ (Text
    "w:ascii", Text
    font)
                                          , (Text
    "w:hAnsi", Text
    font)
                                          , (Text
    "w:cs", Text
    font)
                                          , (Text
    "w:hint", Text
    "default") ] () ]]) Maybe Text
    mbfont
        where (Text
    fmt, Text
    lvltxt, Maybe Text
    mbfont, Text
    start) =
                case ListMarker
    marker of
                     ListMarker
    NoMarker             -> (Text
    "bullet",Text
    " ", Maybe Text
    forall a. Maybe a
    Nothing, Text
    "1")
                     ListMarker
    BulletMarker         -> Int -> (Text, Text, Maybe Text, Text)
    forall {t} {a} {b} {a} {d}.
    (IsString a, IsString b, IsString a, IsString d, Integral t) =>
    t -> (a, b, Maybe a, d)
    bulletFor Int
    lvl
                     CheckboxMarker Bool
    False -> (Text
    "bullet",Text
    "\9744", Maybe Text
    forall a. Maybe a
    Nothing, Text
    "1")
                     CheckboxMarker Bool
    True  -> (Text
    "bullet",Text
    "\9746", Maybe Text
    forall a. Maybe a
    Nothing, Text
    "1")
                     NumberMarker ListNumberStyle
    st ListNumberDelim
    de Int
    n -> (ListNumberStyle -> Int -> Text
    forall {t} {t}.
    (IsString t, Integral t) =>
    ListNumberStyle -> t -> t
    styleFor ListNumberStyle
    st Int
    lvl
                                             ,ListNumberDelim -> Text -> Text
    forall {a}. (Semigroup a, IsString a) => ListNumberDelim -> a -> a
    patternFor ListNumberDelim
    de (Text
    "%" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow (Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
                                             ,Maybe Text
    forall a. Maybe a
    Nothing
                                             ,Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n)
              step :: Int
    step = Int
    720
              hang :: Int
              hang :: Int
    hang = Int
    360
              bulletFor :: t -> (a, b, Maybe a, d)
    bulletFor t
    0 = (a
    "bullet", b
    "\xf0b7", a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "Symbol", d
    "1") -- filled circle
              bulletFor t
    1 = (a
    "bullet", b
    "o", a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "Courier New", d
    "1") -- open o
              bulletFor t
    2 = (a
    "bullet", b
    "\xf0a7", a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "Wingdings", d
    "1")  -- closed box
              bulletFor t
    x = t -> (a, b, Maybe a, d)
    bulletFor (t
    x t -> t -> t
    forall a. Integral a => a -> a -> a
    `mod` t
    3)
              styleFor :: ListNumberStyle -> t -> t
    styleFor ListNumberStyle
    UpperAlpha t
    _   = t
    "upperLetter"
              styleFor ListNumberStyle
    LowerAlpha t
    _   = t
    "lowerLetter"
              styleFor ListNumberStyle
    UpperRoman t
    _   = t
    "upperRoman"
              styleFor ListNumberStyle
    LowerRoman t
    _   = t
    "lowerRoman"
              styleFor ListNumberStyle
    Decimal t
    _      = t
    "decimal"
              styleFor ListNumberStyle
    DefaultStyle t
    0 = t
    "decimal"
              styleFor ListNumberStyle
    DefaultStyle t
    1 = t
    "lowerLetter"
              styleFor ListNumberStyle
    DefaultStyle t
    2 = t
    "lowerRoman"
              styleFor ListNumberStyle
    DefaultStyle t
    3 = t
    "decimal"
              styleFor ListNumberStyle
    DefaultStyle t
    4 = t
    "lowerLetter"
              styleFor ListNumberStyle
    DefaultStyle t
    5 = t
    "lowerRoman"
              styleFor ListNumberStyle
    DefaultStyle t
    x = ListNumberStyle -> t -> t
    styleFor ListNumberStyle
    DefaultStyle (t
    x t -> t -> t
    forall a. Integral a => a -> a -> a
    `mod` t
    6)
              styleFor ListNumberStyle
    _ t
    _            = t
    "decimal"
              patternFor :: ListNumberDelim -> a -> a
    patternFor ListNumberDelim
    OneParen a
    s  = a
    s a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    ")"
              patternFor ListNumberDelim
    TwoParens a
    s = a
    "(" a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    s a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    ")"
              patternFor ListNumberDelim
    _ a
    s         = a
    s a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "."

    -- | Build language transformer function for modifying XML elements.
    -- Navigates directly to w:docDefaults/w:rPr/w:lang instead of generic traversal.
    mkLangTransformer :: Maybe Lang -> (Element -> Element)
    mkLangTransformer :: Maybe Lang -> Element -> Element
    mkLangTransformer Maybe Lang
    Nothing  = Element -> Element
    forall a. a -> a
    id
    mkLangTransformer (Just Lang
    lang) = [QName -> Bool] -> (Element -> Element) -> Element -> Element
    modifyAtPath [QName -> Bool]
    path Element -> Element
    updateLangAttrs
      where
        -- Path is: w:docDefaults / w:rPrDefault / w:rPr / w:lang
        path :: [QName -> Bool]
    path = [Text -> QName -> Bool
    named Text
    "docDefaults", Text -> QName -> Bool
    named Text
    "rPrDefault", Text -> QName -> Bool
    named Text
    "rPr", Text -> QName -> Bool
    named Text
    "lang"]
        named :: Text -> QName -> Bool
    named Text
    n = (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    n) (Text -> Bool) -> (QName -> Text) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Text
    qName

        updateLangAttrs :: Element -> Element
    updateLangAttrs Element
    e
          | Lang -> Bool
    isEastAsianLang Lang
    lang = Element
    e{ elAttribs = map (setattr "eastAsia") $ elAttribs e }
          | Lang -> Bool
    isBidiLang Lang
    lang      = Element
    e{ elAttribs = map (setattr "bidi") $ elAttribs e }
          | Bool
    otherwise            = Element
    e{ elAttribs = map (setattr "val") $ elAttribs e }

        setattr :: Text -> Attr -> Attr
    setattr Text
    attrname (XML.Attr qn :: QName
    qn@(QName Text
    s Maybe Text
    _ Maybe Text
    _) Text
    _)
          | Text
    s Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    attrname  = QName -> Text -> Attr
    XML.Attr QName
    qn (Lang -> Text
    renderLang Lang
    lang)
        setattr Text
    _ Attr
    x        = Attr
    x

        isEastAsianLang :: Lang -> Bool
    isEastAsianLang Lang{ langLanguage :: Lang -> Text
    langLanguage = Text
    l } = Text
    l Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "zh" Bool -> Bool -> Bool
    || Text
    l Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "ja" Bool -> Bool -> Bool
    || Text
    l Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "ko"
        isBidiLang :: Lang -> Bool
    isBidiLang Lang{ langLanguage :: Lang -> Text
    langLanguage = Text
    l } = Text
    l Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "he" Bool -> Bool -> Bool
    || Text
    l Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "ar"

    -- | Modify an element at a specific path in the XML tree.
    -- The path is a list of predicates that match element names at each level.
    modifyAtPath :: [(QName -> Bool)] -> (Element -> Element) -> Element -> Element
    modifyAtPath :: [QName -> Bool] -> (Element -> Element) -> Element -> Element
    modifyAtPath [] Element -> Element
    f Element
    e = Element -> Element
    f Element
    e
    modifyAtPath (QName -> Bool
    p:[QName -> Bool]
    ps) Element -> Element
    f Element
    e = Element
    e{ elContent = map go (elContent e) }
      where
        go :: Content -> Content
    go (Elem Element
    el) | QName -> Bool
    p (Element -> QName
    elName Element
    el) = Element -> Content
    Elem ([QName -> Bool] -> (Element -> Element) -> Element -> Element
    modifyAtPath [QName -> Bool]
    ps Element -> Element
    f Element
    el)
        go Content
    c = Content
    c

    -- | Load reference and distribution archives
    loadArchives :: PandocMonad m
                 => WriterOptions
                 -> m (Archive, Archive, Maybe Text, UTCTime)
    loadArchives :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> m (Archive, Archive, Maybe Text, UTCTime)
    loadArchives WriterOptions
    opts = do
      username <- Text -> m (Maybe Text)
    forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
    P.lookupEnv Text
    "USERNAME"
      utctime <- P.getTimestamp
      oldUserDataDir <- P.getUserDataDir
      P.setUserDataDir Nothing
      res <- readDefaultDataFile "reference.docx"
      P.setUserDataDir oldUserDataDir
      let distArchive = ByteString -> Archive
    toArchive (ByteString -> Archive) -> ByteString -> Archive
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BL.fromStrict ByteString
    res
      refArchive <- case writerReferenceDoc opts of
                       Just String
    f  -> ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> ((ByteString, Maybe Text) -> ByteString)
    -> (ByteString, Maybe Text)
    -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> ByteString)
    -> ((ByteString, Maybe Text) -> ByteString)
    -> (ByteString, Maybe Text)
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString, Maybe Text) -> ByteString
    forall a b. (a, b) -> a
    fst
                                     ((ByteString, Maybe Text) -> Archive)
    -> m (ByteString, Maybe Text) -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (ByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (ByteString, Maybe Text)
    P.fetchItem (String -> Text
    T.pack String
    f)
                       Maybe String
    Nothing -> ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (ByteString -> ByteString) -> ByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> Archive) -> m ByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            String -> m ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    readDataFile String
    "reference.docx"
      return (refArchive, distArchive, username, utctime)

    -- | Extract page dimensions from template
    extractPageLayout :: PandocMonad m
                      => Archive -> Archive -> m (Maybe Element, Maybe Integer)
    extractPageLayout :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> m (Maybe Element, Maybe Integer)
    extractPageLayout Archive
    refArchive Archive
    distArchive = do
      parsedDoc <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    "word/document.xml"
      let wname Text -> Bool
    f QName
    qn = QName -> Maybe Text
    qPrefix QName
    qn Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "w" Bool -> Bool -> Bool
    && Text -> Bool
    f (QName -> Text
    qName QName
    qn)
      let mbsectpr = (QName -> Bool) -> Element -> Maybe Element
    filterElementName ((Text -> Bool) -> QName -> Bool
    wname (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Text
    "sectPr")) Element
    parsedDoc

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

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

      -- Get the available area (converting the size and the margins to int and
      -- doing the difference
      let pgContentWidth = do
                             w <- Maybe Text
    mbAttrSzWidth Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Integer
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead
                             r <- mbAttrMarRight >>= safeRead
                             l <- mbAttrMarLeft >>= safeRead
                             pure $ w - r - l

      return (mbsectpr, pgContentWidth)

    -- | Parse and augment relationships from reference.docx
    extractRelationships :: PandocMonad m
                         => Archive -> Archive
                         -> m ([Element], [Element], [Element], Int)
    extractRelationships :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> m ([Element], [Element], [Element], Int)
    extractRelationships Archive
    refArchive Archive
    distArchive = do
      let isImageNode :: Element -> Bool
    isImageNode Element
    e = QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"
      let isHeaderNode :: Element -> Bool
    isHeaderNode Element
    e = QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"
      let isFooterNode :: Element -> Bool
    isFooterNode Element
    e = QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer"
      parsedRels <- (Element -> Bool) -> Element -> [Element]
    filterElements
                      (\Element
    e -> Element -> Bool
    isImageNode Element
    e Bool -> Bool -> Bool
    || Element -> Bool
    isHeaderNode Element
    e Bool -> Bool -> Bool
    || Element -> Bool
    isFooterNode Element
    e)
                  (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
    "word/_rels/document.xml.rels"
      let getRelId Element
    e =
            case QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e of
              Just Text
    ident -> Text -> Text -> Maybe Text
    T.stripPrefix Text
    "rId" Text
    ident Maybe Text -> (Text -> Maybe b) -> Maybe b
    forall a b. Maybe a -> (a -> 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 Text
    Nothing -> Maybe b
    forall a. Maybe a
    Nothing
      let relIds = (Element -> Maybe Int) -> [Element] -> [Int]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe Int
    forall {b}. Read b => Element -> Maybe b
    getRelId [Element]
    parsedRels
      let maxRelId = if [Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Int]
    relIds then Int
    0 else [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    relIds

      let headers = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Element -> Bool
    isHeaderNode [Element]
    parsedRels
      let footers = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Element -> Bool
    isFooterNode [Element]
    parsedRels
      -- word/_rels/document.xml.rels
      let addBaseRel (Text
    url', Text
    target') (a
    maxId, [Element]
    rels) =
            case [Element
    e | Element
    e <- [Element]
    rels
                    , QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Target" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==
                       Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    target'] of
              [] -> (a
    maxId a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship"
                                [(Text
    "Type",Text
    url')
                                ,(Text
    "Id",Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    tshow (a
    maxId a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1))
                                ,(Text
    "Target",Text
    target')] () Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    rels)
              [Element]
    _ -> (a
    maxId, [Element]
    rels)

      let (newMaxRelId, baserels) = foldr addBaseRel (maxRelId, parsedRels)
                        [("http://schemas.openxmlformats.org/officeDocument/2006/relationships/numbering",
                          "numbering.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles",
                          "styles.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/settings",
                          "settings.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/webSettings",
                          "webSettings.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/fontTable",
                          "fontTable.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/theme",
                          "theme/theme1.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",
                          "footnotes.xml")
                        ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments",
                          "comments.xml")
                        ]

      return (baserels, headers, footers, newMaxRelId)

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

    -- | Create footnote relationships entry
    mkFootnoteRelsEntry :: Integer -> M.Map Text Text -> Entry
    mkFootnoteRelsEntry :: Integer -> Map Text Text -> Entry
    mkFootnoteRelsEntry Integer
    epochtime Map Text Text
    externalLinks =
      let linkrels :: [Element]
    linkrels = ((Text, Text) -> Element) -> [(Text, Text)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> Element
    toLinkRel ([(Text, Text)] -> [Element]) -> [(Text, Text)] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ Map Text Text -> [(Text, Text)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Text Text
    externalLinks
          toLinkRel :: (Text, Text) -> Element
    toLinkRel (Text
    src, Text
    ident) = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship"
            [(Text
    "Type",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
            ,(Text
    "Id",Text
    ident)
            ,(Text
    "Target",Text
    src)
            ,(Text
    "TargetMode",Text
    "External")] ()
      in String -> Integer -> ByteString -> Entry
    toEntry String
    "word/_rels/footnotes.xml.rels" Integer
    epochtime
           (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml (Element -> ByteString) -> Element -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationships"
               [(Text
    "xmlns",Text
    "http://schemas.openxmlformats.org/package/2006/relationships")]
               [Element]
    linkrels

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

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

    -- | Create content types manifest entry
    mkContentTypesEntry :: Integer
                        -> [(String, String, Maybe MimeType, B.ByteString)]  -- imgs
                        -> [Element]  -- headers
                        -> [Element]  -- footers
                        -> Archive    -- refArchive
                        -> Entry
    mkContentTypesEntry :: Integer
    -> [(String, String, Maybe Text, ByteString)]
    -> [Element]
    -> [Element]
    -> Archive
    -> Entry
    mkContentTypesEntry Integer
    epochtime [(String, String, Maybe Text, ByteString)]
    imgs [Element]
    headers [Element]
    footers Archive
    refArchive =
      let mkOverrideNode :: (String, Text) -> Element
    mkOverrideNode (String
    part', Text
    contentType') = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Override"
               [(Text
    "PartName", String -> Text
    T.pack String
    part')
               ,(Text
    "ContentType", Text
    contentType')] ()
          mkImageOverride :: (a, String, Maybe Text, d) -> Element
    mkImageOverride (a
    _, String
    imgpath, Maybe Text
    mbMimeType, d
    _) =
              (String, Text) -> Element
    mkOverrideNode (String
    "/word/" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    imgpath,
                              Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "application/octet-stream" Maybe Text
    mbMimeType)
          mkMediaOverride :: String -> Element
    mkMediaOverride String
    imgpath =
              (String, Text) -> Element
    mkOverrideNode (String
    "/" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    imgpath, String -> Text
    getMimeTypeDef String
    imgpath)
          unrelativize :: String -> String
    unrelativize (Char
    '/':String
    xs) = Char
    '/'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs
          unrelativize String
    xs = String
    "/word/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
          overrides :: [Element]
    overrides = ((String, Text) -> Element) -> [(String, Text)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Text) -> Element
    mkOverrideNode (
                      [(String
    "/word/webSettings.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")
                      ,(String
    "/word/numbering.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.numbering+xml")
                      ,(String
    "/word/settings.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.settings+xml")
                      ,(String
    "/word/theme/theme1.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.theme+xml")
                      ,(String
    "/word/fontTable.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.fontTable+xml")
                      ,(String
    "/docProps/app.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.extended-properties+xml")
                      ,(String
    "/docProps/core.xml",
                        Text
    "application/vnd.openxmlformats-package.core-properties+xml")
                      ,(String
    "/docProps/custom.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.custom-properties+xml")
                      ,(String
    "/word/styles.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml")
                      ,(String
    "/word/document.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")
                      ,(String
    "/word/comments.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml")
                      ,(String
    "/word/footnotes.xml",
                        Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")
                      ] [(String, Text)] -> [(String, Text)] -> [(String, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                      (Element -> (String, Text)) -> [Element] -> [(String, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Element
    x -> (String -> (Text -> String) -> Maybe Text -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (String -> String
    unrelativize (String -> String) -> (Text -> String) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) (Element -> Maybe Text
    extractTarget Element
    x),
                           Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) [Element]
    headers [(String, Text)] -> [(String, Text)] -> [(String, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                      (Element -> (String, Text)) -> [Element] -> [(String, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Element
    x -> (String -> (Text -> String) -> Maybe Text -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (String -> String
    unrelativize (String -> String) -> (Text -> String) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) (Element -> Maybe Text
    extractTarget Element
    x),
                           Text
    "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) [Element]
    footers) [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                        ((String, String, Maybe Text, ByteString) -> Element)
    -> [(String, String, Maybe Text, ByteString)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, Maybe Text, ByteString) -> Element
    forall {a} {d}. (a, String, Maybe Text, d) -> Element
    mkImageOverride [(String, String, Maybe Text, ByteString)]
    imgs [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++
                        [ String -> Element
    mkMediaOverride (Entry -> String
    eRelativePath Entry
    e)
                            | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                            , String
    "word/media/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e
                            , Bool -> Bool
    not (String
    "/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` Entry -> String
    eRelativePath Entry
    e) ]
          mkDefaultNode :: (Text, Text) -> Element
    mkDefaultNode (Text
    ext, Text
    mt) =
            Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Default" [(Text
    "Extension",Text
    ext),(Text
    "ContentType",Text
    mt)] ()
          defaultnodes :: [Element]
    defaultnodes = ((Text, Text) -> Element) -> [(Text, Text)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> Element
    mkDefaultNode
            [(Text
    "xml", Text
    "application/xml"),
             (Text
    "rels", Text
    "application/vnd.openxmlformats-package.relationships+xml"),
             (Text
    "odttf",
               Text
    "application/vnd.openxmlformats-officedocument.obfuscatedFont")]
          contentTypesDoc :: Element
    contentTypesDoc = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Types"
            [(Text
    "xmlns",Text
    "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
      in String -> Integer -> ByteString -> Entry
    toEntry String
    "[Content_Types].xml" Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    contentTypesDoc

    -- | Create document relationships entry
    mkDocumentRelsEntry :: Integer
                        -> [Element]  -- baserels
                        -> [(String, String, Maybe MimeType, B.ByteString)]  -- imgs
                        -> M.Map Text Text  -- externalLinks
                        -> Entry
    mkDocumentRelsEntry :: Integer
    -> [Element]
    -> [(String, String, Maybe Text, ByteString)]
    -> Map Text Text
    -> Entry
    mkDocumentRelsEntry Integer
    epochtime [Element]
    baserels [(String, String, Maybe Text, ByteString)]
    imgs Map Text Text
    externalLinks =
      let toImgRel :: (String, String, c, d) -> Element
    toImgRel (String
    ident, String
    path, c
    _, d
    _) = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship"
            [(Text
    "Type",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
            ,(Text
    "Id",String -> Text
    T.pack String
    ident)
            ,(Text
    "Target",String -> Text
    T.pack String
    path)] ()
          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
          toLinkRel :: (Text, Text) -> Element
    toLinkRel (Text
    src, Text
    ident) = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship"
            [(Text
    "Type",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
            ,(Text
    "Id",Text
    ident)
            ,(Text
    "Target",Text
    src)
            ,(Text
    "TargetMode",Text
    "External")] ()
          linkrels :: [Element]
    linkrels = ((Text, Text) -> Element) -> [(Text, Text)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> Element
    toLinkRel ([(Text, Text)] -> [Element]) -> [(Text, Text)] -> [Element]
    forall a b. (a -> b) -> a -> b
    $ Map Text Text -> [(Text, Text)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Text Text
    externalLinks
          reldoc :: Element
    reldoc = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationships"
            [(Text
    "xmlns",Text
    "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
      in String -> Integer -> ByteString -> Entry
    toEntry String
    "word/_rels/document.xml.rels" Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    reldoc

    -- | Create styles entry with dynamic additions
    mkStylesEntry :: Integer -> Element -> StyleMaps -> WriterState -> WriterOptions -> Entry
    mkStylesEntry :: Integer
    -> Element -> StyleMaps -> WriterState -> WriterOptions -> Entry
    mkStylesEntry Integer
    epochtime Element
    styledoc StyleMaps
    styleMaps WriterState
    st WriterOptions
    opts =
      let stylepath :: String
    stylepath = String
    "word/styles.xml"
          -- 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.
          newDynamicParaProps :: [ParaStyleName]
    newDynamicParaProps = (ParaStyleName -> Bool) -> [ParaStyleName] -> [ParaStyleName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
            (\ParaStyleName
    sty -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ParaStyleName -> Map ParaStyleName ParStyle -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName ParaStyleName
    sty (Map ParaStyleName ParStyle -> Bool)
    -> Map ParaStyleName ParStyle -> Bool
    forall a b. (a -> b) -> a -> b
    $ StyleMaps -> Map ParaStyleName ParStyle
    smParaStyle StyleMaps
    styleMaps)
            (Set ParaStyleName -> [ParaStyleName]
    forall a. Set a -> [a]
    Set.toList (Set ParaStyleName -> [ParaStyleName])
    -> Set ParaStyleName -> [ParaStyleName]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Set ParaStyleName
    stDynamicParaProps WriterState
    st)

          newDynamicTextProps :: [CharStyleName]
    newDynamicTextProps = (CharStyleName -> Bool) -> [CharStyleName] -> [CharStyleName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
            (\CharStyleName
    sty -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ CharStyleName -> Map CharStyleName CharStyle -> Bool
    forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
    hasStyleName CharStyleName
    sty (Map CharStyleName CharStyle -> Bool)
    -> Map CharStyleName CharStyle -> Bool
    forall a b. (a -> b) -> a -> b
    $ StyleMaps -> Map CharStyleName CharStyle
    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)

          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 -> HighlightMethod
    writerHighlightMethod WriterOptions
    opts of
                         Skylighting Style
    sty -> StyleMaps -> Style -> [Element]
    styleToOpenXml StyleMaps
    styleMaps Style
    sty
                         HighlightMethod
    DefaultHighlighting -> StyleMaps -> Style -> [Element]
    styleToOpenXml StyleMaps
    styleMaps
                                                  Style
    defaultStyle
                         HighlightMethod
    _ -> [])
          styledoc' :: Element
    styledoc' = Element
    styledoc{ elContent = elContent styledoc ++
                                               map Elem newstyles }
      in 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'

    -- | Create core document properties entry
    mkCorePropsEntry :: Integer -> UTCTime -> Meta -> Entry
    mkCorePropsEntry :: Integer -> UTCTime -> Meta -> Entry
    mkCorePropsEntry Integer
    epochtime UTCTime
    utctime Meta
    meta =
      let metaValueToText :: MetaValue -> Text
    metaValueToText (MetaString Text
    s)    = Text
    s
          metaValueToText (MetaInlines [Inline]
    ils) = [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    ils
          metaValueToText (MetaBlocks [Block]
    bs)   = [Block] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Block]
    bs
          metaValueToText (MetaBool Bool
    b)      = String -> Text
    T.pack (Bool -> String
    forall a. Show a => a -> String
    show Bool
    b)
          metaValueToText MetaValue
    _                 = Text
    ""
          keywords :: [Text]
    keywords = case Text -> Meta -> Maybe MetaValue
    lookupMeta Text
    "keywords" Meta
    meta of
                           Just (MetaList [MetaValue]
    xs) -> (MetaValue -> Text) -> [MetaValue] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map MetaValue -> Text
    metaValueToText [MetaValue]
    xs
                           Maybe MetaValue
    _                  -> []
          docPropsPath :: String
    docPropsPath = String
    "docProps/core.xml"
          extraCoreProps :: [Text]
    extraCoreProps = [Text
    "subject",Text
    "lang",Text
    "category",Text
    "description"]
          extraCorePropsMap :: Map Text Text
    extraCorePropsMap = [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, Text)] -> Map Text Text)
    -> [(Text, Text)] -> Map Text Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text] -> [(Text, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    extraCoreProps
                           [Text
    "dc:subject",Text
    "dc:language",Text
    "cp:category",Text
    "dc:description"]
          lookupMetaString' :: Text -> Meta -> Text
          lookupMetaString' :: Text -> Meta -> Text
    lookupMetaString' Text
    key' Meta
    meta' =
            case Text
    key' of
                 Text
    "description" -> Text -> [Text] -> Text
    T.intercalate Text
    "_x000d_\n"
                                    ((Block -> Text) -> [Block] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Block -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([Block] -> [Text]) -> [Block] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Meta -> [Block]
    lookupMetaBlocks Text
    "description" Meta
    meta')
                 Text
    key''         -> Text -> Meta -> Text
    lookupMetaString Text
    key'' Meta
    meta'

          docProps :: Element
    docProps = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "cp:coreProperties"
              [(Text
    "xmlns:cp",Text
    "http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
              ,(Text
    "xmlns:dc",Text
    "http://purl.org/dc/elements/1.1/")
              ,(Text
    "xmlns:dcterms",Text
    "http://purl.org/dc/terms/")
              ,(Text
    "xmlns:dcmitype",Text
    "http://purl.org/dc/dcmitype/")
              ,(Text
    "xmlns:xsi",Text
    "http://www.w3.org/2001/XMLSchema-instance")]
              ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Text -> Element
    mktnode Text
    "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]
    : Text -> [(Text, Text)] -> Text -> Element
    mktnode Text
    "dc:creator" [] (Text -> [Text] -> Text
    T.intercalate Text
    "; " (([Inline] -> Text) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Meta -> [[Inline]]
    docAuthors Meta
    meta))
              Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [ Text -> [(Text, Text)] -> Text -> Element
    mktnode (Text -> Text -> Map Text Text -> Text
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault Text
    "" Text
    k Map Text Text
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    extraCoreProps]
              [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "cp:keywords" [] (Text -> [Text] -> Text
    T.intercalate Text
    ", " [Text]
    keywords)
              Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : (\Text
    x -> [ Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "dcterms:created" [(Text
    "xsi:type",Text
    "dcterms:W3CDTF")] Text
    x
                       , Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "dcterms:modified" [(Text
    "xsi:type",Text
    "dcterms:W3CDTF")] Text
    x
                       ]) (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%FT%XZ" UTCTime
    utctime)
      in 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

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

    -- | Create numbering entry
    mkNumberingEntry :: PandocMonad m
                     => Archive -> Archive -> Integer -> [ListMarker] -> m Entry
    mkNumberingEntry :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> Integer -> [ListMarker] -> m Entry
    mkNumberingEntry Archive
    refArchive Archive
    distArchive Integer
    epochtime [ListMarker]
    lists = do
      let numpath :: String
    numpath = String
    "word/numbering.xml"
      numbering <- Archive -> Archive -> String -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> String -> m Element
    parseXml Archive
    refArchive Archive
    distArchive String
    numpath
      let newNumElts = [ListMarker] -> [Element]
    mkNumbering [ListMarker]
    lists
      let pandocAdded Element
    e =
           case (QName -> Bool) -> Element -> Maybe Text
    findAttrBy ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "abstractNumId") (Text -> Bool) -> (QName -> Text) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Text
    qName) Element
    e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead of
             Just Int
    numid -> Int
    numid Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (Int
    990 :: Int)
             Maybe Int
    Nothing    ->
               case (QName -> Bool) -> Element -> Maybe Text
    findAttrBy ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "numId") (Text -> Bool) -> (QName -> Text) -> QName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Text
    qName) Element
    e Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead of
                 Just Int
    numid -> Int
    numid Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (Int
    1000 :: Int)
                 Maybe Int
    Nothing    -> Bool
    False
      let oldElts = (Element -> 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]
    oldElts [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    newNumElts
      return $ toEntry numpath epochtime $ renderXml numbering{ elContent =
                           -- we want all the abstractNums first, then the nums,
                           -- otherwise things break:
                           [Elem e | e <- allElts
                                   , qName (elName e) == "abstractNum" ] ++
                           [Elem e | e <- allElts
                                   , qName (elName e) == "num" ] }

    -- | Collect auxiliary entries from reference archive
    collectReferenceEntries :: PandocMonad m
                            => Archive -> Archive -> [Element] -> [Element]
                            -> m [Entry]
    collectReferenceEntries :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> [Element] -> [Element] -> m [Entry]
    collectReferenceEntries Archive
    refArchive Archive
    distArchive [Element]
    headers [Element]
    footers = do
      let entryFromArchive :: Archive -> String -> m Entry
    entryFromArchive Archive
    arch String
    path =
             m Entry -> (Entry -> m Entry) -> Maybe Entry -> m Entry
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (PandocError -> m Entry
    forall a. PandocError -> m a
    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 -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " missing in reference docx")
                   Entry -> m Entry
    forall a. a -> m a
    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 a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` String -> Archive -> Maybe Entry
    findEntryByPath String
    path Archive
    distArchive)
      docPropsAppEntry <- Archive -> String -> m Entry
    forall {m :: * -> *}.
    MonadError PandocError m =>
    Archive -> String -> m Entry
    entryFromArchive Archive
    refArchive String
    "docProps/app.xml"
      themeEntry <- entryFromArchive refArchive "word/theme/theme1.xml"
      fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml"
      let fontTableRelsEntries = Maybe Entry -> [Entry]
    forall a. Maybe a -> [a]
    maybeToList (Maybe Entry -> [Entry]) -> Maybe Entry -> [Entry]
    forall a b. (a -> b) -> a -> b
    $
           String -> Archive -> Maybe Entry
    findEntryByPath String
    "word/_rels/fontTable.xml.rels" Archive
    refArchive
      let fontEntries = [Entry
    entry | Entry
    entry <- Archive -> [Entry]
    zEntries Archive
    refArchive
                               , String
    "word/fonts/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Entry -> String
    eRelativePath Entry
    entry)]
      webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"
      let unrelativize (Char
    '/':String
    xs) = String
    xs
          unrelativize String
    xs = String
    "word/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
      headerFooterEntries <- mapM (entryFromArchive refArchive . unrelativize) $
                             mapMaybe (fmap T.unpack . extractTarget)
                             (headers ++ footers)
      let miscRelEntries = [ Entry
    e | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                           , String
    "word/_rels/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e
                           , String
    ".xml.rels" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` Entry -> String
    eRelativePath Entry
    e
                           , Entry -> String
    eRelativePath Entry
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "word/_rels/document.xml.rels"
                           , Entry -> String
    eRelativePath Entry
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "word/_rels/footnotes.xml.rels" ]
      let otherMediaEntries = [ Entry
    e | Entry
    e <- Archive -> [Entry]
    zEntries Archive
    refArchive
                              , String
    "word/media/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` Entry -> String
    eRelativePath Entry
    e ]
      return $ docPropsAppEntry : themeEntry : fontTableEntry : webSettingsEntry
             : fontTableRelsEntries ++ fontEntries ++ headerFooterEntries
             ++ miscRelEntries ++ otherMediaEntries

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