From 449ddeb53b9bc2ca28deaedf03a4ea78d9e0d53c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 11 Jan 2013 16:19:06 -0800 Subject: Refactoring: * Shared now exports fetchItem (instead of getItem) and openURL * fetchItem has different parameters than getItem and includes some logic formerly in the ODT and Docx writers * getItem still used in SelfContained --- src/Text/Pandoc/SelfContained.hs | 18 ++++++++++++++++-- src/Text/Pandoc/Shared.hs | 29 +++++++++++++++++------------ src/Text/Pandoc/Writers/Docx.hs | 10 ++-------- src/Text/Pandoc/Writers/EPUB.hs | 1 + src/Text/Pandoc/Writers/ODT.hs | 16 +++++----------- 5 files changed, 41 insertions(+), 33 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index c02e61ba9..780d2de33 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -36,12 +36,14 @@ import Network.URI (isAbsoluteURI, escapeURIString) import Data.ByteString.Base64 import qualified Data.ByteString.Char8 as B import Data.ByteString (ByteString) -import System.FilePath (takeExtension, takeDirectory, ()) +import System.FilePath (takeExtension, dropExtension, takeDirectory, ()) import Data.Char (toLower, isAscii, isAlphaNum) import Codec.Compression.GZip as Gzip import qualified Data.ByteString.Lazy as L -import Text.Pandoc.Shared (renderTags', getItem) +import Text.Pandoc.Shared (renderTags', openURL, readDataFile) import Text.Pandoc.UTF8 (toString, fromString) +import Text.Pandoc.MIME (getMimeType) +import System.Directory (doesFileExist) isOk :: Char -> Bool isOk c = isAscii c && isAlphaNum c @@ -97,6 +99,18 @@ cssURLs userdata d orig = ";base64," `B.append` (encode raw) return $ x `B.append` "url(" `B.append` enc `B.append` rest +getItem :: Maybe FilePath -> String -> IO (ByteString, Maybe String) +getItem userdata f = + if isAbsoluteURI f + then openURL f + else do + let mime = case takeExtension f of + ".gz" -> getMimeType $ dropExtension f + x -> getMimeType x + exists <- doesFileExist f + cont <- if exists then B.readFile f else readDataFile userdata f + return (cont, mime) + getRaw :: Maybe FilePath -> String -> String -> IO (ByteString, String) getRaw userdata mimetype src = do let ext = map toLower $ takeExtension src diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 15af4cc33..26b0e1b1d 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -67,7 +67,8 @@ module Text.Pandoc.Shared ( inDirectory, readDataFile, readDataFileUTF8, - getItem, + fetchItem, + openURL, -- * Error handling err, warn, @@ -545,20 +546,24 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String readDataFileUTF8 userDir fname = UTF8.toString `fmap` readDataFile userDir fname -getItem :: Maybe FilePath -> String -> IO (B.ByteString, Maybe String) -getItem userdata f = - if isAbsoluteURI f - then openURL f - else do - let mime = case takeExtension f of - ".gz" -> getMimeType $ dropExtension f - x -> getMimeType x - exists <- doesFileExist f - cont <- if exists then B.readFile f else readDataFile userdata f - return (cont, mime) +-- | Fetch an image or other item from the local filesystem or the net. +-- Returns raw content and maybe mime type. +fetchItem :: String -> String -> IO (B.ByteString, Maybe String) +fetchItem sourceDir s = + case s of + _ | isAbsoluteURI s -> openURL s + | isAbsoluteURI sourceDir -> openURL $ sourceDir ++ "/" ++ s + | otherwise -> do + let mime = case takeExtension s of + ".gz" -> getMimeType $ dropExtension s + x -> getMimeType x + let f = sourceDir s + cont <- B.readFile f + return (cont, mime) -- TODO - have this return mime type too - then it can work for google -- chart API, e.g. +-- | Read from a URL and return raw data and maybe mime type. openURL :: String -> IO (B.ByteString, Maybe String) openURL u = getBodyAndMimeType =<< simpleHTTP (getReq u) where getReq v = case parseURI v of diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index e8d49ead0..577f9fc84 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -52,8 +52,6 @@ import Data.Unique (hashUnique, newUnique) import System.Random (randomRIO) import Text.Printf (printf) import qualified Control.Exception as E -import Network.URI (isAbsoluteURI) -import System.FilePath (()) data WriterState = WriterState{ stTextProperties :: [Element] @@ -627,14 +625,10 @@ inlineToOpenXML opts (Image alt (src, tit)) = do Just (_,_,elt,_) -> return [elt] Nothing -> do let sourceDir = writerSourceDirectory opts - let src' = case src of - s | isAbsoluteURI s -> s - | isAbsoluteURI sourceDir -> sourceDir ++ "/" ++ s - | otherwise -> sourceDir s - res <- liftIO $ E.try $ getItem Nothing src' + res <- liftIO $ E.try $ fetchItem sourceDir src case res of Left (_ :: E.SomeException) -> do - liftIO $ warn $ "Could not find image `" ++ src' ++ "', skipping..." + liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." -- emit alt text inlinesToOpenXML opts alt Right (img, _) -> do diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 493b762ac..8a020002e 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -107,6 +107,7 @@ writeEPUB opts doc@(Pandoc meta _) = do Pandoc _ blocks <- bottomUpM (transformInlines (writerHTMLMathMethod opts') sourceDir picsRef) doc pics <- readIORef picsRef + -- TODO make this work with URLs: let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e -> return e{ eRelativePath = newsrc } picEntries <- mapM readPicEntry pics diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 8bae293c4..dac718ac8 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -31,12 +31,11 @@ Conversion of 'Pandoc' documents to ODT. module Text.Pandoc.Writers.ODT ( writeODT ) where import Data.IORef import Data.List ( isPrefixOf ) -import System.FilePath ( takeExtension, () ) import qualified Data.ByteString.Lazy as B import Text.Pandoc.UTF8 ( fromStringLazy ) import Codec.Archive.Zip import Text.Pandoc.Options ( WriterOptions(..) ) -import Text.Pandoc.Shared ( stringify, readDataFile, getItem, warn ) +import Text.Pandoc.Shared ( stringify, readDataFile, fetchItem, warn ) import Text.Pandoc.ImageSize ( imageSize, sizeInPoints ) import Text.Pandoc.MIME ( getMimeType ) import Text.Pandoc.Definition @@ -44,11 +43,11 @@ import Text.Pandoc.Generic import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) import Control.Monad (liftM) import Control.Monad.Trans (liftIO) -import Network.URI ( unEscapeString, isAbsoluteURI ) import Text.Pandoc.XML import Text.Pandoc.Pretty import qualified Control.Exception as E import Data.Time.Clock.POSIX ( getPOSIXTime ) +import System.FilePath ( takeExtension ) -- | Produce an ODT file from a Pandoc document. writeODT :: WriterOptions -- ^ Writer options @@ -114,25 +113,20 @@ writeODT opts doc@(Pandoc (Meta title _ _) _) = do transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline transformPic sourceDir entriesRef (Image lab (src,_)) = do - let src' = case unEscapeString src of - s | isAbsoluteURI s -> s - | isAbsoluteURI sourceDir -> sourceDir ++ "/" ++ s - | otherwise -> sourceDir s - res <- liftIO $ E.try $ getItem Nothing src' + res <- liftIO $ E.try $ fetchItem sourceDir src case res of Left (_ :: E.SomeException) -> do - liftIO $ warn $ "Could not find image `" ++ src' ++ "', skipping..." + liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." return $ Emph lab Right (img, _) -> do let size = imageSize img let (w,h) = maybe (0,0) id $ sizeInPoints `fmap` size let tit' = show w ++ "x" ++ show h entries <- readIORef entriesRef - let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src' + let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src let toLazy = B.fromChunks . (:[]) epochtime <- floor `fmap` getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img - -- insert into entriesRef: sourceDir src', eRelativePath = newsrc modifyIORef entriesRef (entry:) return $ Image lab (newsrc, tit') transformPic _ _ x = return x -- cgit v1.2.3