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

.github/workflows/lint.yml

@@ -0,0 +1,30 @@
+name: Lint
+
+# Trigger the workflow on push or pull request, but only for the
+# master branch
+on:
+  pull_request:
+    branch: [master]
+  push:
+    branch: [master]
+    paths-ignore:
+      - LICENSE
+      - README.md
+      - CHANGELOG.md
+      - stack.yaml
+      - .travis.yml
+
+jobs:
+  lint:
+    name: Lint
+    runs-on: ubuntu-latest
+    env:
+      hlint_script: https://raw.github.com/ndmitchell/hlint/master/misc/run.sh
+
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v2
+
+      - name: Download and run hlint
+        run: |
+          curl -sSL "${hlint_script}" | sh -s .

.hlint.yaml

@@ -2,85 +2,107 @@
 # https://github.com/ndmitchell/hlint
 ##########################
 
-# This file contains a template configuration file, which is typically
-# placed as .hlint.yaml in the root of your project
-
-
 # Specify additional command line arguments
 #
 - arguments: [--color=auto, --cpp-ansi]
 
-
-# Control which extensions/flags/modules/functions can be used
-#
-# - extensions:
-#   - default: false # all extension are banned by default
-#   - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
-#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
-#
-# - flags:
-#   - {name: -w, within: []} # -w is allowed nowhere
-#
-# - modules:
-#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
-#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
-#
-# - functions:
-#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
-
-
-# Add custom hints for this project
-#
-# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
-# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
-
-
-# Turn on hints that are off by default
-#
-# Ban "module X(module X) where", to require a real export list
-# - warn: {name: Use explicit module export list}
-#
-# Replace a $ b $ c with a . b $ c
-# - group: {name: dollar, enabled: true}
-#
-# Generalise map to fmap, ++ to <>
-# - group: {name: generalise, enabled: true}
-
-
 # Ignore some builtin hints
-# - ignore: {name: Use let}
-# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
-# - ignore: {name: "Use section"}
-# - ignore: {name: "Use camelCase"}
-# - ignore: {name: "Use list comprehension"}
-# - ignore: {name: "Redundant if"}
+#
 - ignore: {name: "Avoid lambda"}
 - ignore: {name: "Eta reduce"}
 - ignore: {name: "Evaluate"}
-- ignore: {name: "Monad law, left identity", module: "Text.Pandoc.App.OutputSettings"}
-- ignore: {name: "Reduce duplication", module: "Text.Pandoc.Readers.Markdown"}
+- ignore: {name: "Reduce duplication"} # TODO: could be more fine-grained
 - ignore: {name: "Use &&&"}
 - ignore: {name: "Use String"}
 - ignore: {name: "Use fmap"}  # specific for GHC 7.8 compat
-- ignore: {name: "Use forM_", module: "Text.Pandoc.Readers.DocBook"}
 - ignore: {name: "Use isDigit"}
-- ignore: {name: "Use tuple-section", module: "Text.Pandoc.Readers.EPUB"}
-- ignore: {name: "Use uncurry", module: "Text.Pandoc.Readers.Docx.Combine"}
+
+- ignore:
+    name: "Monad law, left identity"
+    within: Text.Pandoc.App.OutputSettings
+
+- ignore:
+    name: "Move brackets to avoid $"
+    within: Text.Pandoc.Writers.CslJson
+
+- ignore:
+    name: "Redundant <$>"
+    within:
+      - Text.Pandoc.Readers.Docx.Parse
+      - Text.Pandoc.Writers.MediaWiki
+      - Text.Pandoc.Writers.OpenDocument
+      - Text.Pandoc.Writers.Powerpoint.Output
+      - Text.Pandoc.Writers.Powerpoint.Presentation
+
+- ignore:
+    name: "Redundant return"
+    within: Text.Pandoc.Citeproc.BibTeX
+
+# TODO: check
+- ignore:
+    name: "Redundant bracket"
+    within:
+      - Text.Pandoc.Citeproc
+      - Text.Pandoc.Citeproc.BibTeX
+      - Text.Pandoc.Citeproc.MetaValue
+
 - ignore:
     name: "Use <$>"
     within:
       - Text.Pandoc.Readers.LaTeX
       - Text.Pandoc.Readers.Markdown
+
 - ignore:
     name: "Use camelCase"
     within:
       - Tests.Writers.Docbook
       - Tests.Writers.Native
+      - Text.Pandoc.Citeproc
       - Text.Pandoc.Extensions
       - Text.Pandoc.Lua.Marshaling.Version
       - Text.Pandoc.Lua.Module.Utils
       - Text.Pandoc.Readers.Odt.ContentReader
       - Text.Pandoc.Readers.Odt.Namespaces
 
+- ignore:
+    name: "Use forM_"
+    within:
+      - Text.Pandoc.Readers.DocBook
+
+- ignore:
+    name: "Use Just"
+    within:
+      - Text.Pandoc.Citeproc.MetaValue
+      - Text.Pandoc.Readers.Odt.ContentReader
+      - Text.Pandoc.Writers.Roff
+
+- ignore:
+    name: "Use list comprehension"
+    within: Text.Pandoc.Citeproc.BibTeX
+
+- ignore:
+    name: "Use list literal pattern"
+    within: Text.Pandoc.Citeproc.MetaValue
+
+# TODO: check
+- ignore:
+    name: "Use second"
+    within:
+      - Text.Pandoc.Citeproc.BibTeX
+      - Text.Pandoc.Citeproc.Locator
+
+# TODO: check
+- ignore:
+    name: "Use sortOn"
+    within: Text.Pandoc.Writers.OpenDocument
+
+- ignore:
+    name: "Use tuple-section"
+    within:
+      - Text.Pandoc.Readers.EPUB
+      - Text.Pandoc.ImageSize
+      - Text.Pandoc.Readers.Markdown
+      - Text.Pandoc.Readers.RST
+
 # Define some custom infix operators
 # - fixity: infixr 3 ~^#^~

src/Text/Pandoc/Citeproc.hs

@@ -1,18 +1,14 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveTraversable #-}
 module Text.Pandoc.Citeproc
   ( processCitations )
 where
 
-import Citeproc as Citeproc
+import Citeproc
 import Citeproc.Pandoc ()
 import Text.Pandoc.Citeproc.Locator (parseLocator)
 import Text.Pandoc.Citeproc.CslJson (cslJsonToReferences)

src/Text/Pandoc/Citeproc/MetaValue.hs

@@ -147,7 +147,7 @@ metaValueToDate (MetaMap m) =
                   mapMaybe metaValueToDateParts xs
                 Just _ -> []
                 Nothing ->
-                  maybe [] (:[]) $ metaValueToDateParts (MetaMap m)
+                  maybeToList $ metaValueToDateParts (MetaMap m)
   circa = fromMaybe False $
             M.lookup "circa" m >>= metaValueToBool
   season = M.lookup "season" m >>= metaValueToInt
@@ -251,4 +251,3 @@ normalizeKey k =
     "pmid"  -> "PMID"
     "url"   -> "URL"
     x       -> x
-

src/Text/Pandoc/Lua/Filter.hs

@@ -160,7 +160,7 @@ mconcatMapM :: (Monad m) => (a -> m [a]) -> [a] -> m [a]
 mconcatMapM f = fmap mconcat . mapM f
 
 hasOneOf :: LuaFilter -> [String] -> Bool
-hasOneOf (LuaFilter fnMap) = any (\k -> Map.member k fnMap)
+hasOneOf (LuaFilter fnMap) = any (`Map.member` fnMap)
 
 contains :: LuaFilter -> String -> Bool
 contains (LuaFilter fnMap) = (`Map.member` fnMap)

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 []
-

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 <$>

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
-

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

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
 

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

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

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

src/Text/Pandoc/Readers/Odt/Generic/Utils.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ViewPatterns  #-}
 {- |
    Module      : Text.Pandoc.Reader.Odt.Generic.Utils

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)]

src/Text/Pandoc/Writers/CslJson.hs

@@ -34,15 +34,15 @@ import Control.Monad.Identity
 import Citeproc.Locale (getLocale)
 import Citeproc.CslJson
 import Text.Pandoc.Options (WriterOptions)
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe (mapMaybe)
 import Data.Aeson.Encode.Pretty         (Config (..), Indent (Spaces),
                                          NumberFormat (Generic),
                                          defConfig, encodePretty')
 
 writeCslJson :: PandocMonad m => WriterOptions -> Pandoc -> m Text
 writeCslJson _opts (Pandoc meta _) = do
-  let lang = fromMaybe (Lang "en" (Just "US")) $
-              parseLang <$> (lookupMeta "lang" meta >>= metaValueToText)
+  let lang = maybe (Lang "en" (Just "US")) parseLang
+               (lookupMeta "lang" meta >>= metaValueToText)
   locale <- case getLocale lang of
                Left e  -> throwError $ PandocCiteprocError e
                Right l -> return l

src/Text/Pandoc/Writers/FB2.hs

@@ -83,7 +83,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
      secs <- renderSections 1 blocks
      let body = el "body" $ el "title" (el "p" title) : secs
      notes <- renderFootnotes
-     (imgs,missing) <- fmap imagesToFetch get >>= \s -> lift (fetchImages s)
+     (imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch)
      let body' = replaceImagesWithAlt missing body
      let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
      return $ pack $ xml_head ++ showContent fb2_xml ++ "\n"

src/Text/Pandoc/Writers/HTML.hs

@@ -314,7 +314,7 @@ pandocToHtml opts (Pandoc meta blocks) = do
                           "/*]]>*/\n")
                           | otherwise -> mempty
                     Nothing -> mempty
-  let mCss :: Maybe [Text] = lookupContext "css" $ metadata
+  let mCss :: Maybe [Text] = lookupContext "css" metadata
   let context =   (if stHighlighting st
                       then case writerHighlightStyle opts of
                                 Just sty -> defField "highlighting-css"
@@ -1290,8 +1290,9 @@ inlineToHtml opts inline = do
                                         | any ((=="cite") . fst) kvs
                                           -> (Just attr, cs)
                                       cs -> (Nothing, cs)
-                                 H.q `fmap` inlineListToHtml opts lst'
-                                   >>= maybe return (addAttrs opts) maybeAttr
+                                 let addAttrsMb = maybe return (addAttrs opts)
+                                 inlineListToHtml opts lst' >>=
+                                   addAttrsMb maybeAttr . H.q
                                else (\x -> leftQuote >> x >> rightQuote)
                                     `fmap` inlineListToHtml opts lst
     (Math t str) -> do
@@ -1468,8 +1469,8 @@ cslEntryToHtml :: PandocMonad m
 cslEntryToHtml opts (Para xs) = do
   html5 <- gets stHtml5
   let inDiv :: Text -> Html -> Html
-      inDiv cls x = ((if html5 then H5.div else H.div)
-                      x ! A.class_ (toValue cls))
+      inDiv cls x = (if html5 then H5.div else H.div)
+                      x ! A.class_ (toValue cls)
   let go (Span ("",[cls],[]) ils)
         | cls == "csl-block" || cls == "csl-left-margin" ||
           cls == "csl-right-inline" || cls == "csl-indent"

src/Text/Pandoc/Writers/JATS.hs

@@ -108,7 +108,7 @@ docToJATS opts (Pandoc meta blocks) = do
                  (fmap chomp . inlinesToJATS opts)
                  meta
   main <- fromBlocks bodyblocks
-  notes <- reverse . map snd <$> gets jatsNotes
+  notes <- gets (reverse . map snd . jatsNotes)
   backs <- fromBlocks backblocks
   tagSet <- ask
   -- In the "Article Authoring" tag set, occurrence of fn-group elements

src/Text/Pandoc/Writers/Jira.hs

@@ -194,7 +194,7 @@ toJiraInlines inlines = do
                               Jira.Monospaced (escapeSpecialChars cs)
         Emph xs            -> styled Jira.Emphasis xs
         Underline xs       -> styled Jira.Insert xs
-        Image attr cap tgt -> imageToJira attr cap (fst tgt) (snd tgt)
+        Image attr cap tgt -> uncurry (imageToJira attr cap) tgt
         LineBreak          -> pure . singleton $ Jira.Linebreak
         Link attr xs tgt   -> toJiraLink attr tgt xs
         Math mtype cs      -> mathToJira mtype cs

src/Text/Pandoc/Writers/Ms.hs

@@ -489,8 +489,8 @@ cslEntryToMs atStart opts (Para xs) =
       | otherwise
          -> case xs of
            [] -> return mempty
-           (x:rest) -> (<>) <$> (inlineToMs opts x)
-                            <*> (cslEntryToMs False opts (Para rest))
+           (x:rest) -> (<>) <$> inlineToMs opts x
+                            <*> cslEntryToMs False opts (Para rest)
 cslEntryToMs _ opts x = blockToMs opts x
 
 

src/Text/Pandoc/Writers/OpenDocument.hs

@@ -601,7 +601,7 @@ inlineToOpenDocument o ils
       formatOpenDocument _fmtOpts = map (map toHlTok)
       toHlTok :: Token -> Doc Text
       toHlTok (toktype,tok) =
-        inTags False "text:span" [("text:style-name", (T.pack $ show toktype))] $ preformatted tok
+        inTags False "text:span" [("text:style-name", T.pack $ show toktype)] $ preformatted tok
       unhighlighted s = inlinedCode $ preformatted s
       preformatted s = handleSpaces $ escapeStringForXML s
       inlinedCode s = return $ inTags False "text:span" [("text:style-name", "Source_Text")] s

src/Text/Pandoc/Writers/Roff.hs

@@ -90,7 +90,7 @@ escapeString e = Text.concat . escapeString' e . Text.unpack
                 AllowUTF8 -> Text.singleton x : escapeString' escapeMode xs
                 AsciiOnly ->
                   let accents = catMaybes $ takeWhile isJust
-                        (map (\c -> Map.lookup c combiningAccentsMap) xs)
+                        (map (`Map.lookup` combiningAccentsMap) xs)
                       rest = drop (length accents) xs
                       s = case Map.lookup x characterCodeMap of
                             Just t  -> "\\[" <> Text.unwords (t:accents) <> "]"