Text.Pandoc.Shared: Removed fetchItem, fetchItem'.

Made changes where these are used, so that the version
of fetchItem from PandocMonad can be used instead.

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