From 527346cc7e2bc874092be2f6793001860e10a719 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 7 Nov 2020 19:38:03 +0100 Subject: Lint code in PRs and when committing to master (#6790) * Remove unused LANGUAGE pragmata * Apply HLint suggestions * Configure HLint to ignore some warnings * Lint code when committing to master --- src/Text/Pandoc/Readers/BibTeX.hs | 4 +--- src/Text/Pandoc/Readers/DocBook.hs | 2 +- src/Text/Pandoc/Readers/Docx.hs | 8 +++----- src/Text/Pandoc/Readers/Docx/Combine.hs | 2 +- src/Text/Pandoc/Readers/EPUB.hs | 7 +++---- src/Text/Pandoc/Readers/Markdown.hs | 2 +- src/Text/Pandoc/Readers/Metadata.hs | 2 +- src/Text/Pandoc/Readers/Odt/ContentReader.hs | 5 +++-- src/Text/Pandoc/Readers/Odt/Generic/Utils.hs | 1 - src/Text/Pandoc/Readers/Txt2Tags.hs | 2 +- 10 files changed, 15 insertions(+), 20 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/BibTeX.hs b/src/Text/Pandoc/Readers/BibTeX.hs index c367e75a1..b7285e306 100644 --- a/src/Text/Pandoc/Readers/BibTeX.hs +++ b/src/Text/Pandoc/Readers/BibTeX.hs @@ -26,7 +26,6 @@ import Text.Pandoc.Builder (setMeta, cite, str) import Data.Text (Text) import Citeproc (Lang(..), parseLang) import Citeproc.Locale (getLocale) -import Data.Maybe (fromMaybe) import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.Class (PandocMonad, lookupEnv) import Text.Pandoc.Citeproc.BibTeX as BibTeX @@ -49,7 +48,7 @@ readBibLaTeX = readBibTeX' BibTeX.Biblatex readBibTeX' :: PandocMonad m => Variant -> ReaderOptions -> Text -> m Pandoc readBibTeX' variant _opts t = do - lang <- fromMaybe (Lang "en" (Just "US")) . fmap parseLang + lang <- maybe (Lang "en" (Just "US")) parseLang <$> lookupEnv "LANG" locale <- case getLocale lang of Left e -> throwError $ PandocCiteprocError e @@ -67,4 +66,3 @@ readBibTeX' variant _opts t = do , citationHash = 0}] (str "[@*]")) $ Pandoc nullMeta [] - diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 190ba1d31..115ac617c 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1046,7 +1046,7 @@ parseEntry cn el = do _ -> 1 let colSpan = toColSpan el let align = toAlignment el - (fmap (cell align 1 colSpan) . (parseMixed plain) . elContent) el + (fmap (cell align 1 colSpan) . parseMixed plain . elContent) el getInlines :: PandocMonad m => Element -> DB m Inlines getInlines e' = trimInlines . mconcat <$> diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 31c0660fd..00de6a0cd 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} {- | @@ -417,7 +416,7 @@ parPartToInlines' (BookMark _ anchor) = (modify $ \s -> s { docxAnchorMap = M.insert anchor prevAnchor anchorMap}) return mempty Nothing -> do - exts <- readerExtensions <$> asks docxOptions + exts <- asks (readerExtensions . docxOptions) let newAnchor = if not inHdrBool && anchor `elem` M.elems anchorMap then uniqueIdent exts [Str anchor] @@ -462,7 +461,7 @@ makeHeaderAnchor' (Header n (ident, classes, kvs) ils) | (c:_) <- filter isAnchorSpan ils , (Span (anchIdent, ["anchor"], _) cIls) <- c = do hdrIDMap <- gets docxAnchorMap - exts <- readerExtensions <$> asks docxOptions + exts <- asks (readerExtensions . docxOptions) let newIdent = if T.null ident then uniqueIdent exts ils (Set.fromList $ M.elems hdrIDMap) else ident @@ -475,7 +474,7 @@ makeHeaderAnchor' (Header n (ident, classes, kvs) ils) makeHeaderAnchor' (Header n (ident, classes, kvs) ils) = do hdrIDMap <- gets docxAnchorMap - exts <- readerExtensions <$> asks docxOptions + exts <- asks (readerExtensions . docxOptions) let newIdent = if T.null ident then uniqueIdent exts ils (Set.fromList $ M.elems hdrIDMap) else ident @@ -736,4 +735,3 @@ docxToOutput opts (Docx (Document _ body)) = addAuthorAndDate :: T.Text -> Maybe T.Text -> [(T.Text, T.Text)] addAuthorAndDate author mdate = ("author", author) : maybe [] (\date -> [("date", date)]) mdate - diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 427a73dbe..46112af19 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -109,7 +109,7 @@ ilModifierAndInnards ils = case viewl $ unMany ils of Underline lst -> Just (Modifier underline, lst) Superscript lst -> Just (Modifier superscript, lst) Subscript lst -> Just (Modifier subscript, lst) - Link attr lst tgt -> Just (Modifier $ linkWith attr (fst tgt) (snd tgt), lst) + Link attr lst tgt -> Just (Modifier $ uncurry (linkWith attr) tgt, lst) Span attr lst -> Just (AttrModifier spanWith attr, lst) _ -> Nothing _ -> Nothing diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 5d7984512..5e3326e6d 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as BL (ByteString) import Data.List (isInfixOf) import qualified Data.Text as T import qualified Data.Map as M (Map, elems, fromList, lookup) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (mapMaybe) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Network.URI (unEscapeString) @@ -139,8 +139,7 @@ parseManifest content coverId = do where findCover e = maybe False (isInfixOf "cover-image") (findAttr (emptyName "properties") e) - || fromMaybe False - (liftM2 (==) coverId (findAttr (emptyName "id") e)) + || Just True == liftM2 (==) coverId (findAttr (emptyName "id") e) parseItem e = do uid <- findAttrE (emptyName "id") e href <- findAttrE (emptyName "href") e @@ -191,7 +190,7 @@ getManifest archive = do let rootdir = dropFileName manifestFile --mime <- lookup "media-type" as manifest <- findEntryByPathE manifestFile archive - fmap ((,) rootdir) (parseXMLDocE . UTF8.toStringLazy . fromEntry $ manifest) + (rootdir,) <$> (parseXMLDocE . UTF8.toStringLazy . fromEntry $ manifest) -- Fixup diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index d8296ea61..64a2db288 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1918,7 +1918,7 @@ note = try $ do -- notes, to avoid infinite looping with notes inside -- notes: let contents' = runF contents st{ stateNotes' = M.empty } - let addCitationNoteNum (c@Citation{}) = + let addCitationNoteNum c@Citation{} = c{ citationNoteNum = noteNum } let adjustCite (Cite cs ils) = Cite (map addCitationNoteNum cs) ils diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index 0d49a7fa8..b9a8653d5 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -70,7 +70,7 @@ yamlBsToRefs :: PandocMonad m -> ParserT Text ParserState m (F [MetaValue]) yamlBsToRefs pMetaValue idpred bstr = case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of - Right (YAML.Doc o@(YAML.Mapping _ _ _):_) + Right (YAML.Doc o@YAML.Mapping{}:_) -> case lookupYAML "references" o of Just (YAML.Sequence _ _ ns) -> do let g n = case lookupYAML "id" n of diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 24391dbf0..43c44e7e9 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -25,6 +25,7 @@ module Text.Pandoc.Readers.Odt.ContentReader import Control.Applicative hiding (liftA, liftA2, liftA3) import Control.Arrow +import Control.Monad ((<=<)) import qualified Data.ByteString.Lazy as B import Data.Foldable (fold) @@ -352,11 +353,11 @@ modifierFromStyleDiff propertyTriple = lookupPreviousValue f = lookupPreviousStyleValue (fmap f . textProperties) - lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties) + lookupPreviousValueM f = lookupPreviousStyleValue (f <=< textProperties) lookupPreviousStyleValue f (ReaderState{..},_,mFamily) = findBy f (extendedStylePropertyChain styleTrace styleSet) - <|> ( f =<< fmap (lookupDefaultStyle' styleSet) mFamily ) + <|> (f . lookupDefaultStyle' styleSet =<< mFamily) type ParaModifier = Blocks -> Blocks diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs index 146f35319..6dc56a0d9 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Reader.Odt.Generic.Utils diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 5c5b3c4e9..474e4fac0 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -464,7 +464,7 @@ macro = try $ do name <- string "%%" *> oneOfStringsCI (map fst commands) optional (try $ enclosed (char '(') (char ')') anyChar) lookAhead (spaceChar <|> oneOf specialChars <|> newline) - maybe (return mempty) (\f -> B.str <$> asks f) (lookup name commands) + maybe (return mempty) (\f -> asks (B.str . f)) (lookup name commands) where commands = [ ("date", date), ("mtime", mtime) , ("infile", T.pack . infile), ("outfile", T.pack . outfile)] -- cgit v1.2.3