module Text.Pandoc.ODT ( saveOpenDocumentAsODT ) where
import Data.List ( find )
import System.FilePath ( (</>), takeFileName )
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.UTF8 ( fromString )
import Prelude hiding ( writeFile, readFile )
import Codec.Archive.Zip
import Control.Applicative ( (<$>) )
import Text.ParserCombinators.Parsec
import System.Time
import Paths_pandoc ( getDataFileName )
import System.Directory
import Control.Monad (liftM)
saveOpenDocumentAsODT :: Maybe FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> String
-> IO ()
saveOpenDocumentAsODT datadir destinationODTPath sourceDirRelative mbRefOdt xml = do
refArchive <- liftM toArchive $
case mbRefOdt of
Just f -> B.readFile f
Nothing -> do
let defaultODT = getDataFileName "reference.odt" >>= B.readFile
case datadir of
Nothing -> defaultODT
Just d -> do
exists <- doesFileExist (d </> "reference.odt")
if exists
then B.readFile (d </> "reference.odt")
else defaultODT
let (newContents, pics) =
case runParser pPictures [] "OpenDocument XML contents" xml of
Left err -> error $ show err
Right x -> x
picEntries <- mapM (makePictureEntry sourceDirRelative) pics
(TOD epochTime _) <- getClockTime
let contentEntry = toEntry "content.xml" epochTime $ fromString newContents
let archive = foldr addEntryToArchive refArchive (contentEntry : picEntries)
B.writeFile destinationODTPath $ fromArchive archive
makePictureEntry :: FilePath
-> (FilePath, String)
-> IO Entry
makePictureEntry sourceDirRelative (path, newPath) = do
entry <- readEntry [] $ sourceDirRelative </> path
return (entry { eRelativePath = newPath })
pPictures :: GenParser Char [(FilePath, String)] ([Char], [(FilePath, String)])
pPictures = do
contents <- concat <$> many (pPicture <|> many1 (noneOf "<") <|> string "<")
pics <- getState
return (contents, pics)
pPicture :: GenParser Char [(FilePath, String)] [Char]
pPicture = try $ do
string "<draw:image xlink:href=\""
path <- manyTill anyChar (char '"')
let filename = takeFileName path
pics <- getState
newPath <- case find (\(o, _) -> o == path) pics of
Just (_, new) -> return new
Nothing -> do
let dups = length $ (filter (\(o, _) -> takeFileName o == filename)) pics
let new = "Pictures/" ++ replicate dups '0' ++ filename
updateState ((path, new) :)
return new
return $ "<draw:image xlink:href=\"" ++ newPath ++ "\""