diff options
-rw-r--r-- | src/Text/Pandoc/SelfContained.hs | 31 | ||||
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 30 |
2 files changed, 31 insertions, 30 deletions
diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index 4b52a6f13..c02e61ba9 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -32,42 +32,17 @@ the HTML using data URIs. -} module Text.Pandoc.SelfContained ( makeSelfContained ) where import Text.HTML.TagSoup -import Network.URI (isAbsoluteURI, parseURI, escapeURIString) -import Network.HTTP +import Network.URI (isAbsoluteURI, escapeURIString) import Data.ByteString.Base64 import qualified Data.ByteString.Char8 as B import Data.ByteString (ByteString) -import System.FilePath (takeExtension, dropExtension, takeDirectory, (</>)) +import System.FilePath (takeExtension, takeDirectory, (</>)) import Data.Char (toLower, isAscii, isAlphaNum) import Codec.Compression.GZip as Gzip import qualified Data.ByteString.Lazy as L -import Text.Pandoc.Shared (readDataFile, renderTags') -import Text.Pandoc.MIME (getMimeType) -import System.Directory (doesFileExist) +import Text.Pandoc.Shared (renderTags', getItem) import Text.Pandoc.UTF8 (toString, fromString) -getItem :: Maybe FilePath -> String -> IO (ByteString, Maybe String) -getItem userdata f = - if isAbsoluteURI f - then openURL f - else do - let mime = case takeExtension f of - ".gz" -> getMimeType $ dropExtension f - x -> getMimeType x - exists <- doesFileExist f - cont <- if exists then B.readFile f else readDataFile userdata f - return (cont, mime) - --- TODO - have this return mime type too - then it can work for google --- chart API, e.g. -openURL :: String -> IO (ByteString, Maybe String) -openURL u = getBodyAndMimeType =<< simpleHTTP (getReq u) - where getReq v = case parseURI v of - Nothing -> error $ "Could not parse URI: " ++ v - Just u' -> mkRequest GET u' - getBodyAndMimeType (Left err) = fail (show err) - getBodyAndMimeType (Right r) = return (rspBody r, findHeader HdrContentType r) - isOk :: Char -> Bool isOk c = isAscii c && isAlphaNum c diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index f23c043e1..15af4cc33 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -67,6 +67,7 @@ module Text.Pandoc.Shared ( inDirectory, readDataFile, readDataFileUTF8, + getItem, -- * Error handling err, warn, @@ -84,9 +85,10 @@ import System.Exit (exitWith, ExitCode(..)) import Data.Char ( toLower, isLower, isUpper, isAlpha, isLetter, isDigit, isSpace ) import Data.List ( find, isPrefixOf, intercalate ) -import Network.URI ( escapeURIString ) +import Network.URI ( escapeURIString, isAbsoluteURI, parseURI ) import System.Directory -import System.FilePath ( (</>) ) +import Text.Pandoc.MIME (getMimeType) +import System.FilePath ( (</>), takeExtension, dropExtension ) import Data.Generics (Typeable, Data) import qualified Control.Monad.State as S import Control.Monad (msum) @@ -97,6 +99,8 @@ import System.IO (stderr) import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), renderOptions) import qualified Data.ByteString as B +import Network.HTTP (findHeader, rspBody, simpleHTTP, RequestMethod(..), + HeaderName(..), mkRequest) #ifdef EMBED_DATA_FILES import Data.FileEmbed #else @@ -541,6 +545,28 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String readDataFileUTF8 userDir fname = UTF8.toString `fmap` readDataFile userDir fname +getItem :: Maybe FilePath -> String -> IO (B.ByteString, Maybe String) +getItem userdata f = + if isAbsoluteURI f + then openURL f + else do + let mime = case takeExtension f of + ".gz" -> getMimeType $ dropExtension f + x -> getMimeType x + exists <- doesFileExist f + cont <- if exists then B.readFile f else readDataFile userdata f + return (cont, mime) + +-- TODO - have this return mime type too - then it can work for google +-- chart API, e.g. +openURL :: String -> IO (B.ByteString, Maybe String) +openURL u = getBodyAndMimeType =<< simpleHTTP (getReq u) + where getReq v = case parseURI v of + Nothing -> error $ "Could not parse URI: " ++ v + Just u' -> mkRequest GET u' + getBodyAndMimeType (Left e) = fail (show e) + getBodyAndMimeType (Right r) = return (rspBody r, findHeader HdrContentType r) + -- -- Error reporting -- |