    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {- |
       Module      : Text.Pandoc.Writers.ODT
       Copyright   : Copyright (C) 2008-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 ODT.
    -}
    module Text.Pandoc.Writers.ODT ( writeODT ) where
    import Codec.Archive.Zip
    import Control.Monad.Except (catchError, throwError)
    import Control.Monad.State.Strict (StateT, evalStateT, gets, modify, lift)
    import Control.Monad (MonadPlus(mplus))
    import qualified Data.ByteString.Lazy as B
    import Data.Maybe (fromMaybe)
    import Data.Generics (everywhere', mkT)
    import Data.List (isPrefixOf)
    import qualified Data.Map as Map
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Data.Time
    import System.FilePath (takeDirectory, takeExtension, (<.>), (</>), isAbsolute)
    import Text.Collate.Lang (Lang (..), renderLang)
    import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
    import qualified Text.Pandoc.Class.PandocMonad as P
    import Text.Pandoc.Data (readDataFile)
    import Text.Pandoc.Definition
    import Text.Pandoc.Error (PandocError(..))
    import Text.Pandoc.ImageSize
    import Text.Pandoc.Logging
    import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
    import Text.Pandoc.Options (WrapOption (..), WriterOptions (..),
                                HighlightMethod(Skylighting))
    import Text.DocLayout
    import Text.Pandoc.Shared (stringify, tshow)
    import Text.Pandoc.Version (pandocVersionText)
    import Text.Pandoc.Writers.Shared (lookupMetaString, lookupMetaBlocks,
                                       fixDisplayMath, getLang,
                                       ensureValidXmlIdentifiers)
    import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toTextLazy)
    import Text.Pandoc.Walk
    import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
    import Text.Pandoc.XML
    import Text.Pandoc.XML.Light
    import Text.TeXMath
    import qualified Text.XML.Light as XL
    import Network.URI (parseRelativeReference, URI(uriPath), isURI)
    import Skylighting

    newtype ODTState = ODTState { ODTState -> [Entry]
    stEntries :: [Entry]
                             }

    type O m = StateT ODTState m

    -- | Produce an ODT file from a Pandoc document.
    writeODT :: PandocMonad m
             => WriterOptions  -- ^ Writer options
             -> Pandoc         -- ^ Document to convert
             -> m B.ByteString
    writeODT :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m ByteString
    writeODT  WriterOptions
    opts Pandoc
    doc =
      let initState :: ODTState
    initState = ODTState{ stEntries :: [Entry]
    stEntries = []
                              }
          doc' :: Pandoc
    doc' = Pandoc -> Pandoc
    fixInternalLinks (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pandoc -> Pandoc
    ensureValidXmlIdentifiers (Pandoc -> Pandoc) -> Pandoc -> Pandoc
    forall a b. (a -> b) -> a -> b
    $ Pandoc
    doc
      in
        StateT ODTState m ByteString -> ODTState -> m ByteString
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (WriterOptions -> Pandoc -> StateT ODTState m ByteString
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> O m ByteString
    pandocToODT WriterOptions
    opts Pandoc
    doc') ODTState
    initState

    -- | ODT internal links are evaluated relative to an imaginary folder
    -- structure that mirrors the zip structure.  The result is that relative
    -- links in the document need to start with `..`.  See #3524.
    fixInternalLinks :: Pandoc -> Pandoc
    fixInternalLinks :: Pandoc -> Pandoc
    fixInternalLinks = (Inline -> Inline) -> Pandoc -> Pandoc
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Inline -> Inline
    go
     where
      go :: Inline -> Inline
    go (Link Attr
    attr [Inline]
    ils (Text
    src,Text
    tit)) =
        Attr -> [Inline] -> (Text, Text) -> Inline
    Link Attr
    attr [Inline]
    ils (Text -> Text
    fixRel Text
    src,Text
    tit)
      go Inline
    x = Inline
    x
      fixRel :: Text -> Text
    fixRel Text
    uri =
        case String -> Maybe URI
    parseRelativeReference (Text -> String
    T.unpack Text
    uri) of
          Just URI
    u
            | Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (URI -> String
    uriPath URI
    u)) -> URI -> Text
    forall a. Show a => a -> Text
    tshow (URI -> Text) -> URI -> Text
    forall a b. (a -> b) -> a -> b
    $ URI
    u{ uriPath = "../" <> uriPath u }
          Maybe URI
    _ -> Text
    uri

    -- | Produce an ODT file from a Pandoc document.
    pandocToODT :: PandocMonad m
                => WriterOptions  -- ^ Writer options
                -> Pandoc         -- ^ Document to convert
                -> O m B.ByteString
    pandocToODT :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> O m ByteString
    pandocToODT WriterOptions
    opts doc :: Pandoc
    doc@(Pandoc Meta
    meta [Block]
    _) = do
      let title :: [Inline]
    title = Meta -> [Inline]
    docTitle Meta
    meta
      let authors :: [[Inline]]
    authors = Meta -> [[Inline]]
    docAuthors Meta
    meta
      utctime <- StateT ODTState m UTCTime
    forall (m :: * -> *). PandocMonad m => m UTCTime
    P.getTimestamp
      lang <- toLang (getLang opts meta)
      refArchive <-
           case writerReferenceDoc opts of
                 Just String
    f -> m Archive -> StateT ODTState m Archive
    forall (m :: * -> *) a. Monad m => m a -> StateT ODTState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m Archive -> StateT ODTState m Archive)
    -> m Archive -> StateT ODTState m Archive
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> ((StrictByteString, Maybe Text) -> ByteString)
    -> (StrictByteString, Maybe Text)
    -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> ByteString
    B.fromStrict (StrictByteString -> ByteString)
    -> ((StrictByteString, Maybe Text) -> StrictByteString)
    -> (StrictByteString, Maybe Text)
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StrictByteString, Maybe Text) -> StrictByteString
    forall a b. (a, b) -> a
    fst ((StrictByteString, Maybe Text) -> Archive)
    -> m (StrictByteString, Maybe Text) -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                    (Text -> m (StrictByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (StrictByteString, Maybe Text)
    P.fetchItem (String -> Text
    T.pack String
    f))
                 Maybe String
    Nothing -> m Archive -> StateT ODTState m Archive
    forall (m :: * -> *) a. Monad m => m a -> StateT ODTState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m Archive -> StateT ODTState m Archive)
    -> m Archive -> StateT ODTState m Archive
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (StrictByteString -> ByteString) -> StrictByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> ByteString
    B.fromStrict (StrictByteString -> Archive) -> m StrictByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                    String -> m StrictByteString
    forall (m :: * -> *). PandocMonad m => String -> m StrictByteString
    readDataFile String
    "reference.odt"
      -- handle formulas and pictures
      -- picEntriesRef <- P.newIORef ([] :: [Entry])
      doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc
      newContents <- lift $ writeOpenDocument opts{writerWrapText = WrapNone} doc'
      epochtime <- floor `fmap` lift P.getPOSIXTime
      let contentEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "content.xml" Integer
    epochtime
                         (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    fromTextLazy (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    TL.fromStrict Text
    newContents
      picEntries <- gets stEntries
      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
    refArchive
                    ([Entry] -> Archive) -> [Entry] -> Archive
    forall a b. (a -> b) -> a -> b
    $ Entry
    contentEntry Entry -> [Entry] -> [Entry]
    forall a. a -> [a] -> [a]
    : [Entry]
    picEntries
      -- construct META-INF/manifest.xml based on archive
      let toFileEntry String
    fp = case String -> Maybe Text
    getMimeType String
    fp of
                            Maybe Text
    Nothing  -> Doc a
    forall a. Doc a
    empty
                            Just Text
    m   -> Text -> [(Text, Text)] -> Doc a
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "manifest:file-entry"
                                         [(Text
    "manifest:media-type", Text
    m)
                                         ,(Text
    "manifest:full-path", String -> Text
    T.pack String
    fp)
                                         ]
      let files = [ String
    ent | String
    ent <- Archive -> [String]
    filesInArchive Archive
    archive,
                                 Bool -> Bool
    not (String
    "META-INF" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    ent) ]
      let formulas = [ String -> String
    takeDirectory String
    ent String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" | String
    ent <- Archive -> [String]
    filesInArchive Archive
    archive,
                          String
    "Formula-" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    ent, String -> String
    takeExtension String
    ent String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ".xml" ]
      let manifestEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "META-INF/manifest.xml" Integer
    epochtime
            (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    fromStringLazy (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Doc String -> String
    forall a. HasChars a => Maybe Int -> Doc a -> a
    render Maybe Int
    forall a. Maybe a
    Nothing
            (Doc String -> String) -> Doc String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc String
    forall a. HasChars a => String -> Doc a
    text String
    "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
            Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
             Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "manifest:manifest"
                [(Text
    "xmlns:manifest",Text
    "urn:oasis:names:tc:opendocument:xmlns:manifest:1.0")
                ,(Text
    "manifest:version",Text
    "1.3")] ( Text -> [(Text, Text)] -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "manifest:file-entry"
                     [(Text
    "manifest:media-type",Text
    "application/vnd.oasis.opendocument.text")
                     ,(Text
    "manifest:full-path",Text
    "/")
                     ,(Text
    "manifest:version", Text
    "1.3")]
                    Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$ [Doc String] -> Doc String
    forall a. [Doc a] -> Doc a
    vcat ( (String -> Doc String) -> [String] -> [Doc String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Doc String
    forall a. HasChars a => String -> Doc a
    toFileEntry [String]
    files )
                    Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$ [Doc String] -> Doc String
    forall a. [Doc a] -> Doc a
    vcat ( (String -> Doc String) -> [String] -> [Doc String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Doc String
    forall a. HasChars a => String -> Doc a
    toFileEntry [String]
    formulas )
                  )
      let archive' = Entry -> Archive -> Archive
    addEntryToArchive Entry
    manifestEntry Archive
    archive
      -- create meta.xml
      let userDefinedMetaFields = [Text
    k | Text
    k <- Map Text MetaValue -> [Text]
    forall k a. Map k a -> [k]
    Map.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
    "lang", Text
    "author"
                                               , Text
    "description", Text
    "subject", Text
    "keywords"]]
      let escapedText = String -> Doc String
    forall a. HasChars a => String -> Doc a
    text (String -> Doc String) -> (Text -> String) -> Text -> Doc String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    escapeStringForXML
      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
    _                  -> []
      let userDefinedMeta =
            (Text -> Doc String) -> [Text] -> [Doc String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Text
    k -> Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    "meta:user-defined"
                  [ (Text
    "meta:name", Text -> Text
    escapeStringForXML Text
    k)
                  ,(Text
    "meta:value-type", Text
    "string")
                  ] (Text -> Doc String
    escapedText (Text -> Doc String) -> Text -> Doc String
    forall a b. (a -> b) -> a -> b
    $ Text -> Meta -> Text
    lookupMetaString Text
    k Meta
    meta)) [Text]
    userDefinedMetaFields
      let metaTag Text
    metafield = Text -> Doc String -> Doc String
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    metafield (Doc String -> Doc String)
    -> (Text -> Doc String) -> Text -> Doc String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Doc String
    escapedText
      let metaEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "meta.xml" Integer
    epochtime
           (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    fromStringLazy (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Doc String -> String
    forall a. HasChars a => Maybe Int -> Doc a -> a
    render Maybe Int
    forall a. Maybe a
    Nothing
           (Doc String -> String) -> Doc String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc String
    forall a. HasChars a => String -> Doc a
    text String
    "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
           Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
            Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "office:document-meta"
               [(Text
    "xmlns:office",Text
    "urn:oasis:names:tc:opendocument:xmlns:office:1.0")
               ,(Text
    "xmlns:xlink",Text
    "http://www.w3.org/1999/xlink")
               ,(Text
    "xmlns:dc",Text
    "http://purl.org/dc/elements/1.1/")
               ,(Text
    "xmlns:meta",Text
    "urn:oasis:names:tc:opendocument:xmlns:meta:1.0")
               ,(Text
    "xmlns:ooo",Text
    "http://openoffice.org/2004/office")
               ,(Text
    "xmlns:grddl",Text
    "http://www.w3.org/2003/g/data-view#")
               ,(Text
    "office:version",Text
    "1.3")] ( Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "office:meta" []
                     ( Text -> Text -> Doc String
    metaTag Text
    "meta:generator" (Text
    "Pandoc/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    pandocVersionText)
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       Text -> Text -> Doc String
    metaTag Text
    "dc:title" ([Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    title)
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       Text -> Text -> Doc String
    metaTag Text
    "dc:description"
                              (Text -> [Text] -> Text
    T.intercalate Text
    "\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))
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       Text -> Text -> Doc String
    metaTag Text
    "dc:subject" (Text -> Meta -> Text
    lookupMetaString Text
    "subject" Meta
    meta)
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       Text -> Text -> Doc String
    metaTag Text
    "meta:keyword" (Text -> [Text] -> Text
    T.intercalate Text
    ", " [Text]
    keywords)
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       case Maybe Lang
    lang of
                            Just Lang
    l  -> Text -> Text -> Doc String
    metaTag Text
    "dc:language" (Lang -> Text
    renderLang Lang
    l)
                            Maybe Lang
    Nothing -> Doc String
    forall a. Doc a
    empty
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       (\Text
    d Text
    a -> Text -> Text -> Doc String
    metaTag Text
    "meta:initial-creator" Text
    a
                             Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$ Text -> Text -> Doc String
    metaTag Text
    "dc:creator" Text
    a
                             Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$ Text -> Text -> Doc String
    metaTag Text
    "meta:creation-date" Text
    d
                             Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$ Text -> Text -> Doc String
    metaTag Text
    "dc:date" Text
    d
                       ) (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)
                         (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]]
    authors))
                       Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
                       [Doc String] -> Doc String
    forall a. [Doc a] -> Doc a
    vcat [Doc String]
    userDefinedMeta
                     )
                 )
      -- make sure mimetype is first
      let mimetypeEntry = String -> Integer -> ByteString -> Entry
    toEntry String
    "mimetype" Integer
    epochtime
                          (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    fromStringLazy String
    "application/vnd.oasis.opendocument.text"
      archive'' <- updateStyle opts lang
                      $ addEntryToArchive mimetypeEntry
                      $ addEntryToArchive metaEntry archive'
      return $ fromArchive archive''

    updateStyle :: forall m . PandocMonad m
                => WriterOptions -> Maybe Lang -> Archive -> O m Archive
    updateStyle :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Maybe Lang -> Archive -> O m Archive
    updateStyle WriterOptions
    opts Maybe Lang
    mbLang Archive
    arch = do
      epochtime <- POSIXTime -> Integer
    forall b. Integral b => POSIXTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Integer)
    -> StateT ODTState m POSIXTime -> StateT ODTState m Integer
    forall a b. (a -> b) -> StateT ODTState m a -> StateT ODTState m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` m POSIXTime -> StateT ODTState m POSIXTime
    forall (m :: * -> *) a. Monad m => m a -> StateT ODTState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m POSIXTime
    forall (m :: * -> *). PandocMonad m => m POSIXTime
    P.getPOSIXTime
      let goEntry :: Entry -> O m Entry
          goEntry Entry
    e
            | Entry -> String
    eRelativePath Entry
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "styles.xml"
              = case Text -> Either Text Element
    parseXMLElement (ByteString -> Text
    toTextLazy (Entry -> ByteString
    fromEntry Entry
    e)) of
                  Left Text
    msg -> PandocError -> O m Entry
    forall a. PandocError -> StateT ODTState m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> O m Entry) -> PandocError -> O m Entry
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocXMLError Text
    "styles.xml" Text
    msg
                  Right Element
    d -> Entry -> O m Entry
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Entry -> O m Entry) -> Entry -> O m Entry
    forall a b. (a -> b) -> a -> b
    $
                    String -> Integer -> ByteString -> Entry
    toEntry String
    "styles.xml" Integer
    epochtime
                    ( Text -> ByteString
    fromTextLazy
                    (Text -> ByteString) -> (Element -> Text) -> Element -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    TL.fromStrict
                    (Text -> Text) -> (Element -> Text) -> Element -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Text
    showTopElement
                    (Element -> Text) -> (Element -> Element) -> Element -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Element -> Element)
    -> (Lang -> Element -> Element) -> Maybe Lang -> Element -> Element
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Element -> Element
    forall a. a -> a
    id Lang -> Element -> Element
    addLang Maybe Lang
    mbLang
                    (Element -> Element) -> (Element -> Element) -> Element -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QName -> Bool) -> (Element -> Element) -> Element -> Element
    transformElement (\QName
    qn -> QName -> Text
    qName QName
    qn Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "styles" Bool -> Bool -> Bool
    &&
                                          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
    "office" )
                         (Element -> Element
    addListItemStyles (Element -> Element) -> (Element -> Element) -> Element -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                          (case WriterOptions -> HighlightMethod
    writerHighlightMethod WriterOptions
    opts of
                            Skylighting Style
    style -> Style -> Element -> Element
    addHlStyles Style
    style
                            HighlightMethod
    _ -> Element -> Element
    forall a. a -> a
    id))
                    (Element -> ByteString) -> Element -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Element
    d )
            | Bool
    otherwise = Entry -> O m Entry
    forall a. a -> StateT ODTState m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Entry
    e
      entries <- mapM goEntry (zEntries arch)
      return arch{ zEntries = entries }

    addHlStyles :: Style -> Element -> Element
    addHlStyles :: Style -> Element -> Element
    addHlStyles Style
    sty Element
    el =
      Element
    el{ elContent = filter (not . isHlStyle) (elContent el) ++
                    styleToOpenDocument sty }
     where
       isHlStyle :: Content -> Bool
    isHlStyle (Elem Element
    e) = Text
    "Tok" Text -> Text -> Bool
    `T.isSuffixOf` (QName -> Text
    qName (Element -> QName
    elName Element
    e))
       isHlStyle Content
    _ = Bool
    False

    -- | Ensure the office:styles element contains paragraph styles for
    -- list items used by the OpenDocument writer.  This injects only the
    -- styles that are missing, so a user-supplied reference.odt may
    -- override any of them.
    addListItemStyles :: Element -> Element
    addListItemStyles :: Element -> Element
    addListItemStyles Element
    el =
      Element
    el{ elContent = elContent el ++ map Elem missingStyles }
     where
       existing :: [Text]
    existing = [ [Text] -> Text
    T.concat [ Attr -> Text
    attrVal Attr
    a
                             | Attr
    a <- Element -> [Attr]
    elAttribs Element
    e
                             , QName -> Text
    qName (Attr -> QName
    attrKey Attr
    a) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "name"
                             , QName -> Maybe Text
    qPrefix (Attr -> QName
    attrKey Attr
    a) Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "style" ]
                  | Elem Element
    e <- Element -> [Content]
    elContent Element
    el
                  , QName -> Text
    qName (Element -> QName
    elName Element
    e) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "style"
                  , QName -> Maybe Text
    qPrefix (Element -> QName
    elName Element
    e) Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "style" ]
       missingStyles :: [Element]
    missingStyles =
         [ Element
    s | Element
    s <- [Element]
    listItemStyleElements
             , Element -> Text
    styleNameOf Element
    s Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Text]
    existing ]
       styleNameOf :: Element -> Text
    styleNameOf Element
    e = [Text] -> Text
    T.concat [ Attr -> Text
    attrVal Attr
    a
                                | Attr
    a <- Element -> [Attr]
    elAttribs Element
    e
                                , QName -> Text
    qName (Attr -> QName
    attrKey Attr
    a) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "name"
                                , QName -> Maybe Text
    qPrefix (Attr -> QName
    attrKey Attr
    a) Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "style" ]

    listItemStyleElements :: [Element]
    listItemStyleElements :: [Element]
    listItemStyleElements =
      [ Text -> Text -> Maybe Element -> Element
    mkParaStyle Text
    "List_20_Bullet" Text
    "List Bullet" Maybe Element
    forall a. Maybe a
    Nothing
      , Text -> Text -> Maybe Element -> Element
    mkParaStyle Text
    "List_20_Bullet_20_Tight" Text
    "List Bullet Tight" (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    tightProps)
      , Text -> Text -> Maybe Element -> Element
    mkParaStyle Text
    "List_20_Number" Text
    "List Number" Maybe Element
    forall a. Maybe a
    Nothing
      , Text -> Text -> Maybe Element -> Element
    mkParaStyle Text
    "List_20_Number_20_Tight" Text
    "List Number Tight" (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    tightProps)
      ]
     where
       styleQN :: Text -> Text -> QName
    styleQN Text
    n Text
    p = Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    n Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    p)
       mkAttr :: Text -> Text -> Text -> Attr
    mkAttr Text
    p Text
    n Text
    v = QName -> Text -> Attr
    Attr (Text -> Text -> QName
    styleQN Text
    n Text
    p) Text
    v
       tightProps :: Element
    tightProps =
         QName -> [Attr] -> [Content] -> Maybe Integer -> Element
    Element (Text -> Text -> QName
    styleQN Text
    "paragraph-properties" Text
    "style")
           [ Text -> Text -> Text -> Attr
    mkAttr Text
    "fo" Text
    "margin-top" Text
    "0in"
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "fo" Text
    "margin-bottom" Text
    "0in"
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "contextual-spacing" Text
    "false"
           ] [] Maybe Integer
    forall a. Maybe a
    Nothing
       mkParaStyle :: Text -> Text -> Maybe Element -> Element
    mkParaStyle Text
    name Text
    display Maybe Element
    mbProps =
         QName -> [Attr] -> [Content] -> Maybe Integer -> Element
    Element (Text -> Text -> QName
    styleQN Text
    "style" Text
    "style")
           [ Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "name" Text
    name
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "display-name" Text
    display
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "family" Text
    "paragraph"
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "parent-style-name" Text
    "List"
           , Text -> Text -> Text -> Attr
    mkAttr Text
    "style" Text
    "class" Text
    "list"
           ]
           ([Content] -> (Element -> [Content]) -> Maybe Element -> [Content]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Element
    p -> [Element -> Content
    Elem Element
    p]) Maybe Element
    mbProps)
           Maybe Integer
    forall a. Maybe a
    Nothing

    -- top-down search
    transformElement :: (QName -> Bool)
                     -> (Element -> Element)
                     -> Element
                     -> Element
    transformElement :: (QName -> Bool) -> (Element -> Element) -> Element -> Element
    transformElement QName -> Bool
    g Element -> Element
    f Element
    el
      | QName -> Bool
    g (Element -> QName
    elName Element
    el)
        = Element -> Element
    f Element
    el
      | Bool
    otherwise
        = Element
    el{ elContent = map go (elContent el) }
     where
       go :: Content -> Content
    go (Elem Element
    e) = Element -> Content
    Elem ((QName -> Bool) -> (Element -> Element) -> Element -> Element
    transformElement QName -> Bool
    g Element -> Element
    f Element
    e)
       go Content
    x = Content
    x

    -- TODO FIXME avoid this generic traversal!
    addLang :: Lang -> Element -> Element
    addLang :: Lang -> Element -> Element
    addLang Lang
    lang = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere' ((Attr -> Attr) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Attr -> Attr
    updateLangAttr)
        where updateLangAttr :: Attr -> Attr
    updateLangAttr (Attr n :: QName
    n@(QName Text
    "language" Maybe Text
    _ (Just Text
    "fo")) Text
    _)
                               = QName -> Text -> Attr
    Attr QName
    n (Lang -> Text
    langLanguage Lang
    lang)
              updateLangAttr (Attr n :: QName
    n@(QName Text
    "country" Maybe Text
    _ (Just Text
    "fo")) Text
    _)
                               = QName -> Text -> Attr
    Attr QName
    n (Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Lang -> Maybe Text
    langRegion Lang
    lang)
              updateLangAttr Attr
    x = Attr
    x

    -- | transform both Image and Math elements
    transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline
    transformPicMath :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> O m Inline
    transformPicMath WriterOptions
    opts (Image attr :: Attr
    attr@(Text
    id', [Text]
    cls, [(Text, Text)]
    _) [Inline]
    lab (Text
    src,Text
    t)) = StateT ODTState m Inline
    -> (PandocError -> StateT ODTState m Inline)
    -> StateT ODTState m Inline
    forall a.
    StateT ODTState m a
    -> (PandocError -> StateT ODTState m a) -> StateT ODTState m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError
       (do (img, mbMimeType) <- Text -> StateT ODTState m (StrictByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (StrictByteString, Maybe Text)
    P.fetchItem Text
    src
           (ptX, ptY) <- case imageSize opts img of
                           Right ImageSize
    s  -> (Double, Double) -> StateT ODTState m (Double, Double)
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Double, Double) -> StateT ODTState m (Double, Double))
    -> (Double, Double) -> StateT ODTState m (Double, Double)
    forall a b. (a -> b) -> a -> b
    $ ImageSize -> (Double, Double)
    sizeInPoints ImageSize
    s
                           Left Text
    msg -> do
                             LogMessage -> StateT ODTState m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT ODTState m ())
    -> LogMessage -> StateT ODTState m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> LogMessage
    CouldNotDetermineImageSize Text
    src Text
    msg
                             (Double, Double) -> StateT ODTState m (Double, Double)
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double
    100, Double
    100)
           let dims =
                 case (Direction -> Maybe Dimension
    getDim Direction
    Width, Direction -> Maybe Dimension
    getDim Direction
    Height) of
                   (Just Dimension
    w, Just Dimension
    h)              -> [(Text
    "width", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    w), (Text
    "height", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    h)]
                   (Just w :: Dimension
    w@(Percent Double
    _), Maybe Dimension
    Nothing) -> [(Text
    "rel-width", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    w),(Text
    "rel-height", Text
    "scale"),(Text
    "width", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptX Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt"),(Text
    "height", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptY Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt")]
                   (Maybe Dimension
    Nothing, Just h :: Dimension
    h@(Percent Double
    _)) -> [(Text
    "rel-width", Text
    "scale"),(Text
    "rel-height", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    h),(Text
    "width", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptX Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt"),(Text
    "height", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptY Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt")]
                   (Just w :: Dimension
    w@(Inch Double
    i), Maybe Dimension
    Nothing)    -> [(Text
    "width", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    w), (Text
    "height", Double -> Text
    forall a. Show a => a -> Text
    tshow (Double
    i Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    ratio) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "in")]
                   (Maybe Dimension
    Nothing, Just h :: Dimension
    h@(Inch Double
    i))    -> [(Text
    "width", Double -> Text
    forall a. Show a => a -> Text
    tshow (Double
    i Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    ratio) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "in"), (Text
    "height", Dimension -> Text
    forall a. Show a => a -> Text
    tshow Dimension
    h)]
                   (Maybe Dimension, Maybe Dimension)
    _                             -> [(Text
    "width", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptX Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt"), (Text
    "height", Double -> Text
    forall a. Show a => a -> Text
    tshow Double
    ptY Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "pt")]
                 where
                   ratio :: Double
    ratio = Double
    ptX Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    ptY
                   getDim :: Direction -> Maybe Dimension
    getDim Direction
    dir = case Direction -> Attr -> Maybe Dimension
    dimension Direction
    dir Attr
    attr of
                                  Just (Percent Double
    i) -> Dimension -> Maybe Dimension
    forall a. a -> Maybe a
    Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
    forall a b. (a -> b) -> a -> b
    $ Double -> Dimension
    Percent Double
    i
                                  Just Dimension
    dim         -> Dimension -> Maybe Dimension
    forall a. a -> Maybe a
    Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
    forall a b. (a -> b) -> a -> b
    $ Double -> Dimension
    Inch (Double -> Dimension) -> Double -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Dimension -> Double
    inInch WriterOptions
    opts Dimension
    dim
                                  Maybe Dimension
    Nothing          -> Maybe Dimension
    forall a. Maybe a
    Nothing
           let  newattr = (Text
    id', [Text]
    cls, [(Text, Text)]
    dims)
           src' <- if writerLinkImages opts
                      then
                        case T.unpack src of
                          String
    s | String -> Bool
    isURI String
    s -> Text -> StateT ODTState m Text
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    src
                            | String -> Bool
    isAbsolute String
    s -> Text -> StateT ODTState m Text
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    src
                            | Bool
    otherwise -> Text -> StateT ODTState m Text
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> StateT ODTState m Text) -> Text -> StateT ODTState m Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    ".." String -> String -> String
    </> String
    s
                      else do
                        entries <- gets stEntries
                        let extension = String -> (Text -> String) -> Maybe Text -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> String
    takeExtension (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '?') (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    src) Text -> String
    T.unpack
                                            (Maybe Text
    mbMimeType Maybe Text -> (Text -> 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
    >>= Text -> Maybe Text
    extensionFromMimeType)
                        let newsrc = String
    "Pictures/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([Entry] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Entry]
    entries) String -> String -> String
    <.> String
    extension
                        let toLazy = [StrictByteString] -> ByteString
    B.fromChunks ([StrictByteString] -> ByteString)
    -> (StrictByteString -> [StrictByteString])
    -> StrictByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StrictByteString -> [StrictByteString] -> [StrictByteString]
    forall a. a -> [a] -> [a]
    :[])
                        epochtime <- floor `fmap` lift P.getPOSIXTime
                        let entry = String -> Integer -> ByteString -> Entry
    toEntry String
    newsrc Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ StrictByteString -> ByteString
    toLazy StrictByteString
    img
                        modify $ \ODTState
    st -> ODTState
    st{ stEntries = entry : entries }
                        return $ T.pack newsrc
           return $ Image newattr lab (src', t))
       (\PandocError
    e -> do
           LogMessage -> StateT ODTState m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT ODTState m ())
    -> LogMessage -> StateT ODTState m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> LogMessage
    CouldNotFetchResource Text
    src (Text -> LogMessage) -> Text -> LogMessage
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (PandocError -> String
    forall a. Show a => a -> String
    show PandocError
    e)
           Inline -> StateT ODTState m Inline
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Inline -> StateT ODTState m Inline)
    -> Inline -> StateT ODTState m Inline
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Inline
    Emph [Inline]
    lab)

    transformPicMath WriterOptions
    _ (Math MathType
    t Text
    math) = do
      entries <- (ODTState -> [Entry]) -> StateT ODTState m [Entry]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ODTState -> [Entry]
    stEntries
      let dt = if MathType
    t MathType -> MathType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MathType
    InlineMath then DisplayType
    DisplayInline else DisplayType
    DisplayBlock
      case writeMathML dt <$> readTeX math of
           Left  Text
    _ -> Inline -> StateT ODTState m Inline
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Inline -> StateT ODTState m Inline)
    -> Inline -> StateT ODTState m Inline
    forall a b. (a -> b) -> a -> b
    $ MathType -> Text -> Inline
    Math MathType
    t Text
    math
           Right Element
    r -> do
             let conf :: ConfigPP
    conf = (QName -> Bool) -> ConfigPP -> ConfigPP
    XL.useShortEmptyTags (Bool -> QName -> Bool
    forall a b. a -> b -> a
    const Bool
    False) ConfigPP
    XL.defaultConfigPP
             let mathml :: String
    mathml = ConfigPP -> Element -> String
    XL.ppcTopElement ConfigPP
    conf Element
    r
             epochtime <- POSIXTime -> Integer
    forall b. Integral b => POSIXTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Integer)
    -> StateT ODTState m POSIXTime -> StateT ODTState m Integer
    forall a b. (a -> b) -> StateT ODTState m a -> StateT ODTState m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` m POSIXTime -> StateT ODTState m POSIXTime
    forall (m :: * -> *) a. Monad m => m a -> StateT ODTState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m POSIXTime
    forall (m :: * -> *). PandocMonad m => m POSIXTime
    P.getPOSIXTime
             let dirname = String
    "Formula-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([Entry] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Entry]
    entries) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/"
             let fname = String
    dirname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "content.xml"
             let entry = String -> Integer -> ByteString -> Entry
    toEntry String
    fname Integer
    epochtime (String -> ByteString
    fromStringLazy String
    mathml)
             let fname' = String
    dirname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "settings.xml"
             let entry' = String -> Integer -> ByteString -> Entry
    toEntry String
    fname' Integer
    epochtime (ByteString -> Entry) -> ByteString -> Entry
    forall a b. (a -> b) -> a -> b
    $ Bool -> ByteString
    documentSettings (MathType
    t MathType -> MathType -> Bool
    forall a. Eq a => a -> a -> Bool
    == MathType
    InlineMath)
             modify $ \ODTState
    st -> ODTState
    st{ stEntries = entry' : (entry : entries) }
             return $ RawInline (Format "opendocument") $ render Nothing $
               inTags False "draw:frame" (if t == DisplayMath
                                          then [("draw:style-name","fr2")
                                               -- `draw:frame` does not support either
                                               -- `style:vertical-pos` or `style:vertical-rel`,
                                               -- therefore those attributes must go into the
                                               -- `style:style` element
                                               ,("text:anchor-type","paragraph")]
                                          else [("draw:style-name","fr1")
                                               ,("text:anchor-type","as-char")]) $
                 selfClosingTag "draw:object" [("xlink:href", T.pack dirname)
                                            , ("xlink:type", "simple")
                                            , ("xlink:show", "embed")
                                            , ("xlink:actuate", "onLoad")]

    transformPicMath WriterOptions
    _ Inline
    x = Inline -> StateT ODTState m Inline
    forall a. a -> StateT ODTState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Inline
    x

    documentSettings :: Bool -> B.ByteString
    documentSettings :: Bool -> ByteString
    documentSettings Bool
    isTextMode = String -> ByteString
    fromStringLazy (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Doc String -> String
    forall a. HasChars a => Maybe Int -> Doc a -> a
    render Maybe Int
    forall a. Maybe a
    Nothing
        (Doc String -> String) -> Doc String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Doc String
    forall a. HasChars a => String -> Doc a
    text String
    "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
        Doc String -> Doc String -> Doc String
    forall a. Doc a -> Doc a -> Doc a
    $$
        Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "office:document-settings"
          [(Text
    "xmlns:office",Text
    "urn:oasis:names:tc:opendocument:xmlns:office:1.0")
          ,(Text
    "xmlns:xlink",Text
    "http://www.w3.org/1999/xlink")
          ,(Text
    "xmlns:config",Text
    "urn:oasis:names:tc:opendocument:xmlns:config:1.0")
          ,(Text
    "xmlns:ooo",Text
    "http://openoffice.org/2004/office")
          ,(Text
    "office:version",Text
    "1.3")] (
           Text -> Doc String -> Doc String
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "office:settings" (Doc String -> Doc String) -> Doc String -> Doc String
    forall a b. (a -> b) -> a -> b
    $
             Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    "config:config-item-set"
               [(Text
    "config:name", Text
    "ooo:configuration-settings")] (Doc String -> Doc String) -> Doc String -> Doc String
    forall a b. (a -> b) -> a -> b
    $
               Bool -> Text -> [(Text, Text)] -> Doc String -> Doc String
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    "config:config-item" [(Text
    "config:name", Text
    "IsTextMode")
                                                 ,(Text
    "config:type", Text
    "boolean")] (Doc String -> Doc String) -> Doc String -> Doc String
    forall a b. (a -> b) -> a -> b
    $
                                                  String -> Doc String
    forall a. HasChars a => String -> Doc a
    text (String -> Doc String) -> String -> Doc String
    forall a b. (a -> b) -> a -> b
    $ if Bool
    isTextMode then String
    "true" else String
    "false")

    styleToOpenDocument :: Style -> [Content]
    styleToOpenDocument :: Style -> [Content]
    styleToOpenDocument Style
    style = (TokenType -> Content) -> [TokenType] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map (Element -> Content
    Elem (Element -> Content)
    -> (TokenType -> Element) -> TokenType -> Content
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TokenType -> Element
    toStyle) [TokenType]
    alltoktypes
      where alltoktypes :: [TokenType]
    alltoktypes = TokenType -> TokenType -> [TokenType]
    forall a. Enum a => a -> a -> [a]
    enumFromTo TokenType
    KeywordTok TokenType
    NormalTok
            styleName :: Text -> QName
    styleName Text
    x =
              case (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ':') Text
    x of
                (Text
    b, Text
    a) | Text -> Bool
    T.null Text
    a  -> Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    x Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "style")
                       | Bool
    otherwise -> Text -> Maybe Text -> Maybe Text -> QName
    QName (Int -> Text -> Text
    T.drop Int
    1 Text
    a) Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    b)
            styleAttr :: (Text, Text) -> Attr
    styleAttr (Text
    x, Text
    y) = QName -> Text -> Attr
    Attr (Text -> QName
    styleName Text
    x) Text
    y
            styleAttrs :: [(Text, Text)] -> [Attr]
    styleAttrs = ((Text, Text) -> Attr) -> [(Text, Text)] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> Attr
    styleAttr
            styleElement :: Text -> [(Text, Text)] -> [Content] -> Element
    styleElement Text
    x [(Text, Text)]
    attrs [Content]
    cs =
              QName -> [Attr] -> [Content] -> Maybe Integer -> Element
    Element (Text -> QName
    styleName Text
    x) ([(Text, Text)] -> [Attr]
    styleAttrs [(Text, Text)]
    attrs) [Content]
    cs Maybe Integer
    forall a. Maybe a
    Nothing
            toStyle :: TokenType -> Element
    toStyle TokenType
    toktype =
              Text -> [(Text, Text)] -> [Content] -> Element
    styleElement Text
    "style"
                [(Text
    "name", TokenType -> Text
    forall a. Show a => a -> Text
    tshow TokenType
    toktype), (Text
    "family", Text
    "text")]
                [Element -> Content
    Elem (Text -> [(Text, Text)] -> [Content] -> Element
    styleElement Text
    "text-properties"
                          (TokenType -> [(Text, Text)]
    forall {a}. IsString a => TokenType -> [(a, Text)]
    tokColor TokenType
    toktype [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++ TokenType -> [(Text, Text)]
    forall {a}. IsString a => TokenType -> [(a, Text)]
    tokBgColor TokenType
    toktype [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                            [(Text
    "fo:font-style", Text
    "italic") |
                               (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenItalic TokenType
    toktype ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                            [(Text
    "fo:font-weight", Text
    "bold") |
                               (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenBold TokenType
    toktype ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                            [(Text
    "style:text-underline-style", Text
    "solid") |
                               (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature TokenStyle -> Bool
    tokenUnderline TokenType
    toktype ])
                            [])]
            tokStyles :: Map TokenType TokenStyle
    tokStyles = Style -> Map TokenType TokenStyle
    tokenStyles Style
    style
            tokFeature :: (TokenStyle -> Bool) -> TokenType -> Bool
    tokFeature 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
    Map.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles
            tokColor :: TokenType -> [(a, Text)]
    tokColor TokenType
    toktype =
              [(a, Text)] -> (Color -> [(a, Text)]) -> Maybe Color -> [(a, Text)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Color
    c -> [(a
    "fo:color", String -> Text
    T.pack (Color -> String
    forall a. FromColor a => Color -> a
    fromColor Color
    c))])
                            ((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
    Map.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)
            tokBgColor :: TokenType -> [(a, Text)]
    tokBgColor TokenType
    toktype =
              [(a, Text)] -> (Color -> [(a, Text)]) -> Maybe Color -> [(a, Text)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Color
    c -> [(a
    "fo:background-color", String -> Text
    T.pack (Color -> String
    forall a. FromColor a => Color -> a
    fromColor Color
    c))])
                        (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
    Map.lookup TokenType
    toktype Map TokenType TokenStyle
    tokStyles)