{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.ODT
   Copyright   : Copyright (C) 2008-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to ODT.
-}
module Text.Pandoc.Writers.ODT ( writeODT ) where
import Codec.Archive.Zip
import Control.Monad.Except (catchError)
import Control.Monad.State.Strict
import qualified Data.ByteString.Lazy as B
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.Pandoc.BCP47 (Lang (..), getLang, renderLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
import qualified Text.Pandoc.Class.PandocMonad as P
import Text.Pandoc.Definition
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)
import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
import Text.Pandoc.XML
import Text.TeXMath
import Text.XML.Light

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 :: WriterOptions -> Pandoc -> m ByteString
writeODT  WriterOptions
opts Pandoc
doc =
  let initState :: ODTState
initState = ODTState :: [Entry] -> ODTState
ODTState{ stEntries :: [Entry]
stEntries = []
                          }
  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

-- | Produce an ODT file from a Pandoc document.
pandocToODT :: PandocMonad m
            => WriterOptions  -- ^ Writer options
            -> Pandoc         -- ^ Document to convert
            -> O m B.ByteString
pandocToODT :: 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 <- StateT ODTState m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
P.getCurrentTime
  Maybe Lang
lang <- Maybe Text -> StateT ODTState m (Maybe 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 FilePath
writerReferenceDoc WriterOptions
opts of
             Just FilePath
f -> (ByteString -> Archive)
-> O m ByteString -> StateT ODTState m Archive
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> Archive
toArchive (O m ByteString -> StateT ODTState m Archive)
-> O m ByteString -> StateT ODTState m Archive
forall a b. (a -> b) -> a -> b
$ m ByteString -> O m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> O m ByteString) -> m ByteString -> O m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
P.readFileLazy FilePath
f
             Maybe FilePath
Nothing -> m Archive -> StateT ODTState m Archive
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)
-> (ByteString -> ByteString) -> ByteString -> Archive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.fromStrict (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
P.readDataFile FilePath
"reference.odt"
  -- handle formulas and pictures
  -- picEntriesRef <- P.newIORef ([] :: [Entry])
  Pandoc
doc' <- (Inline -> StateT ODTState m Inline)
-> Pandoc -> StateT ODTState m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (WriterOptions -> Inline -> StateT ODTState m Inline
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> O m Inline
transformPicMath WriterOptions
opts) (Pandoc -> StateT ODTState m Pandoc)
-> Pandoc -> StateT ODTState m Pandoc
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
fixDisplayMath Pandoc
doc
  Text
newContents <- m Text -> StateT ODTState m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text -> StateT ODTState m Text)
-> m Text -> StateT ODTState m Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOpenDocument WriterOptions
opts{writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapNone} Pandoc
doc'
  Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> StateT ODTState m POSIXTime -> StateT ODTState m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m POSIXTime -> StateT ODTState m POSIXTime
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 contentEntry :: Entry
contentEntry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"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
  [Entry]
picEntries <- (ODTState -> [Entry]) -> StateT ODTState m [Entry]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ODTState -> [Entry]
stEntries
  let archive :: Archive
archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
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 :: FilePath -> Doc a
toFileEntry FilePath
fp = case FilePath -> Maybe Text
getMimeType FilePath
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", FilePath -> Text
T.pack FilePath
fp)
                                     ,(Text
"manifest:version", Text
"1.2")
                                     ]
  let files :: [FilePath]
files = [ FilePath
ent | FilePath
ent <- Archive -> [FilePath]
filesInArchive Archive
archive,
                             Bool -> Bool
not (FilePath
"META-INF" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
ent) ]
  let formulas :: [FilePath]
formulas = [ FilePath -> FilePath
takeDirectory FilePath
ent FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" | FilePath
ent <- Archive -> [FilePath]
filesInArchive Archive
archive,
                      FilePath
"Formula-" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
ent, FilePath -> FilePath
takeExtension FilePath
ent FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".xml" ]
  let manifestEntry :: Entry
manifestEntry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"META-INF/manifest.xml" Integer
epochtime
        (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromStringLazy (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc FilePath -> FilePath
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing
        (Doc FilePath -> FilePath) -> Doc FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc FilePath
forall a. HasChars a => FilePath -> Doc a
text FilePath
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
        Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
         Bool -> Text -> [(Text, Text)] -> Doc FilePath -> Doc FilePath
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")] ( Text -> [(Text, Text)] -> Doc FilePath
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
"/")]
                Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$ [Doc FilePath] -> Doc FilePath
forall a. [Doc a] -> Doc a
vcat ( (FilePath -> Doc FilePath) -> [FilePath] -> [Doc FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc FilePath
forall a. HasChars a => FilePath -> Doc a
toFileEntry [FilePath]
files )
                Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$ [Doc FilePath] -> Doc FilePath
forall a. [Doc a] -> Doc a
vcat ( (FilePath -> Doc FilePath) -> [FilePath] -> [Doc FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc FilePath
forall a. HasChars a => FilePath -> Doc a
toFileEntry [FilePath]
formulas )
              )
  let archive' :: Archive
archive' = Entry -> Archive -> Archive
addEntryToArchive Entry
manifestEntry Archive
archive
  -- create meta.xml
  let userDefinedMetaFields :: [Text]
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 :: Text -> Doc FilePath
escapedText = FilePath -> Doc FilePath
forall a. HasChars a => FilePath -> Doc a
text (FilePath -> Doc FilePath)
-> (Text -> FilePath) -> Text -> Doc FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
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) -> (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 :: [Doc FilePath]
userDefinedMeta =
        (Text -> Doc FilePath) -> [Text] -> [Doc FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> Bool -> Text -> [(Text, Text)] -> Doc FilePath -> Doc FilePath
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 FilePath
escapedText (Text -> Doc FilePath) -> Text -> Doc FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
lookupMetaString Text
k Meta
meta)) [Text]
userDefinedMetaFields
  let metaTag :: Text -> Text -> Doc FilePath
metaTag Text
metafield = Text -> Doc FilePath -> Doc FilePath
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
metafield (Doc FilePath -> Doc FilePath)
-> (Text -> Doc FilePath) -> Text -> Doc FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc FilePath
escapedText
  let metaEntry :: Entry
metaEntry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"meta.xml" Integer
epochtime
       (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromStringLazy (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc FilePath -> FilePath
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing
       (Doc FilePath -> FilePath) -> Doc FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc FilePath
forall a. HasChars a => FilePath -> Doc a
text FilePath
"<?xml version=\"1.0\" encoding=\"utf-8\"?>"
       Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
        Bool -> Text -> [(Text, Text)] -> Doc FilePath -> Doc FilePath
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")] ( Bool -> Text -> [(Text, Text)] -> Doc FilePath -> Doc FilePath
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"office:meta" []
                 ( Text -> Text -> Doc FilePath
metaTag Text
"meta:generator" (Text
"Pandoc/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pandocVersion)
                   Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc FilePath
metaTag Text
"dc:title" ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
title)
                   Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc FilePath
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 FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc FilePath
metaTag Text
"dc:subject" (Text -> Meta -> Text
lookupMetaString Text
"subject" Meta
meta)
                   Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Text -> Doc FilePath
metaTag Text
"meta:keyword" (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
keywords)
                   Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   case Maybe Lang
lang of
                        Just Lang
l  -> Text -> Text -> Doc FilePath
metaTag Text
"dc:language" (Lang -> Text
renderLang Lang
l)
                        Maybe Lang
Nothing -> Doc FilePath
forall a. Doc a
empty
                   Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   (\Text
d Text
a -> Text -> Text -> Doc FilePath
metaTag Text
"meta:initial-creator" Text
a
                         Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc FilePath
metaTag Text
"dc:creator" Text
a
                         Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc FilePath
metaTag Text
"meta:creation-date" Text
d
                         Doc FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Text -> Doc FilePath
metaTag Text
"dc:date" Text
d
                   ) (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%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 FilePath -> Doc FilePath -> Doc FilePath
forall a. Doc a -> Doc a -> Doc a
$$
                   [Doc FilePath] -> Doc FilePath
forall a. [Doc a] -> Doc a
vcat [Doc FilePath]
userDefinedMeta
                 )
             )
  -- make sure mimetype is first
  let mimetypeEntry :: Entry
mimetypeEntry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"mimetype" Integer
epochtime
                      (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
fromStringLazy FilePath
"application/vnd.oasis.opendocument.text"
  Archive
archive'' <- Maybe Lang -> Archive -> StateT ODTState m Archive
forall (m :: * -> *).
PandocMonad m =>
Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Maybe Lang
lang
                  (Archive -> StateT ODTState m Archive)
-> Archive -> StateT ODTState m Archive
forall a b. (a -> b) -> a -> b
$ Entry -> Archive -> Archive
addEntryToArchive Entry
mimetypeEntry
                  (Archive -> Archive) -> Archive -> Archive
forall a b. (a -> b) -> a -> b
$ Entry -> Archive -> Archive
addEntryToArchive Entry
metaEntry Archive
archive'
  ByteString -> O m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> O m ByteString) -> ByteString -> O m ByteString
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive''

updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive
updateStyleWithLang :: Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Maybe Lang
Nothing Archive
arch = Archive -> O m Archive
forall (m :: * -> *) a. Monad m => a -> m a
return Archive
arch
updateStyleWithLang (Just Lang
lang) Archive
arch = do
  Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> StateT ODTState m POSIXTime -> StateT ODTState m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m POSIXTime -> StateT ODTState m POSIXTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
P.getPOSIXTime
  Archive -> O m Archive
forall (m :: * -> *) a. Monad m => a -> m a
return Archive
arch{ zEntries :: [Entry]
zEntries = [if Entry -> FilePath
eRelativePath Entry
e FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"styles.xml"
                              then case FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc
                                      (ByteString -> FilePath
toStringLazy (Entry -> ByteString
fromEntry Entry
e)) of
                                      Maybe Element
Nothing -> Entry
e
                                      Just Element
d ->
                                        FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"styles.xml" Integer
epochtime
                                        ( FilePath -> ByteString
fromStringLazy
                                        (FilePath -> ByteString)
-> (Element -> FilePath) -> Element -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> FilePath
ppTopElement
                                        (Element -> FilePath)
-> (Element -> Element) -> Element -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Element -> Element
addLang Lang
lang (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ Element
d )
                              else Entry
e
                            | Entry
e <- Archive -> [Entry]
zEntries Archive
arch] }

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 FilePath
"language" Maybe FilePath
_ (Just FilePath
"fo")) FilePath
_)
                           = QName -> FilePath -> Attr
Attr QName
n (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Lang -> Text
langLanguage Lang
lang)
          updateLangAttr (Attr n :: QName
n@(QName FilePath
"country" Maybe FilePath
_ (Just FilePath
"fo")) FilePath
_)
                           = QName -> FilePath -> Attr
Attr QName
n (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Lang -> Text
langRegion Lang
lang)
          updateLangAttr Attr
x = Attr
x

-- | transform both Image and Math elements
transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline
transformPicMath :: WriterOptions -> Inline -> O m Inline
transformPicMath WriterOptions
opts (Image attr :: Attr
attr@(Text
id', [Text]
cls, [(Text, Text)]
_) [Inline]
lab (Text
src,Text
t)) = O m Inline -> (PandocError -> O m Inline) -> O m Inline
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
   (do (ByteString
img, Maybe Text
mbMimeType) <- Text -> StateT ODTState m (ByteString, Maybe Text)
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  -> (Double, Double) -> StateT ODTState m (Double, Double)
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 (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", 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 :: Attr
newattr = (Text
id', [Text]
cls, [(Text, Text)]
dims)
       [Entry]
entries <- (ODTState -> [Entry]) -> StateT ODTState m [Entry]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ODTState -> [Entry]
stEntries
       let extension :: FilePath
extension = FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> FilePath
takeExtension (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'?') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
src) Text -> FilePath
T.unpack
                           (Maybe Text
mbMimeType Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType)
       let newsrc :: FilePath
newsrc = FilePath
"Pictures/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([Entry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entry]
entries) FilePath -> FilePath -> FilePath
<.> FilePath
extension
       let toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
       Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> StateT ODTState m POSIXTime -> StateT ODTState m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m POSIXTime -> StateT ODTState m POSIXTime
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 entry :: Entry
entry = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
newsrc Integer
epochtime (ByteString -> Entry) -> ByteString -> Entry
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toLazy ByteString
img
       (ODTState -> ODTState) -> StateT ODTState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ODTState -> ODTState) -> StateT ODTState m ())
-> (ODTState -> ODTState) -> StateT ODTState m ()
forall a b. (a -> b) -> a -> b
$ \ODTState
st -> ODTState
st{ stEntries :: [Entry]
stEntries = Entry
entry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: [Entry]
entries }
       Inline -> O m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> O m Inline) -> Inline -> O m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
newattr [Inline]
lab (FilePath -> Text
T.pack FilePath
newsrc, Text
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
$ FilePath -> Text
T.pack (PandocError -> FilePath
forall a. Show a => a -> FilePath
show PandocError
e)
       Inline -> O m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> O m Inline) -> Inline -> O m Inline
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Emph [Inline]
lab)

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

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

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