cabal: Added http-conduit flag, which allows fetching https resources.

It also brings in a large number of dependencies (http-conduit and its
dependencies), which is why for now it is an optional flag.

Closes #820.
This commit is contained in:
John MacFarlane 2013-07-04 22:40:23 -07:00
parent e7b5f2deb5
commit ed714b1b52
2 changed files with 36 additions and 12 deletions

View file

@ -224,6 +224,10 @@ Flag embed_data_files
Description: Embed data files in binary for relocatable executable. Description: Embed data files in binary for relocatable executable.
Default: False Default: False
Flag http-conduit
Description: Enable downloading of resources over https.
Default: True
Library Library
Build-Depends: base >= 4.2 && <5, Build-Depends: base >= 4.2 && <5,
syb >= 0.1 && < 0.5, syb >= 0.1 && < 0.5,
@ -262,6 +266,10 @@ Library
yaml >= 0.8.3 && < 0.9, yaml >= 0.8.3 && < 0.9,
vector >= 0.10 && < 0.11, vector >= 0.10 && < 0.11,
hslua >= 0.3 && < 0.4 hslua >= 0.3 && < 0.4
if flag(http-conduit)
Build-Depends: http-conduit >= 1.9 && < 1.10,
http-types >= 0.8 && < 0.9
cpp-options: -DHTTP_CONDUIT
if flag(embed_data_files) if flag(embed_data_files)
cpp-options: -DEMBED_DATA_FILES cpp-options: -DEMBED_DATA_FILES
-- build-tools: hsb2hs -- build-tools: hsb2hs

View file

@ -89,7 +89,7 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha,
isLetter, isDigit, isSpace ) isLetter, isDigit, isSpace )
import Data.List ( find, isPrefixOf, intercalate ) import Data.List ( find, isPrefixOf, intercalate )
import qualified Data.Map as M import qualified Data.Map as M
import Network.URI ( escapeURIString, isAbsoluteURI, parseURI, unEscapeString ) import Network.URI ( escapeURIString, isAbsoluteURI, unEscapeString )
import System.Directory import System.Directory
import Text.Pandoc.MIME (getMimeType) import Text.Pandoc.MIME (getMimeType)
import System.FilePath ( (</>), takeExtension, dropExtension ) import System.FilePath ( (</>), takeExtension, dropExtension )
@ -102,11 +102,9 @@ import Data.Time
import System.IO (stderr) import System.IO (stderr)
import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..),
renderOptions) renderOptions)
import qualified Data.ByteString as B import qualified Data.ByteString as BS
import Data.ByteString.Lazy (toChunks)
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import Network.HTTP (findHeader, rspBody,
RequestMethod(..), HeaderName(..), mkRequest)
import Network.Browser (browse, setAllowRedirects, setOutHandler, request)
#ifdef EMBED_DATA_FILES #ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles) import Text.Pandoc.Data (dataFiles)
@ -114,6 +112,16 @@ import System.FilePath ( joinPath, splitDirectories )
#else #else
import Paths_pandoc (getDataFileName) import Paths_pandoc (getDataFileName)
#endif #endif
#ifdef HTTP_CONDUIT
import Network.HTTP.Conduit (httpLbs, parseUrl, withManager,
responseBody, responseHeaders)
import Network.HTTP.Types.Header ( hContentType)
#else
import Network.URI (parseURI)
import Network.HTTP (findHeader, rspBody,
RequestMethod(..), HeaderName(..), mkRequest)
import Network.Browser (browse, setAllowRedirects, setOutHandler, request)
#endif
-- --
-- List processing -- List processing
@ -545,7 +553,7 @@ inDirectory path action = do
setCurrentDirectory oldDir setCurrentDirectory oldDir
return result return result
readDefaultDataFile :: FilePath -> IO B.ByteString readDefaultDataFile :: FilePath -> IO BS.ByteString
readDefaultDataFile fname = readDefaultDataFile fname =
#ifdef EMBED_DATA_FILES #ifdef EMBED_DATA_FILES
case lookup (makeCanonical fname) dataFiles of case lookup (makeCanonical fname) dataFiles of
@ -558,17 +566,17 @@ readDefaultDataFile fname =
go (_:as) ".." = as go (_:as) ".." = as
go as x = x : as go as x = x : as
#else #else
getDataFileName ("data" </> fname) >>= B.readFile getDataFileName ("data" </> fname) >>= BS.readFile
#endif #endif
-- | Read file from specified user data directory or, if not found there, from -- | Read file from specified user data directory or, if not found there, from
-- Cabal data directory. -- Cabal data directory.
readDataFile :: Maybe FilePath -> FilePath -> IO B.ByteString readDataFile :: Maybe FilePath -> FilePath -> IO BS.ByteString
readDataFile Nothing fname = readDefaultDataFile fname readDataFile Nothing fname = readDefaultDataFile fname
readDataFile (Just userDir) fname = do readDataFile (Just userDir) fname = do
exists <- doesFileExist (userDir </> fname) exists <- doesFileExist (userDir </> fname)
if exists if exists
then B.readFile (userDir </> fname) then BS.readFile (userDir </> fname)
else readDefaultDataFile fname else readDefaultDataFile fname
-- | Same as 'readDataFile' but returns a String instead of a ByteString. -- | Same as 'readDataFile' but returns a String instead of a ByteString.
@ -578,7 +586,7 @@ readDataFileUTF8 userDir fname =
-- | Fetch an image or other item from the local filesystem or the net. -- | Fetch an image or other item from the local filesystem or the net.
-- Returns raw content and maybe mime type. -- Returns raw content and maybe mime type.
fetchItem :: String -> String -> IO (B.ByteString, Maybe String) fetchItem :: String -> String -> IO (BS.ByteString, Maybe String)
fetchItem sourceDir s = fetchItem sourceDir s =
case s of case s of
_ | isAbsoluteURI s -> openURL s _ | isAbsoluteURI s -> openURL s
@ -588,16 +596,23 @@ fetchItem sourceDir s =
".gz" -> getMimeType $ dropExtension s ".gz" -> getMimeType $ dropExtension s
x -> getMimeType x x -> getMimeType x
let f = sourceDir </> s let f = sourceDir </> s
cont <- B.readFile f cont <- BS.readFile f
return (cont, mime) return (cont, mime)
-- | Read from a URL and return raw data and maybe mime type. -- | Read from a URL and return raw data and maybe mime type.
openURL :: String -> IO (B.ByteString, Maybe String) openURL :: String -> IO (BS.ByteString, Maybe String)
openURL u openURL u
| "data:" `isPrefixOf` u = | "data:" `isPrefixOf` u =
let mime = takeWhile (/=',') $ drop 5 u let mime = takeWhile (/=',') $ drop 5 u
contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u
in return (contents, Just mime) in return (contents, Just mime)
#ifdef HTTP_CONDUIT
| otherwise = 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 | otherwise = getBodyAndMimeType `fmap` browse
(do S.liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..." (do S.liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."
setOutHandler $ const (return ()) setOutHandler $ const (return ())
@ -609,6 +624,7 @@ openURL u
uriString) uriString)
Just v -> mkRequest GET v Just v -> mkRequest GET v
u' = escapeURIString (/= '|') u -- pipes are rejected by Network.URI u' = escapeURIString (/= '|') u -- pipes are rejected by Network.URI
#endif
-- --
-- Error reporting -- Error reporting