99be906 · typeable/pandoc

git.iko.soy/typeable/pandoc

Added PandocHttpException, trap exceptions in fetching from URLs.

Closes #3646.

commit99be906101f7852e84e5da9c3b66dd6d99f649da authorJohn MacFarlane <jgm@berkeley.edu> dateSun 7 May 2017, 13:11 (10 years ago) parentd414b25

4 files changed+26−9

compare with master

unifiedsplit

src/Text/Pandoc/App.hs+13−4 src/Text/Pandoc/Class.hs+4−1 src/Text/Pandoc/Error.hs+4 src/Text/Pandoc/Shared.hs+5−4

src/Text/Pandoc/App.hs+13−4

@@ -376,7 +376,7 @@ convertWithOpts opts = do

376376 then 0

377377 else optTabStop opts)

378378

379− readSources :: (Functor m, MonadIO m) => [FilePath] -> m String

379+ readSources :: [FilePath] -> PandocIO String

380380 readSources srcs = convertTabs . intercalate "\n" <$>

381381 mapM readSource srcs

382382

@@ -751,6 +751,11 @@ fillMedia sourceURL d = walkM handleImage d

751751 "replacing image with description"

752752 -- emit alt text

753753 return $ Span ("",["image"],[]) lab

754+ PandocHttpError u er -> do

755+ report $ CouldNotFetchResource u

756+ (show er ++ "\rReplacing image with description.")

757+ -- emit alt text

758+ return $ Span ("",["image"],[]) lab

754759 _ -> throwError e)

755760 handleImage x = return x

756761

@@ -800,7 +805,7 @@ applyFilters mbDatadir filters args d = do

800805 expandedFilters <- mapM (expandFilterPath mbDatadir) filters

801806 foldrM ($) d $ map (flip externalFilter args) expandedFilters

802807

803−readSource :: MonadIO m => FilePath -> m String

808+readSource :: FilePath -> PandocIO String

804809readSource "-" = liftIO UTF8.getContents

805810readSource src = case parseURI src of

806811 Just u | uriScheme u `elem` ["http:","https:"] ->

@@ -809,8 +814,12 @@ readSource src = case parseURI src of

809814 liftIO $ UTF8.readFile (uriPath u)

810815 _ -> liftIO $ UTF8.readFile src

811816

812−readURI :: MonadIO m => FilePath -> m String

813−readURI src = liftIO $ (UTF8.toString . fst) <$> openURL src

817+readURI :: FilePath -> PandocIO String

818+readURI src = do

819+ res <- liftIO $ openURL src

820+ case res of

821+ Left e -> throwError $ PandocHttpError src e

822+ Right (contents, _) -> return $ UTF8.toString contents

814823

815824readFile' :: MonadIO m => FilePath -> m B.ByteString

816825readFile' "-" = liftIO B.getContents

src/Text/Pandoc/Class.hs+4−1

@@ -242,7 +242,10 @@ instance PandocMonad PandocIO where

242242 newUniqueHash = hashUnique <$> (liftIO IO.newUnique)

243243 openURL u = do

244244 report $ Fetching u

245− liftIOError IO.openURL u

245+ res <- liftIO (IO.openURL u)

246+ case res of

247+ Right r -> return r

248+ Left e -> throwError $ PandocHttpError u e

246249 readFileLazy s = liftIOError BL.readFile s

247250 readFileStrict s = liftIOError B.readFile s

248251 readDataFile mfp fname = liftIOError (IO.readDataFile mfp) fname

src/Text/Pandoc/Error.hs+4

@@ -42,10 +42,12 @@ import Text.Parsec.Pos hiding (Line)

4242import qualified Text.Pandoc.UTF8 as UTF8

4343import System.Exit (exitWith, ExitCode(..))

4444import System.IO (stderr)

45+import Network.HTTP.Client (HttpException)

4546

4647type Input = String

4748

4849data PandocError = PandocIOError String IOError

50+ | PandocHttpError String HttpException

4951 | PandocShouldNeverHappenError String

5052 | PandocSomeError String

5153 | PandocParseError String

@@ -70,6 +72,8 @@ handleError (Right r) = return r

7072handleError (Left e) =

7173 case e of

7274 PandocIOError _ err' -> ioError err'

75+ PandocHttpError u err' -> err 61 $

76+ "Could not fetch " ++ u ++ "\n" ++ show err'

7377 PandocShouldNeverHappenError s -> err 62 s

7478 PandocSomeError s -> err 63 s

7579 PandocParseError s -> err 64 s

src/Text/Pandoc/Shared.hs+5−4

@@ -141,7 +141,8 @@ import Text.Pandoc.Data (dataFiles)

141141import Paths_pandoc (getDataFileName)

142142#endif

143143import Network.HTTP.Client (httpLbs, responseBody, responseHeaders,

144− Request(port,host,requestHeaders))

144+ Request(port,host,requestHeaders),

145+ HttpException)

145146import Network.HTTP.Client (parseRequest)

146147import Network.HTTP.Client (newManager)

147148import Network.HTTP.Client.Internal (addProxy)

@@ -702,13 +703,13 @@ readDataFileUTF8 userDir fname =

702703 UTF8.toString `fmap` readDataFile userDir fname

703704

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

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

706+openURL :: String -> IO (Either HttpException (BS.ByteString, Maybe MimeType))

706707openURL u

707708 | Just u'' <- stripPrefix "data:" u =

708709 let mime = takeWhile (/=',') u''

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

710− in return (decodeLenient contents, Just mime)

711− | otherwise = withSocketsDo $ do

711+ in return $ Right (decodeLenient contents, Just mime)

712+ | otherwise = E.try $ withSocketsDo $ do

712713 let parseReq = parseRequest

713714 (proxy :: Either IOError String) <-

714715 tryIOError $ getEnv "http_proxy"