{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.ODT
   Copyright   : Copyright (C) 2008-2022 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
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, (<.>))
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.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 (..))
import Text.DocLayout
import Text.Pandoc.Shared (stringify, pandocVersion, tshow)
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

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
ensureValidXmlIdentifiers Pandoc
doc
  in
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> O m ByteString
pandocToODT WriterOptions
opts Pandoc
doc') ODTState
initState

-- | 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
utctime <- forall (m :: * -> *). PandocMonad m => m UTCTime
P.getTimestamp
  Maybe Lang
lang <- forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
opts Meta
meta)
  Archive
refArchive <-
       case WriterOptions -> Maybe String
writerReferenceDoc WriterOptions
opts of
             Just String
f -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> Archive
toArchive forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readFileLazy String
f
             Maybe String
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ByteString -> Archive
toArchive forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                forall (m :: * -> *). PandocMonad m => String -> m ByteString
P.readDataFile String
"reference.odt"
  -- handle formulas and pictures
  -- picEntriesRef <- P.newIORef ([] :: [Entry])
  Pandoc
doc' <- forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> O m Inline
transformPicMath WriterOptions
opts) forall a b. (a -> b) -> a -> b
$ forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
fixDisplayMath Pandoc
doc
  Text
newContents <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOpenDocument WriterOptions
opts{writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapNone} Pandoc
doc'
  Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
  let contentEntry :: Entry
contentEntry = String -> Integer -> ByteString -> Entry
toEntry String
"content.xml" Integer
epochtime
                     forall a b. (a -> b) -> a -> b
$ Text -> ByteString
fromTextLazy forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
newContents
  [Entry]
picEntries <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ODTState -> [Entry]
stEntries
  let archive :: Archive
archive = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
refArchive
                forall a b. (a -> b) -> a -> b
$ Entry
contentEntry forall a. a -> [a] -> [a]
: [Entry]
picEntries
  -- construct META-INF/manifest.xml based on archive
  let toFileEntry :: String -> Doc a
toFileEntry String
fp = case String -> Maybe Text
getMimeType String
fp of
                        Maybe Text
Nothing  -> forall a. Doc a
empty
                        Just Text
m   -> 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)
                                     ,(Text
"manifest:version", Text
"1.2")
                                     ]
  let files :: [String]
files = [ String
ent | String
ent <- Archive -> [String]
filesInArchive Archive
archive,
                             Bool -> Bool
not (String
"META-INF" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ent) ]
  let formulas :: [String]
formulas = [ String -> String
takeDirectory String
ent forall a. [a] -> [a] -> [a]
++ String
"/" | String
ent <- Archive -> [String]
filesInArchive Archive
archive,
                      String
"Formula-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ent, String -> String
takeExtension String
ent forall a. Eq a => a -> a -> Bool
== String
".xml" ]
  let manifestEntry :: Entry
manifestEntry = String -> Integer -> ByteString -> Entry
toEntry String
"META-INF/manifest.xml" Integer
epochtime
        forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromStringLazy forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing
        forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
        forall a. Doc a -> Doc a -> Doc a
$$
         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.2")] ( 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
"/")]
                forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat ( forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => String -> Doc a
toFileEntry [String]
files )
                forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat ( forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => String -> Doc a
toFileEntry [String]
formulas )
              )
  let archive' :: Archive
archive' = Entry -> Archive -> Archive
addEntryToArchive Entry
manifestEntry Archive
archive
  -- create meta.xml
  let userDefinedMetaFields :: [Text]
userDefinedMetaFields = [Text
k | Text
k <- forall k a. Map k a -> [k]
Map.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
                              , Text
k 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 :: Text -> Doc String
escapedText = forall a. HasChars a => String -> Doc a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeStringForXML
  let keywords :: [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"keywords" Meta
meta of
                      Just (MetaList [MetaValue]
xs) -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify [MetaValue]
xs
                      Maybe MetaValue
_                  -> []
  let userDefinedMeta :: [Doc String]
userDefinedMeta =
        forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> 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 forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
lookupMetaString Text
k Meta
meta)) [Text]
userDefinedMetaFields
  let metaTag :: Text -> Text -> Doc String
metaTag Text
metafield = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
metafield forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc String
escapedText
  let metaEntry :: Entry
metaEntry = String -> Integer -> ByteString -> Entry
toEntry String
"meta.xml" Integer
epochtime
       forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromStringLazy forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing
       forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
       forall a. Doc a -> Doc a -> Doc a
$$
        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.2")] ( 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/" forall a. Semigroup a => a -> a -> a
<> Text
pandocVersion)
                   forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc String
metaTag Text
"dc:title" (forall a. Walkable Inline a => a -> Text
stringify [Inline]
title)
                   forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc String
metaTag Text
"dc:description"
                          (Text -> [Text] -> Text
T.intercalate Text
"\n" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify forall a b. (a -> b) -> a -> b
$
                                         Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta))
                   forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc String
metaTag Text
"dc:subject" (Text -> Meta -> Text
lookupMetaString Text
"subject" Meta
meta)
                   forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc String
metaTag Text
"meta:keyword" (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
keywords)
                   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 -> forall a. Doc a
empty
                   forall a. Doc a -> Doc a -> Doc a
$$
                   (\Text
d Text
a -> Text -> Text -> Doc String
metaTag Text
"meta:initial-creator" Text
a
                         forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc String
metaTag Text
"dc:creator" Text
a
                         forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc String
metaTag Text
"meta:creation-date" Text
d
                         forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc String
metaTag Text
"dc:date" Text
d
                   ) (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%XZ" UTCTime
utctime)
                     (Text -> [Text] -> Text
T.intercalate Text
"; " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify [[Inline]]
authors))
                   forall a. Doc a -> Doc a -> Doc a
$$
                   forall a. [Doc a] -> Doc a
vcat [Doc String]
userDefinedMeta
                 )
             )
  -- make sure mimetype is first
  let mimetypeEntry :: Entry
mimetypeEntry = String -> Integer -> ByteString -> Entry
toEntry String
"mimetype" Integer
epochtime
                      forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromStringLazy String
"application/vnd.oasis.opendocument.text"
  Archive
archive'' <- forall (m :: * -> *).
PandocMonad m =>
Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Maybe Lang
lang
                  forall a b. (a -> b) -> a -> b
$ Entry -> Archive -> Archive
addEntryToArchive Entry
mimetypeEntry
                  forall a b. (a -> b) -> a -> b
$ Entry -> Archive -> Archive
addEntryToArchive Entry
metaEntry Archive
archive'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive''

updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive
updateStyleWithLang :: forall (m :: * -> *).
PandocMonad m =>
Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Maybe Lang
Nothing Archive
arch = forall (m :: * -> *) a. Monad m => a -> m a
return Archive
arch
updateStyleWithLang (Just Lang
lang) Archive
arch = do
  Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
  [Entry]
entries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Entry
e -> if Entry -> String
eRelativePath Entry
e forall a. Eq a => a -> a -> Bool
== String
"styles.xml"
                            then case Text -> Either Text Element
parseXMLElement
                                    (ByteString -> Text
toTextLazy (Entry -> ByteString
fromEntry Entry
e)) of
                                    Left Text
msg -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
                                        Text -> Text -> PandocError
PandocXMLError Text
"styles.xml" Text
msg
                                    Right Element
d -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                                      String -> Integer -> ByteString -> Entry
toEntry String
"styles.xml" Integer
epochtime
                                      ( Text -> ByteString
fromTextLazy
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
ppTopElement
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Element -> Element
addLang Lang
lang forall a b. (a -> b) -> a -> b
$ Element
d )
                            else forall (m :: * -> *) a. Monad m => a -> m a
return Entry
e) (Archive -> [Entry]
zEntries Archive
arch)
  forall (m :: * -> *) a. Monad m => a -> m a
return Archive
arch{ zEntries :: [Entry]
zEntries = [Entry]
entries }

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

transformPicMath WriterOptions
_ (Math MathType
t Text
math) = do
  [Entry]
entries <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ODTState -> [Entry]
stEntries
  let dt :: DisplayType
dt = if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then DisplayType
DisplayInline else DisplayType
DisplayBlock
  case DisplayType -> [Exp] -> Element
writeMathML DisplayType
dt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text [Exp]
readTeX Text
math of
       Left  Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 (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
         Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
         let dirname :: String
dirname = String
"Formula-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entry]
entries) forall a. [a] -> [a] -> [a]
++ String
"/"
         let fname :: String
fname = String
dirname forall a. [a] -> [a] -> [a]
++ String
"content.xml"
         let entry :: Entry
entry = String -> Integer -> ByteString -> Entry
toEntry String
fname Integer
epochtime (String -> ByteString
fromStringLazy String
mathml)
         let fname' :: String
fname' = String
dirname forall a. [a] -> [a] -> [a]
++ String
"settings.xml"
         let entry' :: Entry
entry' = String -> Integer -> ByteString -> Entry
toEntry String
fname' Integer
epochtime forall a b. (a -> b) -> a -> b
$ Bool -> ByteString
documentSettings (MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath)
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ODTState
st -> ODTState
st{ stEntries :: [Entry]
stEntries = Entry
entry' forall a. a -> [a] -> [a]
: (Entry
entry forall a. a -> [a] -> [a]
: [Entry]
entries) }
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"opendocument") forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
           forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"draw:frame" (if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath
                                      then [(Text
"draw:style-name",Text
"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
"text:anchor-type",Text
"paragraph")]
                                      else [(Text
"draw:style-name",Text
"fr1")
                                           ,(Text
"text:anchor-type",Text
"as-char")]) forall a b. (a -> b) -> a -> b
$
             forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"draw:object" [(Text
"xlink:href", String -> Text
T.pack String
dirname)
                                        , (Text
"xlink:type", Text
"simple")
                                        , (Text
"xlink:show", Text
"embed")
                                        , (Text
"xlink:actuate", Text
"onLoad")]

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

documentSettings :: Bool -> B.ByteString
documentSettings :: Bool -> ByteString
documentSettings Bool
isTextMode = String -> ByteString
fromStringLazy forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing
    forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
    forall a. Doc a -> Doc a -> Doc a
$$
    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.2")] (
       forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"office:settings" forall a b. (a -> b) -> a -> b
$
         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")] forall a b. (a -> b) -> a -> b
$
           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")] forall a b. (a -> b) -> a -> b
$
                                              forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ if Bool
isTextMode then String
"true" else String
"false")