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:
parent
e7b5f2deb5
commit
ed714b1b52
2 changed files with 36 additions and 12 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue