diff options
author | dr@jones.dk <dr@jones.dk> | 2010-07-31 00:15:41 +0200 |
---|---|---|
committer | dr@jones.dk <dr@jones.dk> | 2010-07-31 00:15:41 +0200 |
commit | 1f6b4aee268fefc72c84bd305b10d4f9103901eb (patch) | |
tree | 06068a6ea16e5fcd9fce72d04c15a69089f85694 /src/Text/Pandoc/ODT.hs | |
parent | c5408a001e497aed5733e00346bcba7e06cb65ba (diff) |
Imported Upstream version 1.6
Diffstat (limited to 'src/Text/Pandoc/ODT.hs')
-rw-r--r-- | src/Text/Pandoc/ODT.hs | 102 |
1 files changed, 0 insertions, 102 deletions
diff --git a/src/Text/Pandoc/ODT.hs b/src/Text/Pandoc/ODT.hs deleted file mode 100644 index d978c0cb4..000000000 --- a/src/Text/Pandoc/ODT.hs +++ /dev/null @@ -1,102 +0,0 @@ -{- -Copyright (C) 2008-2010 John MacFarlane <jgm@berkeley.edu> - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{- | - Module : Text.Pandoc.ODT - Copyright : Copyright (C) 2008-2010 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <jgm@berkeley.edu> - Stability : alpha - Portability : portable - -Functions for producing an ODT file from OpenDocument XML. --} -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) - --- | Produce an ODT file from OpenDocument XML. -saveOpenDocumentAsODT :: Maybe FilePath -- ^ Path of user data directory - -> FilePath -- ^ Pathname of ODT file to be produced - -> FilePath -- ^ Relative directory of source file - -> Maybe FilePath -- ^ Path specified by --reference-odt - -> String -- ^ OpenDocument XML contents - -> 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 - -- handle pictures - 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 -- ^ Relative directory of source file - -> (FilePath, String) -- ^ Path and new path of picture - -> 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 - -- get a unique name - 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 ++ "\"" |