7c980f3 · typeable/pandoc

git.iko.soy/typeable/pandoc

Improved fetching of external resources.

* In Shared, openURL and fetchItem now return an Either, for better error handling. (API change.) * Better error message when fetching a URL fails with `--self-contained`. * EPUB writer: If resource not found, skip it, as in Docx writer. * Closes #916.

commit7c980f39bf1cff941d3e78056fd69e0b371833e3 authorJohn MacFarlane <jgm@berkeley.edu> dateThu 18 Jul 2013, 20:58 (13 years ago) parent6c2e76a

5 files changed+24−17

compare with master

unifiedsplit

src/Text/Pandoc/SelfContained.hs+3−2 src/Text/Pandoc/Shared.hs+9−7 src/Text/Pandoc/Writers/Docx.hs+1−1 src/Text/Pandoc/Writers/EPUB.hs+9−4 src/Text/Pandoc/Writers/ODT.hs+2−3

src/Text/Pandoc/SelfContained.hs+3−2

@@ -40,7 +40,7 @@ import System.FilePath (takeExtension, dropExtension, takeDirectory, (</>))

4040import Data.Char (toLower, isAscii, isAlphaNum)

4141import Codec.Compression.GZip as Gzip

4242import qualified Data.ByteString.Lazy as L

43−import Text.Pandoc.Shared (renderTags', openURL, readDataFile)

43+import Text.Pandoc.Shared (renderTags', openURL, readDataFile, err)

4444import Text.Pandoc.UTF8 (toString, fromString)

4545import Text.Pandoc.MIME (getMimeType)

4646import System.Directory (doesFileExist)

@@ -98,7 +98,7 @@ cssURLs userdata d orig =

9898getItem :: Maybe FilePath -> String -> IO (ByteString, Maybe String)

9999getItem userdata f =

100100 if isAbsoluteURI f

101− then openURL f

101+ then openURL f >>= either handleErr return

102102 else do

103103 -- strip off trailing query or fragment part, if relative URL.

104104 -- this is needed for things like cmunrm.eot?#iefix,

@@ -110,6 +110,7 @@ getItem userdata f =

110110 exists <- doesFileExist f'

111111 cont <- if exists then B.readFile f' else readDataFile userdata f'

112112 return (cont, mime)

113+ where handleErr e = err 61 $ "Failed to retrieve " ++ f ++ "\n" ++ show e

113114

114115getRaw :: Maybe FilePath -> String -> String -> IO (ByteString, String)

115116getRaw userdata mimetype src = do

src/Text/Pandoc/Shared.hs+9−7

@@ -95,6 +95,7 @@ import Text.Pandoc.MIME (getMimeType)

9595import System.FilePath ( (</>), takeExtension, dropExtension )

9696import Data.Generics (Typeable, Data)

9797import qualified Control.Monad.State as S

98+import qualified Control.Exception as E

9899import Control.Monad (msum, unless)

99100import Text.Pandoc.Pretty (charWidth)

100101import System.Locale (defaultTimeLocale)

@@ -586,12 +587,13 @@ readDataFileUTF8 userDir fname =

586587

587588-- | Fetch an image or other item from the local filesystem or the net.

588589-- Returns raw content and maybe mime type.

589−fetchItem :: String -> String -> IO (BS.ByteString, Maybe String)

590+fetchItem :: String -> String

591+ -> IO (Either E.SomeException (BS.ByteString, Maybe String))

590592fetchItem sourceDir s =

591593 case s of

592594 _ | isAbsoluteURI s -> openURL s

593595 | isAbsoluteURI sourceDir -> openURL $ sourceDir ++ "/" ++ s

594− | otherwise -> do

596+ | otherwise -> E.try $ do

595597 let mime = case takeExtension s of

596598 ".gz" -> getMimeType $ dropExtension s

597599 x -> getMimeType x

@@ -600,21 +602,21 @@ fetchItem sourceDir s =

600602 return (cont, mime)

601603

602604-- | Read from a URL and return raw data and maybe mime type.

603−openURL :: String -> IO (BS.ByteString, Maybe String)

605+openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe String))

604606openURL u

605607 | "data:" `isPrefixOf` u =

606608 let mime = takeWhile (/=',') $ drop 5 u

607609 contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u

608− in return (contents, Just mime)

610+ in return $ Right (contents, Just mime)

609611#ifdef HTTP_CONDUIT

610− | otherwise = do

612+ | otherwise = E.try $ do

611613 req <- parseUrl u

612614 resp <- withManager $ httpLbs req

613615 return (BS.concat $ toChunks $ responseBody resp,

614616 UTF8.toString `fmap` lookup hContentType (responseHeaders resp))

615617#else

616− | otherwise = getBodyAndMimeType `fmap` browse

617− (do S.liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."

618+ | otherwise = E.try $ getBodyAndMimeType `fmap` browse

619+ (do UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."

618620 setOutHandler $ const (return ())

619621 setAllowRedirects True

620622 request (getRequest' u'))

src/Text/Pandoc/Writers/Docx.hs+1−1

@@ -726,7 +726,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do

726726 Just (_,_,_,elt,_) -> return [elt]

727727 Nothing -> do

728728 let sourceDir = writerSourceDirectory opts

729− res <- liftIO $ E.try $ fetchItem sourceDir src

729+ res <- liftIO $ fetchItem sourceDir src

730730 case res of

731731 Left (_ :: E.SomeException) -> do

732732 liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."

src/Text/Pandoc/Writers/EPUB.hs+9−4

@@ -123,10 +123,15 @@ writeEPUB opts doc@(Pandoc meta _) = do

123123 Pandoc _ blocks <- bottomUpM

124124 (transformInline opts' sourceDir picsRef) doc

125125 pics <- readIORef picsRef

126− let readPicEntry (oldsrc, newsrc) = do

127− (img,_) <- fetchItem sourceDir oldsrc

128− return $ toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img

129− picEntries <- mapM readPicEntry pics

126+ let readPicEntry entries (oldsrc, newsrc) = do

127+ res <- fetchItem sourceDir oldsrc

128+ case res of

129+ Left e -> do

130+ warn $ "Could not find image `" ++ oldsrc ++ "', skipping..."

131+ return entries

132+ Right (img,_) -> return $

133+ (toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img) : entries

134+ picEntries <- foldM readPicEntry [] pics

130135

131136 -- handle fonts

132137 let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f

src/Text/Pandoc/Writers/ODT.hs+2−3

@@ -42,7 +42,6 @@ import Text.Pandoc.Definition

4242import Text.Pandoc.Generic

4343import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )

4444import Control.Monad (liftM)

45−import Control.Monad.Trans (liftIO)

4645import Text.Pandoc.XML

4746import Text.Pandoc.Pretty

4847import qualified Control.Exception as E

@@ -114,10 +113,10 @@ writeODT opts doc@(Pandoc meta _) = do

114113

115114transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline

116115transformPic sourceDir entriesRef (Image lab (src,_)) = do

117− res <- liftIO $ E.try $ fetchItem sourceDir src

116+ res <- fetchItem sourceDir src

118117 case res of

119118 Left (_ :: E.SomeException) -> do

120− liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."

119+ warn $ "Could not find image `" ++ src ++ "', skipping..."

121120 return $ Emph lab

122121 Right (img, _) -> do

123122 let size = imageSize img