From 83b9a66bf468c0f32bd96be92bb571bd83b73903 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 19 Nov 2013 13:15:24 -0800 Subject: Shared: Fixed bug in openURL with data: URIs. Previously the base-64 encoded bytestring was returned. We now decode it so it's a proper image! This should fix parsing of data: URLs. --- src/Text/Pandoc/Shared.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index d6ccdae66..8dcd88148 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -108,6 +108,7 @@ import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Text.Pandoc.Compat.Monoid +import Data.ByteString.Base64 (decodeLenient) #ifdef EMBED_DATA_FILES import Text.Pandoc.Data (dataFiles) @@ -641,7 +642,7 @@ openURL u | "data:" `isPrefixOf` u = let mime = takeWhile (/=',') $ drop 5 u contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u - in return $ Right (contents, Just mime) + in return $ Right (decodeLenient contents, Just mime) #ifdef HTTP_CONDUIT | otherwise = E.try $ do req <- parseUrl u -- cgit v1.2.3 From 82813b55852c99c2e4d179083c119937c39d5398 Mon Sep 17 00:00:00 2001 From: Shaun Attfield Date: Sun, 1 Dec 2013 10:19:08 +0200 Subject: normalizeDate: Allow dates with year only (%Y) --- src/Text/Pandoc/Shared.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 8dcd88148..7592b7659 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -270,7 +270,7 @@ normalizeDate s = fmap (formatTime defaultTimeLocale "%F") (msum $ map (\fs -> parsetimeWith fs s) formats :: Maybe Day) where parsetimeWith = parseTime defaultTimeLocale formats = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y", - "%d %B %Y", "%b. %d, %Y", "%B %d, %Y"] + "%d %B %Y", "%b. %d, %Y", "%B %d, %Y", "%Y"] -- -- Pandoc block and inline list processing -- cgit v1.2.3 From 142f81889b6ede73f965afa01ac67427e1335e9d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 9 Dec 2013 22:35:22 -0800 Subject: Added `withSocketsDo` around http conduit code in `openURL`. This should address #1080, but further testing on Windows is needed before we can close the bug. --- src/Text/Pandoc/Shared.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 7592b7659..ce71881e6 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -121,6 +121,7 @@ import Data.ByteString.Lazy (toChunks) import Network.HTTP.Conduit (httpLbs, parseUrl, withManager, responseBody, responseHeaders) import Network.HTTP.Types.Header ( hContentType) +import Network (withSocketsDo) #else import Network.URI (parseURI) import Network.HTTP (findHeader, rspBody, @@ -644,7 +645,7 @@ openURL u contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u in return $ Right (decodeLenient contents, Just mime) #ifdef HTTP_CONDUIT - | otherwise = E.try $ do + | otherwise = withSocketsDo $ E.try $ do req <- parseUrl u resp <- withManager $ httpLbs req return (BS.concat $ toChunks $ responseBody resp, -- cgit v1.2.3 From 1ed2c467c9442934c060257f6e191a5a3d6c1e38 Mon Sep 17 00:00:00 2001 From: Henry de Valence Date: Thu, 19 Dec 2013 17:06:27 -0500 Subject: HLint: Use all Replace `and . map` with `all`. --- src/Text/Pandoc/Shared.hs | 2 +- src/Text/Pandoc/Writers/LaTeX.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index ce71881e6..cd2f7e24d 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -532,7 +532,7 @@ headerShift n = walk shift -- | Detect if a list is tight. isTightList :: [[Block]] -> Bool -isTightList = and . map firstIsPlain +isTightList = all firstIsPlain where firstIsPlain (Plain _ : _) = True firstIsPlain _ = False diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 7612be100..47b769c48 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -443,7 +443,7 @@ blockToLaTeX (DefinitionList lst) = do incremental <- gets stIncremental let inc = if incremental then "[<+->]" else "" items <- mapM defListItemToLaTeX lst - let spacing = if and $ map isTightList (map snd lst) + let spacing = if all isTightList (map snd lst) then text "\\itemsep1pt\\parskip0pt\\parsep0pt" else empty return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$ @@ -764,9 +764,9 @@ citationsToNatbib cits | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits = citeCommand "citep" p s ks where - noPrefix = and . map (null . citationPrefix) - noSuffix = and . map (null . citationSuffix) - ismode m = and . map (((==) m) . citationMode) + noPrefix = all (null . citationPrefix) + noSuffix = all (null . citationSuffix) + ismode m = all (((==) m) . citationMode) p = citationPrefix $ head $ cits s = citationSuffix $ last $ cits ks = intercalate ", " $ map citationId cits -- cgit v1.2.3 From 0c5e7cf8cb4fe6959d7e89880e8925afe6625414 Mon Sep 17 00:00:00 2001 From: Henry de Valence Date: Thu, 19 Dec 2013 20:19:24 -0500 Subject: HLint: use `elem` and `notElem` Replaces long conditional chains with calls to `elem` and `notElem`. --- pandoc.hs | 2 +- src/Text/Pandoc/Parsing.hs | 4 ++-- src/Text/Pandoc/Readers/LaTeX.hs | 5 ++--- src/Text/Pandoc/Readers/Markdown.hs | 8 ++++---- src/Text/Pandoc/Shared.hs | 12 ++++-------- src/Text/Pandoc/Writers/Markdown.hs | 11 ++++++----- src/Text/Pandoc/Writers/Org.hs | 2 +- 7 files changed, 20 insertions(+), 24 deletions(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/pandoc.hs b/pandoc.hs index cada3347d..ccd3e57fb 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -656,7 +656,7 @@ options = (ReqArg (\arg opt -> do let b = takeBaseName arg - if (b == "pdflatex" || b == "lualatex" || b == "xelatex") + if b `elem` ["pdflatex", "lualatex", "xelatex"] then return opt { optLaTeXEngine = arg } else err 45 "latex-engine must be pdflatex, lualatex, or xelatex.") "PROGRAM") diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index e15854333..2f21e1253 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -271,7 +271,7 @@ spaceChar = satisfy $ \c -> c == ' ' || c == '\t' -- | Parses a nonspace, nonnewline character. nonspaceChar :: Parser [Char] st Char -nonspaceChar = satisfy $ \x -> x /= '\t' && x /= '\n' && x /= ' ' && x /= '\r' +nonspaceChar = satisfy $ flip notElem ['\t', '\n', ' ', '\r'] -- | Skips zero or more spaces or tabs. skipSpaces :: Parser [Char] st () @@ -1062,7 +1062,7 @@ doubleQuoteStart :: Parser [Char] ParserState () doubleQuoteStart = do failIfInQuoteContext InDoubleQuote try $ do charOrRef "\"\8220\147" - notFollowedBy (satisfy (\c -> c == ' ' || c == '\t' || c == '\n')) + notFollowedBy . satisfy $ flip elem [' ', '\t', '\n'] doubleQuoteEnd :: Parser [Char] st () doubleQuoteEnd = do diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 0020a8f26..51271edc5 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -874,9 +874,8 @@ verbatimEnv = do (_,r) <- withRaw $ do controlSeq "begin" name <- braced - guard $ name == "verbatim" || name == "Verbatim" || - name == "lstlisting" || name == "minted" || - name == "alltt" + guard $ name `elem` ["verbatim", "Verbatim", "lstlisting", + "minted", "alltt"] verbEnv name rest <- getInput return (r,rest) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index b2e88d47e..f483ab059 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -789,8 +789,8 @@ listItem start = try $ do orderedList :: MarkdownParser (F Blocks) orderedList = try $ do (start, style, delim) <- lookAhead anyOrderedListStart - unless ((style == DefaultStyle || style == Decimal || style == Example) && - (delim == DefaultDelim || delim == Period)) $ + unless (style `elem` [DefaultStyle, Decimal, Example] && + delim `elem` [DefaultDelim, Period]) $ guardEnabled Ext_fancy_lists when (style == Example) $ guardEnabled Ext_example_lists items <- fmap sequence $ many1 $ listItem @@ -925,8 +925,8 @@ strictHtmlBlock = htmlInBalanced (not . isInlineTag) rawVerbatimBlock :: MarkdownParser String rawVerbatimBlock = try $ do - (TagOpen tag _, open) <- htmlTag (tagOpen (\t -> - t == "pre" || t == "style" || t == "script") + (TagOpen tag _, open) <- htmlTag (tagOpen (flip elem + ["pre", "style", "script"]) (const True)) contents <- manyTill anyChar (htmlTag (~== TagClose tag)) return $ open ++ contents ++ renderTags [TagClose tag] diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index cd2f7e24d..3446f4343 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -564,14 +564,10 @@ makeMeta title authors date = -- | Render HTML tags. renderTags' :: [Tag String] -> String renderTags' = renderTagsOptions - renderOptions{ optMinimize = \x -> - let y = map toLower x - in y == "hr" || y == "br" || - y == "img" || y == "meta" || - y == "link" - , optRawTag = \x -> - let y = map toLower x - in y == "script" || y == "style" } + renderOptions{ optMinimize = matchTags ["hr", "br", "img", + "meta", "link"] + , optRawTag = matchTags ["script", "style"] } + where matchTags = \tags -> flip elem tags . map toLower -- -- File handling diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index c0b189b75..278e5cc9d 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -338,7 +338,7 @@ blockToMarkdown opts (RawBlock f str) else return $ if isEnabled Ext_markdown_attribute opts then text (addMarkdownAttribute str) <> text "\n" else text str <> text "\n" - | f == "latex" || f == "tex" || f == "markdown" = do + | f `elem` ["latex", "tex", "markdown"] = do st <- get if stPlain st then return empty @@ -628,10 +628,11 @@ getReference label (src, tit) = do Nothing -> do let label' = case find ((== label) . fst) (stRefs st) of Just _ -> -- label is used; generate numerical label - case find (\n -> not (any (== [Str (show n)]) - (map fst (stRefs st)))) [1..(10000 :: Integer)] of - Just x -> [Str (show x)] - Nothing -> error "no unique label" + case find (\n -> notElem [Str (show n)] + (map fst (stRefs st))) + [1..(10000 :: Integer)] of + Just x -> [Str (show x)] + Nothing -> error "no unique label" Nothing -> label modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st }) return label' diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 51083f52b..d318c5f6a 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -129,7 +129,7 @@ blockToOrg (Para inlines) = do blockToOrg (RawBlock "html" str) = return $ blankline $$ "#+BEGIN_HTML" $$ nest 2 (text str) $$ "#+END_HTML" $$ blankline -blockToOrg (RawBlock f str) | f == "org" || f == "latex" || f == "tex" = +blockToOrg (RawBlock f str) | f `elem` ["org", "latex", "tex"] = return $ text str blockToOrg (RawBlock _ _) = return empty blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline -- cgit v1.2.3 From aada7b495bf4af9912603b3b7649dd0d63f9b5fc Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 8 Jan 2014 12:04:08 -0800 Subject: fetchItem: Handle image URLs beginning with '//'. --- src/Text/Pandoc/Shared.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'src/Text/Pandoc/Shared.hs') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 3446f4343..714402e42 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -91,7 +91,8 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha, isLetter, isDigit, isSpace ) import Data.List ( find, isPrefixOf, intercalate ) import qualified Data.Map as M -import Network.URI ( escapeURIString, isURI, unEscapeString ) +import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo, + unEscapeString, parseURIReference ) import System.Directory import Text.Pandoc.MIME (getMimeType) import System.FilePath ( (), takeExtension, dropExtension ) @@ -623,9 +624,13 @@ fetchItem :: Maybe String -> String -> IO (Either E.SomeException (BS.ByteString, Maybe String)) fetchItem sourceURL s | isURI s = openURL s - | otherwise = case sourceURL of - Just u -> openURL (u ++ "/" ++ s) - Nothing -> E.try readLocalFile + | otherwise = + case sourceURL >>= parseURIReference of + Just u -> case parseURIReference s of + Just s' -> openURL $ show $ + s' `nonStrictRelativeTo` u + Nothing -> openURL $ show u ++ "/" ++ s + Nothing -> E.try readLocalFile where readLocalFile = do let mime = case takeExtension s of ".gz" -> getMimeType $ dropExtension s -- cgit v1.2.3