    {-# LANGUAGE PatternGuards       #-}
    {-# LANGUAGE RankNTypes          #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns        #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {- |
       Module      : Text.Pandoc.Writers.Docx
       Copyright   : Copyright (C) 2012-2024 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.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.MIME (getMimeTypeDef)
    import Text.Pandoc.Options
    import Text.Pandoc.Readers.Docx.Parse (extractTarget)
    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 Data.Generics (mkT, everywhere)
    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
      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'

      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"

      parsedDoc <- parseXml refArchive distArchive "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

      -- styles
      mblang <- toLang $ getLang opts meta
      -- TODO FIXME avoid this generic traversal!
      -- lang is in w:docDefaults /  w:rPr  /  w:lang
      let addLang :: Element -> Element
          addLang = case Maybe Lang
    mblang of
                      Maybe Lang
    Nothing -> Element -> Element
    forall a. a -> a
    id
                      Just Lang
    l  -> (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere ((Element -> Element) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT (Lang -> Element -> Element
    go Lang
    l))
            where
              go :: Lang -> Element -> Element
              go :: Lang -> Element -> Element
    go Lang
    lang Element
    e'
               | QName -> Text
    qName (Element -> QName
    elName Element
    e') Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "lang"
                 = if Lang -> Bool
    isEastAsianLang Lang
    lang
                      then Element
    e'{ elAttribs =
                                 map (setattr "eastAsia" (renderLang lang)) $
                                 elAttribs e' }
                      else
                        if Lang -> Bool
    isBidiLang Lang
    lang
                           then Element
    e'{ elAttribs =
                                     map (setattr "bidi" (renderLang lang)) $
                                     elAttribs e' }
                           else Element
    e'{ elAttribs =
                                     map (setattr "val" (renderLang lang)) $
                                     elAttribs e' }
               | Bool
    otherwise = Element
    e'

              setattr :: Text -> Text -> Attr -> Attr
    setattr Text
    attrname Text
    l (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 Text
    l
              setattr Text
    _ Text
    _ Attr
    x      = Attr
    x

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

      let stylepath = String
    "word/styles.xml"
      styledoc <- addLang <$> parseXml refArchive distArchive stylepath

      -- parse styledoc for heading styles
      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
            }

      let 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
    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
    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 <- filterElements
                      (\Element
    e -> Element -> Bool
    isImageNode Element
    e Bool -> Bool -> Bool
    || Element -> Bool
    isHeaderNode Element
    e Bool -> Bool -> Bool
    || Element -> Bool
    isFooterNode Element
    e)
                  <$> parseXml refArchive distArchive "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")
                        ]

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

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

      -- create entries for images in word/media/...
      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

      let 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")]

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

      -- [Content_Types].xml
      let mkOverrideNode (String
    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')] ()
      let 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)
      let 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)
      let 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
    "" (Text -> String
    T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    "/word/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)) (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
    "" (Text -> String
    T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    "/word/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>)) (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 ]

      let 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)] ()
      let 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")]
      let 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
      let contentTypesEntry = 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

      let 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)] ()
      let imgrels = ((String, String, Maybe Text, ByteString) -> Element)
    -> [(String, String, Maybe Text, ByteString)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String, Maybe Text, ByteString) -> Element
    forall {c} {d}. (String, String, c, d) -> Element
    toImgRel [(String, String, Maybe Text, ByteString)]
    imgs
      let toLinkRel (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") ] ()
      let 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 -> [(Text, Text)])
    -> Map Text Text -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ WriterState -> Map Text Text
    stExternalLinks WriterState
    st
      let 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
      let relEntry = 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

      let contents' = ByteString -> ByteString
    BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    UTF8.fromText Text
    contents

      -- word/document.xml
      let contentEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "word/document.xml" Integer
    epochtime ByteString
    contents'

      -- footnotes
      let notes = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:footnotes" [(Text, Text)]
    stdAttributes [Element]
    footnotes
      let footnotesEntry = 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

      -- footnote rels
      let footnoteRelEntry = 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

      -- comments
      let commentsEntry = 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

      -- styles

      -- We only want to inject paragraph and text properties that
      -- are not already in the style map. Note that keys in the stylemap
      -- are normalized as lowercase.
      let newDynamicParaProps = (ParaStyleName -> 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 -> 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)

      let 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]
    ++
                      [Element] -> (Style -> [Element]) -> Maybe Style -> [Element]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (StyleMaps -> Style -> [Element]
    styleToOpenXml StyleMaps
    styleMaps) (WriterOptions -> Maybe Style
    writerHighlightStyle WriterOptions
    opts)
      let styledoc' = Element
    styledoc{ elContent = elContent styledoc ++
                                               map Elem newstyles }
      let styleEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    stylepath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    styledoc'

      -- construct word/numbering.xml
      let numpath = String
    "word/numbering.xml"
      numbering <- parseXml refArchive distArchive numpath
      let newNumElts = [ListMarker] -> [Element]
    mkNumbering (WriterState -> [ListMarker]
    stLists WriterState
    st)
      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
      let numEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    numpath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    numbering{ elContent =
                           -- 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" ] }

      let 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
    forall a. Walkable Inline a => a -> Text
    stringify [MetaValue]
    xs
                           Maybe MetaValue
    _                  -> []

      -- docProps/core.xml
      let docPropsPath = String
    "docProps/core.xml"
      let extraCoreProps = [Text
    "subject",Text
    "lang",Text
    "category",Text
    "description"]
      let 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"]
      let 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'

      let 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)
      let docPropsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    docPropsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    docProps

      -- docProps/custom.xml
      let customProperties :: [(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)]
      let 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
      let customPropsPath = String
    "docProps/custom.xml"
      let 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)..]
      let customPropsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    customPropsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    customProps

      let relsPath = String
    "_rels/.rels"
      let 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")]
            ]
      let relsEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    relsPath Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Element -> ByteString
    renderXml Element
    rels

      -- we use dist archive for settings.xml, because Word sometimes
      -- adds references to footnotes or endnotes we don't have...
      -- we do, however, copy some settings over from reference
      let settingsPath = String
    "word/settings.xml"

      settingsEntry <- copyChildren refArchive distArchive settingsPath epochtime
                          -- note: these must go in the following order:
                         [ "writeProtection"
                         , "view"
                         , "zoom"
                         , "removePersonalInformation"
                         , "removeDateAndTime"
                         , "doNotDisplayPageBoundaries"
                         , "displayBackgroundShape"
                         , "printPostScriptOverText"
                         , "printFractionalCharacterWidth"
                         , "printFormsData"
                         , "embedTrueTypeFonts"
                         , "embedSystemFonts"
                         , "saveSubsetFonts"
                         , "saveFormsData"
                         , "mirrorMargins"
                         , "alignBordersAndEdges"
                         , "bordersDoNotSurroundHeader"
                         , "bordersDoNotSurroundFooter"
                         , "gutterAtTop"
                         , "hideSpellingErrors"
                         , "hideGrammaticalErrors"
                         , "activeWritingStyle"
                         , "proofState"
                         , "formsDesign"
                         , "attachedTemplate"
                         , "linkStyles"
                         , "stylePaneFormatFilter"
                         , "stylePaneSortMethod"
                         , "documentType"
                         , "mailMerge"
                         , "revisionView"
                         , "trackRevisions"
                         , "doNotTrackMoves"
                         , "doNotTrackFormatting"
                         , "documentProtection"
                         , "autoFormatOverride"
                         , "styleLockTheme"
                         , "styleLockQFSet"
                         , "defaultTabStop"
                         , "autoHyphenation"
                         , "consecutiveHyphenLimit"
                         , "hyphenationZone"
                         , "doNotHyphenateCaps"
                         , "showEnvelope"
                         , "summaryLength"
                         , "clickAndTypeStyle"
                         , "defaultTableStyle"
                         , "evenAndOddHeaders"
                         , "bookFoldRevPrinting"
                         , "bookFoldPrinting"
                         , "bookFoldPrintingSheets"
                         , "drawingGridHorizontalSpacing"
                         , "drawingGridVerticalSpacing"
                         , "displayHorizontalDrawingGridEvery"
                         , "displayVerticalDrawingGridEvery"
                         , "doNotUseMarginsForDrawingGridOrigin"
                         , "drawingGridHorizontalOrigin"
                         , "drawingGridVerticalOrigin"
                         , "doNotShadeFormData"
                         , "noPunctuationKerning"
                         , "characterSpacingControl"
                         , "printTwoOnOne"
                         , "strictFirstAndLastChars"
                         , "noLineBreaksAfter"
                         , "noLineBreaksBefore"
                         , "savePreviewPicture"
                         , "doNotValidateAgainstSchema"
                         , "saveInvalidXml"
                         , "ignoreMixedContent"
                         , "alwaysShowPlaceholderText"
                         , "doNotDemarcateInvalidXml"
                         , "saveXmlDataOnly"
                         , "useXSLTWhenSaving"
                         , "saveThroughXslt"
                         , "showXMLTags"
                         , "alwaysMergeEmptyNamespace"
                         , "updateFields"
                         , "hdrShapeDefaults"
                         -- , "footnotePr" -- this can cause problems, see #9522
                         -- , "endnotePr"
                         , "compat"
                         , "docVars"
                         , "rsids"
                         , "attachedSchema"
                         , "themeFontLang"
                         , "clrSchemeMapping"
                         , "doNotIncludeSubdocsInStats"
                         , "doNotAutoCompressPictures"
                         , "forceUpgrade"
                         , "captions"
                         , "readModeInkLockDown"
                         , "smartTagType"
                         , "shapeDefaults"
                         , "doNotEmbedSmartTags"
                         , "decimalSymbol"
                         , "listSeparator" ]

      let 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 <- entryFromArchive refArchive "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)]
                            -- or parse fontTable.xml.rels?
      webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"
      headerFooterEntries <- mapM (entryFromArchive refArchive . ("word/" ++)) $
                             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 ]

      -- Create archive
      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
    docPropsAppEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    customPropsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    themeEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    settingsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : Entry
    webSettingsEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      Entry
    fontTableEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    :
                      [Entry]
    fontTableRelsEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    fontEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++
                      [Entry]
    imageEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    headerFooterEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++
                      [Entry]
    miscRelEntries [Entry] -> [Entry] -> [Entry]
    forall a. [a] -> [a] -> [a]
    ++ [Entry]
    otherMediaEntries
      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

    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
    "."