From 4c3db9273fc8e92c2c23d4455a6ab178472be06d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 7 Feb 2020 08:32:47 -0800 Subject: Apply linter suggestions. Add fix_spacing to lint target in Makefile. --- src/Text/Pandoc/Readers/CSV.hs | 3 +-- src/Text/Pandoc/Readers/DocBook.hs | 3 +-- src/Text/Pandoc/Readers/Docx/Fields.hs | 4 ++-- src/Text/Pandoc/Readers/HTML.hs | 6 +++--- src/Text/Pandoc/Readers/Markdown.hs | 13 ++++++------- src/Text/Pandoc/Readers/Metadata.hs | 15 ++++++--------- src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/ContentReader.hs | 2 +- src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs | 8 ++++---- src/Text/Pandoc/Readers/Odt/StyleReader.hs | 2 +- src/Text/Pandoc/Readers/RST.hs | 14 ++++++-------- src/Text/Pandoc/Readers/TikiWiki.hs | 2 +- src/Text/Pandoc/Readers/Vimwiki.hs | 2 +- 13 files changed, 35 insertions(+), 43 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs index 62c94b3a0..47776b43d 100644 --- a/src/Text/Pandoc/Readers/CSV.hs +++ b/src/Text/Pandoc/Readers/CSV.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Readers.RST @@ -42,4 +42,3 @@ readCSV _opts s = widths = replicate numcols 0 Right [] -> return $ B.doc mempty Left e -> throwError $ PandocParsecError s e - diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 535ade658..0b45460b2 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1106,9 +1106,8 @@ equation e constructor = readMath :: (Element -> Bool) -> (Element -> b) -> [b] readMath childPredicate fromElement = - ( map (fromElement . everywhere (mkT removePrefix)) + map (fromElement . everywhere (mkT removePrefix)) $ filterChildren childPredicate e - ) -- | Get the actual text stored in a CData block. 'showContent' -- returns the text still surrounded by the [[CDATA]] tags. diff --git a/src/Text/Pandoc/Readers/Docx/Fields.hs b/src/Text/Pandoc/Readers/Docx/Fields.hs index 05d9dd697..905d6f4c4 100644 --- a/src/Text/Pandoc/Readers/Docx/Fields.hs +++ b/src/Text/Pandoc/Readers/Docx/Fields.hs @@ -42,7 +42,7 @@ escapedQuote = string "\\\"" $> "\\\"" inQuotes :: Parser T.Text inQuotes = - (try escapedQuote) <|> (anyChar >>= (\c -> return $ T.singleton c)) + try escapedQuote <|> (anyChar >>= (\c -> return $ T.singleton c)) quotedString :: Parser T.Text quotedString = do @@ -50,7 +50,7 @@ quotedString = do T.concat <$> manyTill inQuotes (try (char '"')) unquotedString :: Parser T.Text -unquotedString = T.pack <$> manyTill anyChar (try $ lookAhead space *> return () <|> eof) +unquotedString = T.pack <$> manyTill anyChar (try $ lookAhead space Data.Functor.$> () <|> eof) fieldArgument :: Parser T.Text fieldArgument = quotedString <|> unquotedString diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 979bb2de5..aa73cd9a1 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -403,8 +403,8 @@ pDiv = try $ do pRawHtmlBlock :: PandocMonad m => TagParser m Blocks pRawHtmlBlock = do - raw <- (pHtmlBlock "script" <|> pHtmlBlock "style" <|> pHtmlBlock "textarea" - <|> pRawTag) + raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pHtmlBlock "textarea" + <|> pRawTag exts <- getOption readerExtensions if extensionEnabled Ext_raw_html exts && not (T.null raw) then return $ B.rawBlock "html" raw @@ -976,7 +976,7 @@ isSpecial '\8221' = True isSpecial _ = False pSymbol :: PandocMonad m => InlinesParser m Inlines -pSymbol = satisfy isSpecial >>= return . B.str . T.singleton +pSymbol = B.str . T.singleton <$> satisfy isSpecial isBad :: Char -> Bool isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index c09c110aa..70fba0165 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -21,10 +21,9 @@ import Prelude import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace) -import Data.List (sortBy, transpose, elemIndex) +import Data.List (transpose, elemIndex, sortOn) import qualified Data.Map as M import Data.Maybe -import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -247,7 +246,7 @@ yamlMetaBlock = try $ do newMetaF <- yamlBsToMeta parseBlocks $ UTF8.fromTextLazy $ TL.fromStrict rawYaml -- Since `<>` is left-biased, existing values are not touched: - updateState $ \st -> st{ stateMeta' = (stateMeta' st) <> newMetaF } + updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF } return mempty stopLine :: PandocMonad m => MarkdownParser m () @@ -1107,7 +1106,7 @@ rawHtmlBlocks = do return (return (B.rawBlock "html" $ stripMarkdownAttribute raw) <> contents <> return (B.rawBlock "html" rawcloser))) - <|> (return (return (B.rawBlock "html" raw) <> contents)) + <|> return (return (B.rawBlock "html" raw) <> contents) updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock } return result @@ -1170,7 +1169,7 @@ simpleTableHeader headless = try $ do else rawHeads heads <- fmap sequence $ - mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads' + mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads' return (heads, aligns, indices) -- Returns an alignment type for a table, based on a list of strings @@ -1183,7 +1182,7 @@ alignType [] _ = AlignDefault alignType strLst len = let nonempties = filter (not . T.null) $ map trimr strLst (leftSpace, rightSpace) = - case sortBy (comparing T.length) nonempties of + case sortOn T.length nonempties of (x:_) -> (T.head x `elem` [' ', 't'], T.length x < len) [] -> (False, False) in case (leftSpace, rightSpace) of @@ -1287,7 +1286,7 @@ multilineTableHeader headless = try $ do then replicate (length dashes) "" else map (T.unlines . map trim) rawHeadsList heads <- fmap sequence $ - mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads + mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads return (heads, aligns, indices') -- Parse a grid table: starts with row of '-' on top, then header diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index 701e65980..23ceb40f9 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -40,8 +40,8 @@ yamlBsToMeta :: PandocMonad m yamlBsToMeta pBlocks bstr = do pos <- getPosition case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of - Right ((YAML.Doc (YAML.Mapping _ _ o)):_) - -> (fmap Meta) <$> yamlMap pBlocks o + Right (YAML.Doc (YAML.Mapping _ _ o):_) + -> fmap Meta <$> yamlMap pBlocks o Right [] -> return . return $ mempty Right [YAML.Doc (YAML.Scalar _ YAML.SNull)] -> return . return $ mempty @@ -84,12 +84,10 @@ toMetaValue pBlocks x = asBlocks p = MetaBlocks . B.toList <$> p checkBoolean :: Text -> Maybe Bool -checkBoolean t = - if t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE" - then Just True - else if t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" - then Just False - else Nothing +checkBoolean t + | t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE" = Just True + | t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" = Just False + | otherwise = Nothing yamlToMetaValue :: PandocMonad m => ParserT Text ParserState m (F Blocks) @@ -133,4 +131,3 @@ yamlMap pBlocks o = do return $ do v' <- fv return (k, v') - diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index d5eb7e708..ba212ebba 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -183,14 +183,14 @@ a >>?! f = a >>> right f => FallibleArrow a x f (b,b') -> (b -> b' -> c) -> FallibleArrow a x f c -a >>?% f = a >>?^ (uncurry f) +a >>?% f = a >>?^ uncurry f --- (^>>?%) :: (ArrowChoice a) => (x -> Either f (b,b')) -> (b -> b' -> c) -> FallibleArrow a x f c -a ^>>?% f = arr a >>?^ (uncurry f) +a ^>>?% f = arr a >>?^ uncurry f --- (>>?%?) :: (ArrowChoice a) diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index ff8cdc5fa..167d4403c 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -792,7 +792,7 @@ read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plai image_attributes :: Maybe T.Text -> Maybe T.Text -> Attr image_attributes x y = - ( "", [], (dim "width" x) ++ (dim "height" y)) + ( "", [], dim "width" x ++ dim "height" y) where dim _ (Just "") = [] dim name (Just v) = [(name, v)] diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index ea4e09403..9b2d3411d 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -163,7 +163,7 @@ swapStack' state stack pushElement :: XML.Element -> XMLConverterState nsID extraState -> XMLConverterState nsID extraState -pushElement e state = state { parentElements = e:(parentElements state) } +pushElement e state = state { parentElements = e:parentElements state } -- | Pop the top element from the call stack, unless it is the last one. popElement :: XMLConverterState nsID extraState @@ -605,8 +605,8 @@ executeInSub nsID name a = keepingTheValue (findChild nsID name) >>> ignoringState liftFailure >>? switchingTheStack a - where liftFailure (_, (Left f)) = Left f - liftFailure (x, (Right e)) = Right (x, e) + where liftFailure (_, Left f) = Left f + liftFailure (x, Right e) = Right (x, e) -------------------------------------------------------------------------------- -- Iterating over children @@ -702,7 +702,7 @@ prepareMatchersC :: (NameSpaceID nsID) => [(nsID, ElementName, FallibleXMLConverter nsID extraState x x)] -> ContentMatchConverter nsID extraState x --prepareMatchersC = foldSs . (map $ uncurry3 makeMatcherC) -prepareMatchersC = reverseComposition . (map $ uncurry3 makeMatcherC) +prepareMatchersC = reverseComposition . map (uncurry3 makeMatcherC) -- | Takes a list of element-data - converter groups and -- * Finds all content of the current element diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index 99fa05880..c2eae0b82 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -120,7 +120,7 @@ fontPitchReader = executeInSub NsOffice "font-face-decls" ( lookupDefaultingAttr NsStyle "font-pitch" )) >>?^ ( M.fromList . foldl accumLegalPitches [] ) - ) `ifFailedDo` (returnV (Right M.empty)) + ) `ifFailedDo` returnV (Right M.empty) where accumLegalPitches ls (Nothing,_) = ls accumLegalPitches ls (Just n,p) = (n,p):ls diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 68b853ca5..ba1902a6e 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -166,10 +166,8 @@ parseRST = do blocks <- B.toList <$> parseBlocks citations <- (sort . M.toList . stateCitations) <$> getState citationItems <- mapM parseCitation citations - let refBlock = if null citationItems - then [] - else [Div ("citations",[],[]) $ - B.toList $ B.definitionList citationItems] + let refBlock = [Div ("citations",[],[]) $ + B.toList $ B.definitionList citationItems | not (null citationItems)] standalone <- getOption readerStandalone state <- getState let meta = stateMeta state @@ -225,7 +223,7 @@ rawFieldListItem minIndent = try $ do first <- anyLine rest <- option "" $ try $ do lookAhead (count indent (char ' ') >> spaceChar) indentedBlock - let raw = (if T.null first then "" else (first <> "\n")) <> rest <> "\n" + let raw = (if T.null first then "" else first <> "\n") <> rest <> "\n" return (name, raw) fieldListItem :: PandocMonad m => Int -> RSTParser m (Inlines, [Blocks]) @@ -706,7 +704,7 @@ directive' = do tit <- B.para . B.strong <$> parseInlineFromText (trim top <> if T.null subtit then "" - else (": " <> subtit)) + else ": " <> subtit) bod <- parseFromString' parseBlocks body' return $ B.divWith (name,"sidebar":classes,keyvals) $ tit <> bod "topic" -> @@ -1446,14 +1444,14 @@ roleAfter = try $ do unmarkedInterpretedText :: PandocMonad m => RSTParser m Text unmarkedInterpretedText = try $ do atStart (char '`') - contents <- mconcat <$> (many1 + contents <- mconcat <$> many1 ( many1 (noneOf "`\\\n") <|> (char '\\' >> ((\c -> ['\\',c]) <$> noneOf "\n")) <|> (string "\n" <* notFollowedBy blankline) <|> try (string "`" <* notFollowedBy (() <$ roleMarker) <* lookAhead (satisfy isAlphaNum)) - )) + ) char '`' return $ T.pack contents diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index 501c204f5..438191ba1 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -55,7 +55,7 @@ type TikiWikiParser = ParserT Text ParserState -- tryMsg :: Text -> TikiWikiParser m a -> TikiWikiParser m a -tryMsg msg p = try p (T.unpack msg) +tryMsg msg p = try p T.unpack msg skip :: TikiWikiParser m a -> TikiWikiParser m () skip parser = Control.Monad.void parser diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index d641df8a5..755eea45f 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -147,7 +147,7 @@ header = try $ do contents <- trimInlines . mconcat <$> manyTill inline (try $ spaceChar >> string eqs >> many spaceChar >> newline) attr <- registerHeader (makeId contents, - if sp == "" then [] else ["justcenter"], []) contents + ["justcenter" | not (null sp)], []) contents return $ B.headerWith attr lev contents para :: PandocMonad m => VwParser m Blocks -- cgit v1.2.3