aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/SelfContained.hs5
-rw-r--r--src/Text/Pandoc/Shared.hs16
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs2
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs13
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs5
5 files changed, 24 insertions, 17 deletions
diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs
index c4613992a..0547bc065 100644
--- a/src/Text/Pandoc/SelfContained.hs
+++ b/src/Text/Pandoc/SelfContained.hs
@@ -40,7 +40,7 @@ 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', openURL, readDataFile)
+import Text.Pandoc.Shared (renderTags', openURL, readDataFile, err)
import Text.Pandoc.UTF8 (toString, fromString)
import Text.Pandoc.MIME (getMimeType)
import System.Directory (doesFileExist)
@@ -98,7 +98,7 @@ cssURLs userdata d orig =
getItem :: Maybe FilePath -> String -> IO (ByteString, Maybe String)
getItem userdata f =
if isAbsoluteURI f
- then openURL f
+ then openURL f >>= either handleErr return
else do
-- strip off trailing query or fragment part, if relative URL.
-- this is needed for things like cmunrm.eot?#iefix,
@@ -110,6 +110,7 @@ getItem userdata f =
exists <- doesFileExist f'
cont <- if exists then B.readFile f' else readDataFile userdata f'
return (cont, mime)
+ where handleErr e = err 61 $ "Failed to retrieve " ++ f ++ "\n" ++ show e
getRaw :: Maybe FilePath -> String -> String -> IO (ByteString, String)
getRaw userdata mimetype src = do
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 09086da1f..0f2e16d2e 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -95,6 +95,7 @@ import Text.Pandoc.MIME (getMimeType)
import System.FilePath ( (</>), takeExtension, dropExtension )
import Data.Generics (Typeable, Data)
import qualified Control.Monad.State as S
+import qualified Control.Exception as E
import Control.Monad (msum, unless)
import Text.Pandoc.Pretty (charWidth)
import System.Locale (defaultTimeLocale)
@@ -586,12 +587,13 @@ readDataFileUTF8 userDir fname =
-- | Fetch an image or other item from the local filesystem or the net.
-- Returns raw content and maybe mime type.
-fetchItem :: String -> String -> IO (BS.ByteString, Maybe String)
+fetchItem :: String -> String
+ -> IO (Either E.SomeException (BS.ByteString, Maybe String))
fetchItem sourceDir s =
case s of
_ | isAbsoluteURI s -> openURL s
| isAbsoluteURI sourceDir -> openURL $ sourceDir ++ "/" ++ s
- | otherwise -> do
+ | otherwise -> E.try $ do
let mime = case takeExtension s of
".gz" -> getMimeType $ dropExtension s
x -> getMimeType x
@@ -600,21 +602,21 @@ fetchItem sourceDir s =
return (cont, mime)
-- | Read from a URL and return raw data and maybe mime type.
-openURL :: String -> IO (BS.ByteString, Maybe String)
+openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe String))
openURL u
| "data:" `isPrefixOf` u =
let mime = takeWhile (/=',') $ drop 5 u
contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u
- in return (contents, Just mime)
+ in return $ Right (contents, Just mime)
#ifdef HTTP_CONDUIT
- | otherwise = do
+ | otherwise = E.try $ do
req <- parseUrl u
resp <- withManager $ httpLbs req
return (BS.concat $ toChunks $ responseBody resp,
UTF8.toString `fmap` lookup hContentType (responseHeaders resp))
#else
- | otherwise = getBodyAndMimeType `fmap` browse
- (do S.liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."
+ | otherwise = E.try $ getBodyAndMimeType `fmap` browse
+ (do UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."
setOutHandler $ const (return ())
setAllowRedirects True
request (getRequest' u'))
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 1ed8c2fa5..611cddc65 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -726,7 +726,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
Just (_,_,_,elt,_) -> return [elt]
Nothing -> do
let sourceDir = writerSourceDirectory opts
- res <- liftIO $ E.try $ fetchItem sourceDir src
+ res <- liftIO $ fetchItem sourceDir src
case res of
Left (_ :: E.SomeException) -> do
liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index f171a2560..42863ef86 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -123,10 +123,15 @@ writeEPUB opts doc@(Pandoc meta _) = do
Pandoc _ blocks <- bottomUpM
(transformInline opts' sourceDir picsRef) doc
pics <- readIORef picsRef
- let readPicEntry (oldsrc, newsrc) = do
- (img,_) <- fetchItem sourceDir oldsrc
- return $ toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img
- picEntries <- mapM readPicEntry pics
+ let readPicEntry entries (oldsrc, newsrc) = do
+ res <- fetchItem sourceDir oldsrc
+ case res of
+ Left e -> do
+ warn $ "Could not find image `" ++ oldsrc ++ "', skipping..."
+ return entries
+ Right (img,_) -> return $
+ (toEntry newsrc epochtime $ B.fromChunks . (:[]) $ img) : entries
+ picEntries <- foldM readPicEntry [] pics
-- handle fonts
let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index db27286e8..589010bb9 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -42,7 +42,6 @@ import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
import Control.Monad (liftM)
-import Control.Monad.Trans (liftIO)
import Text.Pandoc.XML
import Text.Pandoc.Pretty
import qualified Control.Exception as E
@@ -114,10 +113,10 @@ writeODT opts doc@(Pandoc meta _) = do
transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline
transformPic sourceDir entriesRef (Image lab (src,_)) = do
- res <- liftIO $ E.try $ fetchItem sourceDir src
+ res <- fetchItem sourceDir src
case res of
Left (_ :: E.SomeException) -> do
- liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+ warn $ "Could not find image `" ++ src ++ "', skipping..."
return $ Emph lab
Right (img, _) -> do
let size = imageSize img
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-01 03:29:01 +0000