diff options
author | John MacFarlane <jgm@berkeley.edu> | 2016-12-12 13:51:20 +0100 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2017-01-25 17:07:42 +0100 |
commit | 6aff97e4e16b3829151a5e84b63a0aee26ea8511 (patch) | |
tree | bdab822f07f9d868ab8714dc8a392f48278b8d6e /src | |
parent | 4cb124d147790814cf2055afdfd17e500cece559 (diff) | |
download | pandoc-6aff97e4e16b3829151a5e84b63a0aee26ea8511.tar.gz |
Text.Pandoc.Shared: Removed fetchItem, fetchItem'.
Made changes where these are used, so that the version
of fetchItem from PandocMonad can be used instead.
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/PDF.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/SelfContained.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 69 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 33 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/FB2.hs | 18 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ICML.hs | 8 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 7 |
9 files changed, 58 insertions, 108 deletions
diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 348f6a2fe..68151f569 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -49,8 +49,7 @@ import Data.Maybe (fromMaybe) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Definition import Text.Pandoc.Walk (walkM) -import Text.Pandoc.Shared (fetchItem', warn, withTempDir, inDirectory, - stringify) +import Text.Pandoc.Shared (warn, withTempDir, inDirectory, stringify) import Text.Pandoc.Writers.Shared (getField, metaToJSON) import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..)) import Text.Pandoc.MIME (extensionFromMimeType, getMimeType) @@ -61,7 +60,7 @@ import qualified Codec.Picture as JP #ifdef _WINDOWS import Data.List (intercalate) #endif -import Text.Pandoc.Class (PandocIO, runIOorExplode) +import Text.Pandoc.Class (PandocIO, runIOorExplode, fetchItem, setMediaBag, runIO) #ifdef _WINDOWS changePathSeparators :: FilePath -> FilePath @@ -123,7 +122,9 @@ handleImage' opts tmpdir (Image attr ils (src,tit)) = do if exists then return $ Image attr ils (src,tit) else do - res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src + res <- runIO $ do + setMediaBag $ writerMediaBag opts + fetchItem (writerSourceURL opts) src case res of Right (contents, Just mime) -> do let ext = fromMaybe (takeExtension src) $ diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index 6bcdc8728..176de99be 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -41,7 +41,7 @@ import Data.Char (toLower, isAscii, isAlphaNum) import Codec.Compression.GZip as Gzip import qualified Data.ByteString.Lazy as L import Control.Monad.Trans (MonadIO(..)) -import Text.Pandoc.Shared (renderTags', err, fetchItem', warn, trim) +import Text.Pandoc.Shared (renderTags', err, warn, trim) import Text.Pandoc.MediaBag (MediaBag) import Text.Pandoc.MIME (MimeType) import Text.Pandoc.UTF8 (toString) @@ -51,6 +51,7 @@ import Control.Applicative ((<|>)) import Text.Parsec (runParserT, ParsecT) import qualified Text.Parsec as P import Control.Monad.Trans (lift) +import Text.Pandoc.Class (fetchItem, runIO, setMediaBag) isOk :: Char -> Bool isOk c = isAscii c && isAlphaNum c @@ -144,7 +145,8 @@ getDataURI :: MediaBag -> Maybe String -> MimeType -> String getDataURI _ _ _ src@('d':'a':'t':'a':':':_) = return src -- already data: uri getDataURI media sourceURL mimetype src = do let ext = map toLower $ takeExtension src - fetchResult <- fetchItem' media sourceURL src + fetchResult <- runIO $ do setMediaBag media + fetchItem sourceURL src (raw, respMime) <- case fetchResult of Left msg -> err 67 $ "Could not fetch " ++ src ++ "\n" ++ show msg diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 0ff30dcce..fabda42ed 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -79,8 +79,6 @@ module Text.Pandoc.Shared ( getDefaultReferenceODT, readDataFile, readDataFileUTF8, - fetchItem, - fetchItem', openURL, collapseFilePath, filteredFilesFromArchive, @@ -100,7 +98,6 @@ module Text.Pandoc.Shared ( import Text.Pandoc.Definition import Text.Pandoc.Walk -import Text.Pandoc.MediaBag (MediaBag, lookupMedia) import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..)) import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.UTF8 as UTF8 @@ -111,15 +108,13 @@ import Data.List ( find, stripPrefix, intercalate ) import Data.Maybe (mapMaybe) import Data.Version ( showVersion ) import qualified Data.Map as M -import Network.URI ( escapeURIString, nonStrictRelativeTo, - unEscapeString, parseURIReference, isAllowedInURI, - parseURI, URI(..) ) +import Network.URI ( escapeURIString, unEscapeString ) import qualified Data.Set as Set import System.Directory import System.FilePath (splitDirectories, isPathSeparator) import qualified System.FilePath.Posix as Posix -import Text.Pandoc.MIME (MimeType, getMimeType) -import System.FilePath ( (</>), takeExtension, dropExtension) +import Text.Pandoc.MIME (MimeType) +import System.FilePath ( (</>) ) import Data.Generics (Typeable, Data) import qualified Control.Monad.State as S import Control.Monad.Trans (MonadIO (..)) @@ -752,64 +747,6 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String readDataFileUTF8 userDir fname = UTF8.toString `fmap` readDataFile userDir fname --- | Specialized version of parseURIReference that disallows --- single-letter schemes. Reason: these are usually windows absolute --- paths. -parseURIReference' :: String -> Maybe URI -parseURIReference' s = - case parseURIReference s of - Just u - | length (uriScheme u) > 2 -> Just u - | null (uriScheme u) -> Just u -- protocol-relative - _ -> Nothing - --- | Fetch an image or other item from the local filesystem or the net. --- Returns raw content and maybe mime type. -fetchItem :: Maybe String -> String - -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) -fetchItem sourceURL s = - case (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped s) of - (Just u, s') -> -- try fetching from relative path at source - case parseURIReference' s' of - Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u - Nothing -> openURL s' -- will throw error - (Nothing, s'@('/':'/':_)) -> -- protocol-relative URI - case parseURIReference' s' of - Just u' -> openURL $ show $ u' `nonStrictRelativeTo` httpcolon - Nothing -> openURL s' -- will throw error - (Nothing, s') -> - case parseURI s' of -- requires absolute URI - -- We don't want to treat C:/ as a scheme: - Just u' | length (uriScheme u') > 2 -> openURL (show u') - Just u' | uriScheme u' == "file:" -> - E.try $ readLocalFile $ dropWhile (=='/') (uriPath u') - _ -> E.try $ readLocalFile fp -- get from local file system - where readLocalFile f = do - cont <- BS.readFile f - return (cont, mime) - httpcolon = URI{ uriScheme = "http:", - uriAuthority = Nothing, - uriPath = "", - uriQuery = "", - uriFragment = "" } - dropFragmentAndQuery = takeWhile (\c -> c /= '?' && c /= '#') - fp = unEscapeString $ dropFragmentAndQuery s - mime = case takeExtension fp of - ".gz" -> getMimeType $ dropExtension fp - ".svgz" -> getMimeType $ dropExtension fp ++ ".svg" - x -> getMimeType x - ensureEscaped = escapeURIString isAllowedInURI . map convertSlash - convertSlash '\\' = '/' - convertSlash x = x - --- | Like 'fetchItem', but also looks for items in a 'MediaBag'. -fetchItem' :: MediaBag -> Maybe String -> String - -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) -fetchItem' media sourceURL s = do - case lookupMedia s media of - Nothing -> fetchItem sourceURL s - Just (mime, bs) -> return $ Right (BS.concat $ toChunks bs, Just mime) - -- | Read from a URL and return raw data and maybe mime type. openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) openURL u diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 163b2f3af..25e224a7a 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -48,6 +48,7 @@ import Text.Pandoc.Options import Text.Pandoc.Writers.Math import Text.Pandoc.Highlighting ( highlight ) import Text.Pandoc.Walk +import Text.Pandoc.Error (PandocError) import Text.XML.Light as XML import Text.TeXMath import Text.Pandoc.Readers.Docx.StyleMap @@ -55,9 +56,9 @@ import Text.Pandoc.Readers.Docx.Util (elemName) import Control.Monad.Reader import Control.Monad.State import Skylighting +import Control.Monad.Except (runExceptT) import System.Random (randomR) import Text.Printf (printf) -import qualified Control.Exception as E import Data.Monoid ((<>)) import qualified Data.Text as T import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, @@ -1180,10 +1181,10 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do case M.lookup src imgs of Just (_,_,_,elt,_) -> return [elt] Nothing -> do - res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src + res <- runExceptT $ lift (P.fetchItem (writerSourceURL opts) src) case res of - Left (_ :: E.SomeException) -> do - (lift . lift) $ P.warning ("Could not find image `" ++ src ++ "', skipping...") + Left (_ :: PandocError) -> do + P.warning ("Could not find image `" ++ src ++ "', skipping...") -- emit alt text inlinesToOpenXML opts alt Right (img, mt) -> do diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 1c3a44207..d6c3ff533 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -64,7 +64,7 @@ import Data.Char ( toLower, isDigit, isAlphaNum ) import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType) import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags) -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, catchError) import Text.Pandoc.Error import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as P @@ -858,23 +858,20 @@ modifyMediaRef opts oldsrc = do media <- gets stMediaPaths case lookup oldsrc media of Just (n,_) -> return n - Nothing -> do - res <- lift $ P.fetchItem' (writerMediaBag opts) - (writerSourceURL opts) oldsrc - (new, mbEntry) <- - case res of - Left _ -> do - lift $ P.warning $ "Could not find media `" ++ oldsrc ++ "', skipping..." - return (oldsrc, Nothing) - Right (img,mbMime) -> do - let new = "media/file" ++ show (length media) ++ - fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) - (('.':) <$> (mbMime >>= extensionFromMimeType)) - epochtime <- floor `fmap` lift P.getPOSIXTime - let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img - return (new, Just entry) - modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media} - return new + Nothing -> catchError + (do (img, mbMime) <- P.fetchItem (writerSourceURL opts) oldsrc + let new = "media/file" ++ show (length media) ++ + fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) + (('.':) <$> (mbMime >>= extensionFromMimeType)) + epochtime <- floor `fmap` lift P.getPOSIXTime + let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img + modify $ \st -> st{ stMediaPaths = + (oldsrc, (new, Just entry)):media} + return new) + (\e -> do + P.warning $ "Could not find media `" ++ oldsrc ++ + "', skipping...\n" ++ show e + return oldsrc) transformBlock :: PandocMonad m => WriterOptions diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 20af67b62..7baac4f9e 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -39,7 +39,7 @@ import Text.XML.Light import qualified Text.XML.Light as X import qualified Text.XML.Light.Cursor as XC import qualified Data.ByteString.Char8 as B8 -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, catchError) import Text.Pandoc.Definition @@ -241,10 +241,18 @@ fetchImage href link = do else return Nothing (True, Just _) -> return Nothing -- not base64-encoded _ -> do - response <- P.fetchItem Nothing link - case response of - Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs) - _ -> return $ Nothing + catchError (do (bs, mbmime) <- P.fetchItem Nothing link + case mbmime of + Nothing -> do + P.warning ("Could not determine mime type for " + ++ link) + return Nothing + Just mime -> return $ Just (mime, + B8.unpack $ encode bs)) + (\e -> + do P.warning ("Could not fetch " ++ link ++ + ":\n" ++ show e) + return Nothing) case mbimg of Just (imgtype, imgdata) -> do return . Right $ el "binary" diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 6bc7436d8..b68b9067a 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts, ScopedTypeVariables #-} {- | Module : Text.Pandoc.Writers.ICML @@ -15,6 +15,7 @@ into InDesign with File -> Place. -} module Text.Pandoc.Writers.ICML (writeICML) where import Text.Pandoc.Definition +import Text.Pandoc.Error (PandocError) import Text.Pandoc.XML import Text.Pandoc.Writers.Math (texMathToInlines) import Text.Pandoc.Writers.Shared @@ -26,6 +27,7 @@ import Text.Pandoc.ImageSize import Data.List (isPrefixOf, isInfixOf, stripPrefix, intersperse) import Data.Text as Text (breakOnAll, pack) import Control.Monad.State +import Control.Monad.Except (runExceptT) import Network.URI (isURI) import qualified Data.Set as Set import Text.Pandoc.Class (PandocMonad) @@ -534,9 +536,9 @@ styleToStrAttr style = -- | Assemble an ICML Image. imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc imageICML opts style attr (src, _) = do - res <- lift $ P.fetchItem (writerSourceURL opts) src + res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src imgS <- case res of - Left (_) -> do + Left (_ :: PandocError) -> do lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..." return def Right (img, _) -> do diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 0e4999712..5672719f9 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -45,9 +45,10 @@ import Text.Pandoc.Walk import Text.Pandoc.Writers.Shared ( fixDisplayMath ) import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) import Control.Monad.State +import Control.Monad.Except (runExceptT) +import Text.Pandoc.Error (PandocError) import Text.Pandoc.XML import Text.Pandoc.Pretty -import qualified Control.Exception as E import System.FilePath ( takeExtension, takeDirectory, (<.>)) import Text.Pandoc.Class ( PandocMonad ) import qualified Text.Pandoc.Class as P @@ -145,9 +146,9 @@ pandocToODT opts doc@(Pandoc meta _) = do -- | transform both Image and Math elements transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do - res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src + res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src case res of - Left (_ :: E.SomeException) -> do + Left (_ :: PandocError) -> do lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..." return $ Emph lab Right (img, mbMimeType) -> do diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index a3351a705..bd3461a03 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {- Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu> @@ -43,7 +44,7 @@ import qualified Data.ByteString as B import qualified Data.Map as M import Text.Printf ( printf ) import Text.Pandoc.ImageSize -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, runExceptT, lift) import Text.Pandoc.Error import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as P @@ -53,7 +54,7 @@ import qualified Text.Pandoc.Class as P -- If file not found or filetype not jpeg or png, leave the inline unchanged. rtfEmbedImage :: PandocMonad m => WriterOptions -> Inline -> m Inline rtfEmbedImage opts x@(Image attr _ (src,_)) = do - result <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src + result <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src case result of Right (imgdata, Just mime) | mime == "image/jpeg" || mime == "image/png" -> do @@ -87,7 +88,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do Right (_, Nothing) -> do warning $ "Could not determine image type for " ++ src ++ ", skipping." return x - Left e -> do + Left ( e :: PandocError ) -> do warning $ "Could not fetch image " ++ src ++ "\n" ++ show e return x rtfEmbedImage _ x = return x |