From cae155b095e5182cc1b342b21f7430e40afe7ba8 Mon Sep 17 00:00:00 2001 From: Christian Despres <50160106+despresc@users.noreply.github.com> Date: Sun, 13 Sep 2020 10:48:14 -0400 Subject: Fix hlint suggestions, update hlint.yaml (#6680) * Fix hlint suggestions, update hlint.yaml Most suggestions were redundant brackets. Some required LambdaCase. The .hlint.yaml file had a small typo, and didn't ignore camelCase suggestions in certain modules. --- src/Text/Pandoc/Readers/CSV.hs | 2 +- src/Text/Pandoc/Readers/CommonMark.hs | 1 - src/Text/Pandoc/Readers/DocBook.hs | 22 ++++---- src/Text/Pandoc/Readers/Docx.hs | 10 ++-- src/Text/Pandoc/Readers/Docx/Parse.hs | 12 ++--- src/Text/Pandoc/Readers/DokuWiki.hs | 2 +- src/Text/Pandoc/Readers/HTML.hs | 2 +- src/Text/Pandoc/Readers/Haddock.hs | 2 +- src/Text/Pandoc/Readers/JATS.hs | 12 ++--- src/Text/Pandoc/Readers/LaTeX.hs | 63 +++++++++++----------- src/Text/Pandoc/Readers/LaTeX/Lang.hs | 2 +- src/Text/Pandoc/Readers/LaTeX/Parsing.hs | 14 +++-- src/Text/Pandoc/Readers/LaTeX/SIunitx.hs | 6 +-- src/Text/Pandoc/Readers/Man.hs | 2 +- src/Text/Pandoc/Readers/Markdown.hs | 12 ++--- src/Text/Pandoc/Readers/MediaWiki.hs | 6 +-- src/Text/Pandoc/Readers/Muse.hs | 2 +- src/Text/Pandoc/Readers/Odt/ContentReader.hs | 6 +-- .../Pandoc/Readers/Odt/Generic/XMLConverter.hs | 3 +- src/Text/Pandoc/Readers/Org/Blocks.hs | 23 ++++---- src/Text/Pandoc/Readers/Org/ParserState.hs | 2 +- src/Text/Pandoc/Readers/Org/Shared.hs | 4 +- src/Text/Pandoc/Readers/RST.hs | 8 +-- src/Text/Pandoc/Readers/TWiki.hs | 14 ++--- src/Text/Pandoc/Readers/Textile.hs | 6 +-- src/Text/Pandoc/Readers/Txt2Tags.hs | 2 +- 26 files changed, 114 insertions(+), 126 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs index 384687a6a..f0edcaa16 100644 --- a/src/Text/Pandoc/Readers/CSV.hs +++ b/src/Text/Pandoc/Readers/CSV.hs @@ -39,7 +39,7 @@ readCSV _opts s = numcols = length r toplain = B.simpleCell . B.plain . B.text . T.strip toRow = Row nullAttr . map toplain - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] hdrs = toHeaderRow r rows = map toRow rs aligns = replicate numcols AlignDefault diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index a85d9aa37..43db6d59a 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Readers.CommonMark Copyright : Copyright (C) 2015-2020 John MacFarlane diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index b91e29fa7..084c2788f 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -18,7 +18,7 @@ import Data.Either (rights) import Data.Foldable (asum) import Data.Generics import Data.List (intersperse,elemIndex) -import Data.Maybe (fromMaybe,catMaybes) +import Data.Maybe (fromMaybe,mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup.Entity (lookupEntity) @@ -781,7 +781,7 @@ parseBlock (Elem e) = "para" -> parseMixed para (elContent e) "formalpara" -> do tit <- case filterChild (named "title") e of - Just t -> (para . strong . (<> str ".")) <$> + Just t -> para . strong . (<> str ".") <$> getInlines t Nothing -> return mempty (tit <>) <$> parseMixed para (elContent e) @@ -897,7 +897,7 @@ parseBlock (Elem e) = parseBlockquote = do attrib <- case filterChild (named "attribution") e of Nothing -> return mempty - Just z -> (para . (str "— " <>) . mconcat) + Just z -> para . (str "— " <>) . mconcat <$> mapM parseInline (elContent z) contents <- getBlocks e @@ -931,7 +931,7 @@ parseBlock (Elem e) = _ -> filterChildren isColspec e' let colnames = case colspecs of [] -> [] - cs -> catMaybes $ map (findAttr (unqual "colname" )) cs + cs -> mapMaybe (findAttr (unqual "colname" )) cs let isRow x = named "row" x || named "tr" x headrows <- case filterChild (named "thead") e' of Just h -> case filterChild isRow h of @@ -968,7 +968,7 @@ parseBlock (Elem e) = in ColWidth . (/ tot) <$> ws' Nothing -> replicate numrows ColWidthDefault let toRow = Row nullAttr - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ table (simpleCaption $ plain capt) (zip aligns widths) (TableHead nullAttr $ toHeaderRow headrows) @@ -1008,7 +1008,7 @@ parseBlock (Elem e) = parseMixed :: PandocMonad m => (Inlines -> Blocks) -> [Content] -> DB m Blocks parseMixed container conts = do let (ils,rest) = break isBlockElement conts - ils' <- (trimInlines . mconcat) <$> mapM parseInline ils + ils' <- trimInlines . mconcat <$> mapM parseInline ils let p = if ils' == mempty then mempty else container ils' case rest of [] -> return p @@ -1036,10 +1036,10 @@ parseEntry cn el = do case (mStrt, mEnd) of (Just start, Just end) -> colDistance start end _ -> 1 - (fmap (cell AlignDefault 1 (toColSpan el)) . (parseMixed plain) . elContent) el + (fmap (cell AlignDefault 1 (toColSpan el)) . parseMixed plain . elContent) el getInlines :: PandocMonad m => Element -> DB m Inlines -getInlines e' = (trimInlines . mconcat) <$> +getInlines e' = trimInlines . mconcat <$> mapM parseInline (elContent e') strContentRecursive :: Element -> String @@ -1136,7 +1136,7 @@ parseInline (Elem e) = "strong" -> strong <$> innerInlines "strikethrough" -> strikeout <$> innerInlines _ -> emph <$> innerInlines - "footnote" -> (note . mconcat) <$> + "footnote" -> note . mconcat <$> mapM parseBlock (elContent e) "title" -> return mempty "affiliation" -> skip @@ -1149,14 +1149,14 @@ parseInline (Elem e) = lift $ report $ IgnoredElement $ T.pack $ qName (elName e) return mempty - innerInlines = (trimInlines . mconcat) <$> + innerInlines = trimInlines . mconcat <$> mapM parseInline (elContent e) codeWithLang = do let classes' = case attrValue "language" e of "" -> [] l -> [l] return $ codeWith (attrValue "id" e,classes',[]) $ T.pack $ strContentRecursive e - simpleList = (mconcat . intersperse (str "," <> space)) <$> mapM getInlines + simpleList = mconcat . intersperse (str "," <> space) <$> mapM getInlines (filterChildren (named "member") e) segmentedList = do tit <- maybe (return mempty) getInlines $ filterChild (named "title") e diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index c9aa2f7c5..9c2f58342 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -91,9 +91,9 @@ readDocx :: PandocMonad m => ReaderOptions -> B.ByteString -> m Pandoc -readDocx opts bytes = do +readDocx opts bytes = case toArchiveOrFail bytes of - Right archive -> do + Right archive -> case archiveToDocxWithWarnings archive of Right (docx, parserWarnings) -> do mapM_ (P.report . DocxParserWarning) parserWarnings @@ -291,9 +291,9 @@ runStyleToTransform rPr' = do spanWith ("",[],[("dir","ltr")]) . go rPr{isRTL = Nothing} | Just SupScrpt <- rVertAlign rPr = superscript . go rPr{rVertAlign = Nothing} - | Just SubScrpt <- rVertAlign rPr = do + | Just SubScrpt <- rVertAlign rPr = subscript . go rPr{rVertAlign = Nothing} - | Just "single" <- rUnderline rPr = do + | Just "single" <- rUnderline rPr = Pandoc.underline . go rPr{rUnderline = Nothing} | otherwise = id return $ go rPr' @@ -658,7 +658,7 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do rowLength (Docx.Row c) = length c let toRow = Pandoc.Row nullAttr . map simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] -- pad cells. New Text.Pandoc.Builder will do that for us, -- so this is for compatibility while we switch over. diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index eab4f4e0d..698d7a88a 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -404,12 +404,8 @@ archiveToNotes zf = >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry) enElem = findEntryByPath "word/endnotes.xml" zf >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry) - fn_namespaces = case fnElem of - Just e -> elemToNameSpaces e - Nothing -> [] - en_namespaces = case enElem of - Just e -> elemToNameSpaces e - Nothing -> [] + fn_namespaces = maybe [] elemToNameSpaces fnElem + en_namespaces = maybe [] elemToNameSpaces enElem ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces fn = fnElem >>= walkDocument ns >>= elemToNotes ns "footnote" en = enElem >>= walkDocument ns >>= elemToNotes ns "endnote" @@ -420,9 +416,7 @@ archiveToComments :: Archive -> Comments archiveToComments zf = let cmtsElem = findEntryByPath "word/comments.xml" zf >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry) - cmts_namespaces = case cmtsElem of - Just e -> elemToNameSpaces e - Nothing -> [] + cmts_namespaces = maybe [] elemToNameSpaces cmtsElem cmts = elemToComments cmts_namespaces <$> (cmtsElem >>= walkDocument cmts_namespaces) in case cmts of diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs index 722701ee2..336be09e5 100644 --- a/src/Text/Pandoc/Readers/DokuWiki.hs +++ b/src/Text/Pandoc/Readers/DokuWiki.hs @@ -472,7 +472,7 @@ table = do else ([], rows) let attrs = (AlignDefault, ColWidthDefault) <$ transpose rows let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] pure $ B.table B.emptyCaption attrs (TableHead nullAttr $ toHeaderRow headerRow) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 3f6e0a1af..761c4cabe 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -517,7 +517,7 @@ pTable = try $ do else replicate cols (ColWidth (1.0 / fromIntegral cols)) else widths' let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.tableWith attribs (B.simpleCaption $ B.plain caption) (zip aligns widths) diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 8fe5e062c..25d69f040 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -86,7 +86,7 @@ docHToBlocks d' = } -> let toCells = map (docHToBlocks . tableCellContents) . tableRowCells toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] (header, body) = if null headerRows then ([], map toCells bodyRows) diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index d3d742de3..69d597212 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -189,7 +189,7 @@ parseBlock (Elem e) = _ -> getBlocks e where parseMixed container conts = do let (ils,rest) = break isBlockElement conts - ils' <- (trimInlines . mconcat) <$> mapM parseInline ils + ils' <- trimInlines . mconcat <$> mapM parseInline ils let p = if ils' == mempty then mempty else container ils' case rest of [] -> return p @@ -206,7 +206,7 @@ parseBlock (Elem e) = parseBlockquote = do attrib <- case filterChild (named "attribution") e of Nothing -> return mempty - Just z -> (para . (str "— " <>) . mconcat) + Just z -> para . (str "— " <>) . mconcat <$> mapM parseInline (elContent z) contents <- getBlocks e @@ -281,7 +281,7 @@ parseBlock (Elem e) = in ColWidth . (/ tot) <$> ws' Nothing -> replicate numrows ColWidthDefault let toRow = Row nullAttr . map simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ table (simpleCaption $ plain capt) (zip aligns widths) (TableHead nullAttr $ toHeaderRow headrows) @@ -309,7 +309,7 @@ parseBlock (Elem e) = return $ headerWith (ident,[],[]) n' headerText <> b getInlines :: PandocMonad m => Element -> JATS m Inlines -getInlines e' = (trimInlines . mconcat) <$> +getInlines e' = trimInlines . mconcat <$> mapM parseInline (elContent e') parseMetadata :: PandocMonad m => Element -> JATS m Blocks @@ -518,10 +518,10 @@ parseInline (Elem e) = "email" -> return $ link ("mailto:" <> textContent e) "" $ str $ textContent e "uri" -> return $ link (textContent e) "" $ str $ textContent e - "fn" -> (note . mconcat) <$> + "fn" -> note . mconcat <$> mapM parseBlock (elContent e) _ -> innerInlines - where innerInlines = (trimInlines . mconcat) <$> + where innerInlines = trimInlines . mconcat <$> mapM parseInline (elContent e) mathML x = case readMathML . T.pack . showElement $ everywhere (mkT removePrefix) x of diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index de391e54a..5ceb6e22a 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -31,6 +31,7 @@ import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isDigit, isLetter, toUpper, chr) import Data.Default +import Data.Functor (($>)) import Data.List (intercalate) import qualified Data.Map as M import Data.Maybe (fromMaybe, maybeToList) @@ -136,15 +137,15 @@ rawLaTeXBlock = do inp <- getInput let toks = tokenize "source" inp snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks - <|> (rawLaTeXParser toks True + <|> rawLaTeXParser toks True (do choice (map controlSeq ["include", "input", "subfile", "usepackage"]) skipMany opt braced - return mempty) blocks) + return mempty) blocks <|> rawLaTeXParser toks True (environment <|> blockCommand) - (mconcat <$> (many (block <|> beginOrEndCommand)))) + (mconcat <$> many (block <|> beginOrEndCommand))) -- See #4667 for motivation; sometimes people write macros -- that just evaluate to a begin or end command, which blockCommand @@ -187,10 +188,10 @@ inlineCommand = do -- inline elements: word :: PandocMonad m => LP m Inlines -word = (str . untoken) <$> satisfyTok isWordTok +word = str . untoken <$> satisfyTok isWordTok regularSymbol :: PandocMonad m => LP m Inlines -regularSymbol = (str . untoken) <$> satisfyTok isRegularSymbol +regularSymbol = str . untoken <$> satisfyTok isRegularSymbol where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t isRegularSymbol _ = False isSpecial c = c `Set.member` specialChars @@ -206,7 +207,7 @@ inlineGroup = do doLHSverb :: PandocMonad m => LP m Inlines doLHSverb = - (codeWith ("",["haskell"],[]) . untokenize) + codeWith ("",["haskell"],[]) . untokenize <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|') mkImage :: PandocMonad m => [(Text, Text)] -> Text -> LP m Inlines @@ -342,7 +343,7 @@ doverb = do Just (c, ts) | T.null ts -> return c _ -> mzero withVerbatimMode $ - (code . untokenize) <$> + code . untokenize <$> manyTill (notFollowedBy newlineTok >> verbTok marker) (symbol marker) verbTok :: PandocMonad m => Char -> LP m Tok @@ -383,7 +384,7 @@ doinlinecode classes = do _ -> mzero let stopchar = if marker == '{' then '}' else marker withVerbatimMode $ - (codeWith ("",classes,[]) . T.map nlToSpace . untokenize) <$> + codeWith ("",classes,[]) . T.map nlToSpace . untokenize <$> manyTill (verbTok stopchar) (symbol stopchar) nlToSpace :: Char -> Char @@ -402,7 +403,7 @@ dollarsMath = do display <- option False (True <$ symbol '$') (do contents <- try $ untokenize <$> pDollarsMath 0 if display - then (mathDisplay contents <$ symbol '$') + then mathDisplay contents <$ symbol '$' else return $ mathInline contents) <|> (guard display >> return (mathInline "")) @@ -415,7 +416,7 @@ pDollarsMath n = do , n == 0 -> return [] | t == "\\" -> do tk' <- anyTok - ((tk :) . (tk' :)) <$> pDollarsMath n + (tk :) . (tk' :) <$> pDollarsMath n | t == "{" -> (tk :) <$> pDollarsMath (n+1) | t == "}" -> if n > 0 @@ -477,7 +478,7 @@ cites mode multi = try $ do tempCits <- many1 simpleCiteArgs case tempCits of (k:ks) -> case ks of - (_:_) -> return $ ((addMprenote pre k):init ks) ++ + (_:_) -> return $ (addMprenote pre k : init ks) ++ [addMpostnote suf (last ks)] _ -> return [addMprenote pre (addMpostnote suf k)] _ -> return [[]] @@ -521,7 +522,7 @@ complexNatbibCitation mode = try $ do bgroup items <- mconcat <$> many1 (notFollowedBy (symbol ';') >> inline) - `sepBy1` (symbol ';') + `sepBy1` symbol ';' egroup return $ map handleCitationPart items case cs of @@ -660,7 +661,7 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList , ("eqref", rawInlineOr "eqref" $ doref "eqref") -- from amsmath.sty , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok) , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok) - , ("lettrine", rawInlineOr "lettrine" $ lettrine) + , ("lettrine", rawInlineOr "lettrine" lettrine) , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")")) , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]")) , ("ensuremath", mathInline . untokenize <$> braced) @@ -1073,7 +1074,7 @@ coloredInline stylename = do spanWith ("",[],[("style",stylename <> ": " <> untokenize color)]) <$> tok ttfamily :: PandocMonad m => LP m Inlines -ttfamily = (code . stringify . toList) <$> tok +ttfamily = code . stringify . toList <$> tok rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines rawInlineOr name' fallback = do @@ -1235,8 +1236,8 @@ doSubfile = do include :: (PandocMonad m, Monoid a) => Text -> LP m a include name = do skipMany opt - fs <- (map (T.unpack . removeDoubleQuotes . T.strip) . T.splitOn "," . - untokenize) <$> braced + fs <- map (T.unpack . removeDoubleQuotes . T.strip) . T.splitOn "," . + untokenize <$> braced let defaultExt | name == "usepackage" = ".sty" | otherwise = ".tex" mapM_ (insertIncluded defaultExt) fs @@ -1251,7 +1252,7 @@ insertIncluded defaultExtension f' = do ".tex" -> f' ".sty" -> f' _ -> addExtension f' defaultExtension - dirs <- (map T.unpack . splitTextBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS" + dirs <- map T.unpack . splitTextBy (==':') . fromMaybe "." <$> lookupEnv "TEXINPUTS" pos <- getPosition containers <- getIncludeFiles <$> getState when (T.pack f `elem` containers) $ @@ -1564,7 +1565,7 @@ blockCommands = M.fromList , ("frametitle", section nullAttr 3) , ("framesubtitle", section nullAttr 4) -- letters - , ("opening", (para . trimInlines) <$> (skipopts *> tok)) + , ("opening", para . trimInlines <$> (skipopts *> tok)) , ("closing", skipopts *> closing) -- memoir , ("plainbreak", braced >> pure horizontalRule) @@ -1578,10 +1579,10 @@ blockCommands = M.fromList -- , ("hrule", pure horizontalRule) , ("strut", pure mempty) - , ("rule", skipopts *> tok *> tok *> pure horizontalRule) + , ("rule", skipopts *> tok *> tok $> horizontalRule) , ("item", looseItem) , ("documentclass", skipopts *> braced *> preamble) - , ("centerline", (para . trimInlines) <$> (skipopts *> tok)) + , ("centerline", para . trimInlines <$> (skipopts *> tok)) , ("caption", mempty <$ setCaption) , ("bibliography", mempty <$ (skipopts *> braced >>= addMeta "bibliography" . splitBibs . untokenize)) @@ -1623,7 +1624,7 @@ environments :: PandocMonad m => M.Map Text (LP m Blocks) environments = M.fromList [ ("document", env "document" blocks <* skipMany anyTok) , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract")) - , ("sloppypar", env "sloppypar" $ blocks) + , ("sloppypar", env "sloppypar" blocks) , ("letter", env "letter" letterContents) , ("minipage", env "minipage" $ skipopts *> spaces *> optional braced *> spaces *> blocks) @@ -1709,7 +1710,7 @@ proof = do bs <- env "proof" blocks return $ B.divWith ("", ["proof"], []) $ - addQed $ addTitle (B.emph (title <> ".")) $ bs + addQed $ addTitle (B.emph (title <> ".")) bs addTitle :: Inlines -> Blocks -> Blocks addTitle ils bs = @@ -1753,8 +1754,7 @@ theoremEnvironment name = do then do let name' = fromMaybe name $ theoremSeries tspec num <- getNextNumber - (fromMaybe (DottedNum [0]) . - fmap theoremLastNum . + (maybe (DottedNum [0]) theoremLastNum . M.lookup name' . sTheoremMap) updateState $ \s -> s{ sTheoremMap = @@ -1866,7 +1866,7 @@ inputMinted = do pos <- getPosition attr <- mintedAttr f <- T.filter (/='"') . untokenize <$> braced - dirs <- (map T.unpack . splitTextBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS" + dirs <- map T.unpack . splitTextBy (==':') . fromMaybe "." <$> lookupEnv "TEXINPUTS" mbCode <- readFileFromDirs dirs (T.unpack f) rawcode <- case mbCode of Just s -> return s @@ -1979,7 +1979,7 @@ inputListing = do pos <- getPosition options <- option [] keyvals f <- T.filter (/='"') . untokenize <$> braced - dirs <- (map T.unpack . splitTextBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS" + dirs <- map T.unpack . splitTextBy (==':') . fromMaybe "." <$> lookupEnv "TEXINPUTS" mbCode <- readFileFromDirs dirs (T.unpack f) codeLines <- case mbCode of Just s -> return $ T.lines s @@ -2176,18 +2176,17 @@ parseTableCell :: PandocMonad m => LP m Cell parseTableCell = do spaces updateState $ \st -> st{ sInTableCell = True } - cell' <- ( multicolumnCell + cell' <- multicolumnCell <|> multirowCell <|> parseSimpleCell <|> parseEmptyCell - ) updateState $ \st -> st{ sInTableCell = False } spaces return cell' where -- The parsing of empty cells is important in LaTeX, especially when dealing -- with multirow/multicolumn. See #6603. - parseEmptyCell = optional spaces >> return emptyCell <* optional spaces + parseEmptyCell = spaces $> emptyCell cellAlignment :: PandocMonad m => LP m Alignment cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|') @@ -2237,8 +2236,8 @@ multicolumnCell = controlSeq "multicolumn" >> do (Cell _ _ (RowSpan rs) _ bs) <- multirowCell return $ cell alignment - (RowSpan $ rs) - (ColSpan $ span') + (RowSpan rs) + (ColSpan span') (fromList bs) symbol '{' *> (nestedCell <|> singleCell) <* symbol '}' @@ -2276,7 +2275,7 @@ simpTable envname hasWidthParameter = try $ do lookAhead $ controlSeq "end" -- make sure we're at end return $ table emptyCaption (zip aligns widths) - (TableHead nullAttr $ header') + (TableHead nullAttr header') [TableBody nullAttr 0 [] rows] (TableFoot nullAttr []) diff --git a/src/Text/Pandoc/Readers/LaTeX/Lang.hs b/src/Text/Pandoc/Readers/LaTeX/Lang.hs index 55965c995..814b2fe79 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Lang.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Lang.hs @@ -152,4 +152,4 @@ babelLangToBCP47 s = "newzealand" -> Just $ Lang "en" "" "NZ" [] "american" -> Just $ Lang "en" "" "US" [] "classiclatin" -> Just $ Lang "la" "" "" ["x-classic"] - _ -> fmap ($ "") $ M.lookup s polyglossiaLangToBCP47 + _ -> ($ "") <$> M.lookup s polyglossiaLangToBCP47 diff --git a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs index 10e48b45f..c349fe3b1 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Parsing.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Parsing.hs @@ -1,8 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Readers.LaTeX.Parsing Copyright : Copyright (C) 2006-2020 John MacFarlane @@ -736,14 +736,14 @@ keyval = try $ do (mconcat <$> many1 ( (untokenize . snd <$> withRaw braced) <|> - (untokenize <$> (many1 + (untokenize <$> many1 (satisfyTok - (\t -> case t of + (\case Tok _ Symbol "]" -> False Tok _ Symbol "," -> False Tok _ Symbol "{" -> False Tok _ Symbol "}" -> False - _ -> True)))))) + _ -> True))))) optional (symbol ',') sp return (key, T.strip val) @@ -756,8 +756,7 @@ verbEnv name = withVerbatimMode $ do optional blankline res <- manyTill anyTok (end_ name) return $ stripTrailingNewline - $ untokenize - $ res + $ untokenize res -- Strip single final newline and any spaces following it. -- Input is unchanged if it doesn't end with newline + @@ -819,8 +818,7 @@ overlaySpecification = try $ do overlayTok :: PandocMonad m => LP m Tok overlayTok = - satisfyTok (\t -> - case t of + satisfyTok (\case Tok _ Word _ -> True Tok _ Spaces _ -> True Tok _ Symbol c -> c `elem` ["-","+","@","|",":",","] diff --git a/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs b/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs index 49a6d7301..436330d85 100644 --- a/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs +++ b/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs @@ -103,9 +103,9 @@ doSIang = do ps <- T.splitOn ";" . untokenize <$> braced case ps ++ repeat "" of (d:m:s:_) -> return $ - (if T.null d then mempty else (str d <> str "\xb0")) <> - (if T.null m then mempty else (str m <> str "\x2032")) <> - (if T.null s then mempty else (str s <> str "\x2033")) + (if T.null d then mempty else str d <> str "\xb0") <> + (if T.null m then mempty else str m <> str "\x2032") <> + (if T.null s then mempty else str s <> str "\x2033") _ -> return mempty -- converts e.g. \SIrange{100}{200}{\ms} to "100 ms--200 ms" diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs index 12001b534..ed31e1f9a 100644 --- a/src/Text/Pandoc/Readers/Man.hs +++ b/src/Text/Pandoc/Readers/Man.hs @@ -162,7 +162,7 @@ parseTable = do _ -> Nothing toRow = Row nullAttr . map simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] parseNewParagraph :: PandocMonad m => ManParser m Blocks parseNewParagraph = do diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 9b6671f1b..866b074c7 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1025,7 +1025,7 @@ htmlBlock = do guardEnabled Ext_raw_html try (do (TagOpen _ attrs) <- lookAhead $ fst <$> htmlTag isBlockTag - (return . B.rawBlock "html") <$> rawVerbatimBlock + return . B.rawBlock "html" <$> rawVerbatimBlock <|> (do guardEnabled Ext_markdown_attribute oldMarkdownAttribute <- stateMarkdownAttribute <$> getState markdownAttribute <- @@ -1582,7 +1582,7 @@ ender c n = try $ do three :: PandocMonad m => Char -> MarkdownParser m (F Inlines) three c = do contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline) - (ender c 3 >> updateLastStrPos >> return ((B.strong . B.emph) <$> contents)) + (ender c 3 >> updateLastStrPos >> return (B.strong . B.emph <$> contents)) <|> (ender c 2 >> updateLastStrPos >> one c (B.strong <$> contents)) <|> (ender c 1 >> updateLastStrPos >> two c (B.emph <$> contents)) <|> return (return (B.str $ T.pack [c,c,c]) <> contents) @@ -1617,7 +1617,7 @@ inlinesBetween :: PandocMonad m -> MarkdownParser m b -> MarkdownParser m (F Inlines) inlinesBetween start end = - (trimInlinesF . mconcat) <$> try (start >> many1Till inner end) + trimInlinesF . mconcat <$> try (start >> many1Till inner end) where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline) innerSpace = try $ whitespace <* notFollowedBy' end @@ -1720,7 +1720,7 @@ source = do try parenthesizedChars <|> (notFollowedBy (oneOf " )") >> countChar 1 litChar) <|> try (many1Char spaceChar <* notFollowedBy (oneOf "\"')")) - let sourceURL = (T.unwords . T.words . T.concat) <$> many urlChunk + let sourceURL = T.unwords . T.words . T.concat <$> many urlChunk let betweenAngles = try $ char '<' >> manyTillChar litChar (char '>') src <- try betweenAngles <|> sourceURL @@ -2023,7 +2023,7 @@ textualCite = try $ do mbrest <- option Nothing $ try $ spnl >> Just <$> withRaw normalCite case mbrest of Just (rest, raw) -> - return $ (flip B.cite (B.text $ "@" <> key <> " " <> raw) . (first:)) + return $ flip B.cite (B.text $ "@" <> key <> " " <> raw) . (first:) <$> rest Nothing -> (do @@ -2130,4 +2130,4 @@ toRow :: [Blocks] -> Row toRow = Row nullAttr . map B.simpleCell toHeaderRow :: [Blocks] -> [Row] -toHeaderRow l = if null l then [] else [toRow l] +toHeaderRow l = [toRow l | not (null l)] diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index bcf1228ad..6e7dc3110 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -231,7 +231,7 @@ table = do then (hdr, rows') else (replicate cols mempty, hdr:rows') let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain caption) cellspecs (TableHead nullAttr $ toHeaderRow headers) @@ -283,7 +283,7 @@ tableCaption = try $ do skipSpaces sym "|+" optional (try $ parseAttrs *> skipSpaces *> char '|' *> blanklines) - (trimInlines . mconcat) <$> + trimInlines . mconcat <$> many (notFollowedBy (cellsep <|> rowsep) *> inline) tableRow :: PandocMonad m => MWParser m [((Alignment, Double), Blocks)] @@ -678,7 +678,7 @@ url = do -- | Parses a list of inlines between start and end delimiters. inlinesBetween :: (PandocMonad m, Show b) => MWParser m a -> MWParser m b -> MWParser m Inlines inlinesBetween start end = - (trimInlines . mconcat) <$> try (start >> many1Till inner end) + trimInlines . mconcat <$> try (start >> many1Till inner end) where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline) innerSpace = try $ whitespace <* notFollowedBy' end diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 751a37808..b4eea9d3a 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -653,7 +653,7 @@ museToPandocTable (MuseTable caption headers body footers) = where attrs = (AlignDefault, ColWidthDefault) <$ transpose (headers ++ body ++ footers) (headRow, rows) = fromMaybe ([], []) $ uncons headers toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] museAppendElement :: MuseTableElement -> MuseTable diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 74120f96a..24391dbf0 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -220,9 +220,9 @@ uniqueIdentFrom :: AnchorPrefix -> [Anchor] -> Anchor uniqueIdentFrom baseIdent usedIdents = let numIdent n = baseIdent <> "-" <> T.pack (show n) in if baseIdent `elem` usedIdents - then case find (\x -> numIdent x `notElem` usedIdents) ([1..60000] :: [Int]) of - Just x -> numIdent x - Nothing -> baseIdent -- if we have more than 60,000, allow repeats + then maybe baseIdent numIdent + $ find (\x -> numIdent x `notElem` usedIdents) ([1..60000] :: [Int]) + -- if we have more than 60,000, allow repeats else baseIdent -- | First argument: basis for a new "pretty" anchor if none exists yet diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 5583d64ce..00c636a0d 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-} {- | Module : Text.Pandoc.Readers.Odt.Generic.XMLConverter @@ -691,7 +692,7 @@ makeMatcherC nsID name c = ( second ( contentToElem >>% recover) &&&^ snd contentToElem :: FallibleXMLConverter nsID extraState XML.Content XML.Element - contentToElem = arr $ \e -> case e of + contentToElem = arr $ \case XML.Elem e' -> succeedWith e' _ -> failEmpty diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index c60817d1b..d71cd7faf 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Shared (compactify, compactifyDL, safeRead) import Control.Monad (foldM, guard, mplus, mzero, void) import Data.Char (isSpace) import Data.Default (Default) +import Data.Functor (($>)) import Data.List (foldl', intersperse) import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) @@ -103,9 +104,7 @@ attrFromBlockAttributes :: BlockAttributes -> Attr attrFromBlockAttributes BlockAttributes{..} = let ident = fromMaybe mempty $ lookup "id" blockAttrKeyValues - classes = case lookup "class" blockAttrKeyValues of - Nothing -> [] - Just clsStr -> T.words clsStr + classes = maybe [] T.words $ lookup "class" blockAttrKeyValues kv = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues in (ident, classes, kv) @@ -576,10 +575,10 @@ rawExportLine = try $ do rawOrgLine :: PandocMonad m => OrgParser m (F Blocks) rawOrgLine = do line <- metaLineStart *> anyLine - returnF $ B.rawBlock "org" $ ("#+" <> line) + returnF $ B.rawBlock "org" $ "#+" <> line commentLine :: Monad m => OrgParser m Blocks -commentLine = commentLineStart *> anyLine *> pure mempty +commentLine = commentLineStart *> anyLine $> mempty -- @@ -648,12 +647,12 @@ orgToPandocTable (OrgTable colProps heads lns) caption = (TableFoot nullAttr []) where toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, ColWidth) convertColProp totalWidth colProp = let align' = fromMaybe AlignDefault $ columnAlignment colProp - width' = (\w t -> (fromIntegral w / fromIntegral t)) + width' = (\w t -> fromIntegral w / fromIntegral t) <$> columnRelWidth colProp <*> totalWidth in (align', maybe ColWidthDefault ColWidth width') @@ -691,9 +690,9 @@ columnPropertyCell = emptyOrgCell <|> propCell "alignment info" tableAlignFromChar :: Monad m => OrgParser m Alignment tableAlignFromChar = try $ - choice [ char 'l' *> return AlignLeft - , char 'c' *> return AlignCenter - , char 'r' *> return AlignRight + choice [ char 'l' $> AlignLeft + , char 'c' $> AlignCenter + , char 'r' $> AlignRight ] tableHline :: Monad m => OrgParser m OrgTableRow @@ -796,13 +795,13 @@ paraOrPlain = try $ do -- Make sure we are not looking at a headline notFollowedBy' headerStart ils <- inlines - nl <- option False (newline *> return True) + nl <- option False (newline $> True) -- Read block as paragraph, except if we are in a list context and the block -- is directly followed by a list item, in which case the block is read as -- plain text. try (guard nl *> notFollowedBy (inList *> (orderedListStart <|> bulletListStart)) - *> return (B.para <$> ils)) + $> (B.para <$> ils)) <|> return (B.plain <$> ils) diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 6e2e86373..1e4799e7b 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -122,7 +122,7 @@ data OrgParserState = OrgParserState , orgMacros :: M.Map Text Macro } -data OrgParserLocal = OrgParserLocal +newtype OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } diff --git a/src/Text/Pandoc/Readers/Org/Shared.hs b/src/Text/Pandoc/Readers/Org/Shared.hs index 3934be6e1..7f72077a4 100644 --- a/src/Text/Pandoc/Readers/Org/Shared.hs +++ b/src/Text/Pandoc/Readers/Org/Shared.hs @@ -58,9 +58,7 @@ cleanLinkText s originalLang :: Text -> [(Text, Text)] originalLang lang = let transLang = translateLang lang - in if transLang == lang - then [] - else [("org-language", lang)] + in [("org-language", lang) | transLang /= lang] -- | Translate from Org-mode's programming language identifiers to those used -- by Pandoc. This is useful to allow for proper syntax highlighting in diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 25682a500..50947c1be 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -164,7 +164,7 @@ parseRST = do , stateIdentifiers = mempty } -- now parse it for real... blocks <- B.toList <$> parseBlocks - citations <- (sort . M.toList . stateCitations) <$> getState + citations <- sort . M.toList . stateCitations <$> getState citationItems <- mapM parseCitation citations let refBlock = [Div ("citations",[],[]) $ B.toList $ B.definitionList citationItems | not (null citationItems)] @@ -823,7 +823,7 @@ listTableDirective top fields body = do splitTextBy (`elem` (" ," :: String)) specs _ -> replicate numOfCols ColWidthDefault toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain title) (zip (replicate numOfCols AlignDefault) widths) (TableHead nullAttr $ toHeaderRow headerRow) @@ -906,7 +906,7 @@ csvTableDirective top fields rawcsv = do $ splitTextBy (`elem` (" ," :: String)) specs _ -> replicate numOfCols ColWidthDefault let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain title) (zip (replicate numOfCols AlignDefault) widths) (TableHead nullAttr $ toHeaderRow headerRow) @@ -1014,7 +1014,7 @@ toChunks = dropWhile T.null codeblock :: Text -> [Text] -> [(Text, Text)] -> Text -> Text -> Bool -> RSTParser m Blocks -codeblock ident classes fields lang body rmTrailingNewlines = do +codeblock ident classes fields lang body rmTrailingNewlines = return $ B.codeBlockWith attribs $ stripTrailingNewlines' body where stripTrailingNewlines' = if rmTrailingNewlines then stripTrailingNewlines diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index ebd87359a..484a6c923 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -214,7 +214,7 @@ listItemLine prefix marker = mconcat <$> (lineContent >>= parseContent) listContinuation = notFollowedBy (textStr prefix >> marker) >> string " " >> lineContent parseContent = parseFromString' $ many1 $ nestedList <|> parseInline - parseInline = (B.plain . mconcat) <$> many1Till inline (lastNewline <|> newlineBeforeNestedList) + parseInline = B.plain . mconcat <$> many1Till inline (lastNewline <|> newlineBeforeNestedList) nestedList = list prefix lastNewline = try $ char '\n' <* eof newlineBeforeNestedList = try $ char '\n' <* lookAhead nestedList @@ -235,7 +235,7 @@ table = try $ do columns rows = replicate (columCount rows) mempty columCount rows = length $ head rows toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] tableParseHeader :: PandocMonad m => TWParser m ((Alignment, ColWidth), B.Blocks) tableParseHeader = try $ do @@ -265,13 +265,13 @@ tableEndOfRow :: PandocMonad m => TWParser m Char tableEndOfRow = lookAhead (try $ char '|' >> char '\n') >> char '|' tableColumnContent :: PandocMonad m => TWParser m a -> TWParser m B.Blocks -tableColumnContent end = (B.plain . mconcat) <$> manyTill content (lookAhead $ try end) +tableColumnContent end = B.plain . mconcat <$> manyTill content (lookAhead $ try end) where content = continuation <|> inline continuation = try $ char '\\' >> newline >> return mempty blockQuote :: PandocMonad m => TWParser m B.Blocks -blockQuote = (B.blockQuote . mconcat) <$> parseHtmlContent "blockquote" block +blockQuote = B.blockQuote . mconcat <$> parseHtmlContent "blockquote" block noautolink :: PandocMonad m => TWParser m B.Blocks noautolink = do @@ -285,7 +285,7 @@ noautolink = do parseContent = parseFromString' $ many block para :: PandocMonad m => TWParser m B.Blocks -para = (result . mconcat) <$> many1Till inline endOfParaElement +para = result . mconcat <$> many1Till inline endOfParaElement where endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement endOfInput = try $ skipMany blankline >> skipSpaces >> eof @@ -428,13 +428,13 @@ nestedString end = innerSpace <|> countChar 1 nonspaceChar innerSpace = try $ many1Char spaceChar <* notFollowedBy end boldCode :: PandocMonad m => TWParser m B.Inlines -boldCode = try $ (B.strong . B.code . fromEntities) <$> enclosed (string "==") nestedString +boldCode = try $ B.strong . B.code . fromEntities <$> enclosed (string "==") nestedString htmlComment :: PandocMonad m => TWParser m B.Inlines htmlComment = htmlTag isCommentTag >> return mempty code :: PandocMonad m => TWParser m B.Inlines -code = try $ (B.code . fromEntities) <$> enclosed (char '=') nestedString +code = try $ B.code . fromEntities <$> enclosed (char '=') nestedString codeHtml :: PandocMonad m => TWParser m B.Inlines codeHtml = do diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index b105b587d..6691d8381 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -282,7 +282,7 @@ definitionListStart = try $ do -- break. definitionListItem :: PandocMonad m => ParserT Text ParserState m (Inlines, [Blocks]) definitionListItem = try $ do - term <- (mconcat . intersperse B.linebreak) <$> many1 definitionListStart + term <- mconcat . intersperse B.linebreak <$> many1 definitionListStart def' <- string ":=" *> optional whitespace *> (multilineDef <|> inlineDef) return (term, def') where inlineDef :: PandocMonad m => ParserT Text ParserState m [Blocks] @@ -378,7 +378,7 @@ table = try $ do let nbOfCols = maximum $ map length (headers:rows) let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows) let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain caption) (zip aligns (replicate nbOfCols ColWidthDefault)) (TableHead nullAttr $ toHeaderRow $ map snd headers) @@ -439,7 +439,7 @@ inlineParsers = [ str , link , image , mark - , (B.str . T.singleton) <$> characterReference + , B.str . T.singleton <$> characterReference , smartPunctuation inline , symbol ] diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 245df6f08..5c5b3c4e9 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -267,7 +267,7 @@ table = try $ do let rowsPadded = map (pad size) rows' let headerPadded = if null tableHeader then mempty else pad size tableHeader let toRow = Row nullAttr . map B.simpleCell - toHeaderRow l = if null l then [] else [toRow l] + toHeaderRow l = [toRow l | not (null l)] return $ B.table B.emptyCaption (zip aligns (replicate ncolumns ColWidthDefault)) (TableHead nullAttr $ toHeaderRow headerPadded) -- cgit v1.2.3