hlint 3.5 → 3.6

raw patch · 62 files changed

+1054/−292 lines, 62 filesdep ~cmdargsdep ~ghcdep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: cmdargs, ghc, ghc-lib-parser, ghc-lib-parser-ex

API changes (from Hackage documentation)

Files

• .hlint.yaml +3/−1
• CHANGES.txt +31/−0
• LICENSE +1/−1
• README.md +2/−1
• data/default.yaml +3/−0
• data/do-block.yaml +2/−0
• data/hlint.yaml +267/−30
• hlint.cabal +10/−9
• src/Apply.hs +6/−4
• src/CC.hs +5/−4
• src/CmdLine.hs +23/−15
• src/Config/Haskell.hs +3/−2
• src/Config/Type.hs +2/−1
• src/Config/Yaml.hs +8/−7
• src/Extension.hs +3/−2
• src/GHC/All.hs +14/−7
• src/GHC/Util.hs +1/−1
• src/GHC/Util/ApiAnnotation.hs +4/−4
• src/GHC/Util/Brackets.hs +8/−2
• src/GHC/Util/DynFlags.hs +1/−1
• src/GHC/Util/FreeVars.hs +24/−7
• src/GHC/Util/HsExpr.hs +8/−8
• src/GHC/Util/Scope.hs +6/−6
• src/GHC/Util/SrcLoc.hs +2/−1
• src/GHC/Util/Unify.hs +22/−23
• src/GHC/Util/View.hs +3/−3
• src/HLint.hs +20/−4
• src/Hint/Bracket.hs +34/−5
• src/Hint/Comment.hs +2/−1
• src/Hint/Duplicate.hs +3/−2
• src/Hint/Export.hs +2/−3
• src/Hint/Extensions.hs +44/−17
• src/Hint/Import.hs +9/−9
• src/Hint/Lambda.hs +5/−4
• src/Hint/List.hs +9/−5
• src/Hint/ListRec.hs +3/−3
• src/Hint/Match.hs +4/−3
• src/Hint/Monad.hs +7/−6
• src/Hint/Naming.hs +15/−10
• src/Hint/NewType.hs +25/−18
• src/Hint/NumLiteral.hs +15/−3
• src/Hint/Pattern.hs +18/−12
• src/Hint/Pragma.hs +9/−4
• src/Hint/Restrict.hs +20/−14
• src/Hint/Smell.hs +3/−2
• src/Hint/Unsafe.hs +3/−3
• src/Idea.hs +3/−2
• src/Language/Haskell/HLint.hs +6/−5
• src/Refact.hs +4/−3
• src/Report.hs +3/−2
• src/SARIF.hs +178/−0
• src/Summary.hs +2/−1
• src/Test/Annotations.hs +3/−2
• src/Test/InputOutput.hs +5/−1
• src/Timing.hs +2/−1
• tests/cpp.test +39/−2
• tests/do-block.test +17/−0
• tests/flag-ignore-suggestions.test +38/−0
• tests/lhs.test +1/−1
• tests/parse-error.test +3/−3
• tests/sarif.test +38/−0
• tests/serialise.test +0/−1

@@ -16,6 +16,7 @@  - extensions:   - default: false+  - name: [ImportQualifiedPost]   - name: [DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving, NoMonomorphismRestriction, OverloadedStrings]   - name: [MultiWayIf, PatternGuards, RecordWildCards, ViewPatterns, PatternSynonyms, TupleSections, LambdaCase]   - name: [Rank2Types, ScopedTypeVariables]@@ -26,6 +27,7 @@   - name: [TemplateHaskell]   - name: [DerivingVia, DeriveGeneric, DataKinds]   - {name: CPP, within: [HsColour, Config.Yaml, Test.Annotations]} # so it can be disabled to avoid GPL code+  - {name: CPP, within: CmdLine} # Don't think this one is really necessary  - flags:   - default: false@@ -70,7 +72,7 @@  # doesn't fit with the other statements - ignore: {name: Use let, within: [HLint, Test.All]}-# this const has meaingful argument names+# this const has meaningful argument names - ignore: {name: Use const, within: Config.Yaml} # TEMPORARY: this lint is deleted on HEAD - ignore: {name: Use String}

@@ -1,5 +1,36 @@ Changelog for HLint (* = breaking change) +3.6, released 2023-06-26+    #1522, define __GLASGOW_HASKELL__ for cmdCpp+    #1519, don't suggest removing brackets that result in a parse error+    #1512, add hints to convert for [1..n] to replicateM n+    #1430, add ignore-suggestions flag+    #1517, support NO_COLOR+    #1505, don't suggest redundant brackets around constraints+    #1478, Fix no warn on (x.y) by treating x.y as atom+    #1481, more hints about concat/concatMap+    #1485, add more hints about using a Functor on a literal tuple+    #1479, add specialised not hints for notElem/notNull+    #1437, don't add/remove Monad constraints in replacements+    #1475, rules for (elem False) and (notElem True)+    #1476, generalise map-consuming rules from lists to Foldables/Traversables+    #1480, add hints about notElem and notNull+    #1482, support SARIF output+    #1470, drop support for GHC 9.0+*   #1470, move to GHC 9.6 parser+    #1449, add some more generalize hints that suggest fmap instead of map+    Never suggest concatForM_, because it doesn't exist+    #1467, and groups for warning on partial functions+    #1465, improve the timing information with -v flag+    #1454, filter Just . map f ==> map Just . mapMaybe f+    #1452, add more evaluate rules, e.g. fromJust (Just x) ==> x+    #1488, add <$>/<&> hints for Either+    #1447, make <$> hints also work on <&> (dualized)+    #1450, suggest nub/sort ==> nubSort with the extra hints+    #1451, isJust y && (x == fromJust y) ==> Just x == y+    #578, don't suggest numeric underscores for < 5 digits+    #1428, rename "Use map" hints that introduce tuple sections+    #1424, don't suggest sortOn; suggest avoiding `reverse . sort` 3.5, released 2022-09-20     #1421, change zip/repeat to map with tuple section     #1418, add more QuickCheck hints

@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2006-2022.+Copyright Neil Mitchell 2006-2023. All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -57,7 +57,7 @@  The first hint is marked as an warning, because using `concatMap` in preference to the two separate functions is always desirable. In contrast, the removal of brackets is probably a good idea, but not always. Reasons that a hint might be a suggestion include requiring an additional import, something not everyone agrees on, and functions only available in more recent versions of the base library. -Any configuration can be done via [.hlint.yaml](./README.md#customizing-the-hints) file.+Any configuration can be done via [.hlint.yaml](./README.md#customizing-the-hints) file. Any other file name, such as `.hlint.yml`, can only be used explicitly with the `--hint=FILE` option.  **Bug reports:** The suggested replacement should be equivalent - please report all incorrect suggestions not mentioned as known limitations. @@ -98,6 +98,7 @@ * [hint-man](https://github.com/apps/hint-man) automatically submits reviews to opened pull requests in your repositories with inline hints. * [CircleCI](https://circleci.com/orbs/registry/orb/haskell-works/hlint) has a plugin to run HLint more easily. * [haskell/actions](https://github.com/haskell/actions) has `hlint-setup` and `hlint-run` actions for GitHub.+* [haskell-actions/hlint-scan](https://github.com/haskell-actions/hlint-scan) is a GitHub action using HLint for [code scanning](https://docs.github.com/en/code-security/code-scanning/automatically-scanning-your-code-for-vulnerabilities-and-errors/about-code-scanning).  ### Automatically Applying Hints 

@@ -51,6 +51,9 @@ # # Generalise map to fmap, ++ to <> # - group: {name: generalise, enabled: true}+#+# Warn on use of partial functions+# - group: {name: partial, enabled: true}   # Ignore some builtin hints

@@ -0,0 +1,2 @@+- ignore: { }+- warn: {lhs: "case m of Just x -> y; Nothing -> Nothing", rhs: "do x <- m; y"}

@@ -6,30 +6,34 @@ - package:     name: base     modules:-    - import Prelude+    - import Control.Applicative     - import Control.Arrow+    - import Control.Concurrent.Chan     - import Control.Exception+    - import Control.Exception.Base     - import Control.Monad     - import Control.Monad.Trans.State-    - import qualified Data.Foldable-    - import Data.Foldable(asum, sequenceA_, traverse_, for_)-    - import Data.Traversable(traverse, for)-    - import Control.Applicative     - import Data.Bifunctor+    - import Data.Char+    - import Data.Either+    - import Data.Fixed+    - import Data.Foldable(asum, sequenceA_, traverse_, for_)     - import Data.Function     - import Data.Int-    - import Data.Char     - import Data.List as Data.List     - import Data.List as X+    - import Data.List.NonEmpty     - import Data.Maybe     - import Data.Monoid+    - import Data.Ratio+    - import Data.Traversable(traverse, for)+    - import Numeric+    - import Prelude+    - import System.Exit     - import System.IO-    - import Control.Concurrent.Chan     - import System.Mem.Weak-    - import Control.Exception.Base-    - import System.Exit-    - import Data.Either-    - import Numeric+    - import Text.Read+    - import qualified Data.Foldable      - import IO as System.IO     - import List as Data.List@@ -112,11 +116,9 @@     - warn: {lhs: head (sortBy f x), rhs: minimumBy f x, side: isCompare f}     - warn: {lhs: last (sortBy f x), rhs: maximumBy f x, side: isCompare f}     - warn: {lhs: reverse (sortBy f x), rhs: sortBy (flip f) x, name: Avoid reverse, side: isCompare f, note: Stabilizes sort order}-    - warn: {lhs: sortBy (flip (comparing f)), rhs: sortOn (Down . f)}-    - warn: {lhs: sortBy (comparing f), rhs: sortOn f, side: notEq f fst && notEq f snd}+    - warn: {lhs: sortBy (flip (comparing f)), rhs: sortBy (comparing (Data.Ord.Down . f))}     - warn: {lhs: reverse (sortOn f x), rhs: sortOn (Data.Ord.Down . f) x, name: Avoid reverse, note: Stabilizes sort order}-    # This suggestion likely costs performance, see https://github.com/ndmitchell/hlint/issues/669#issuecomment-607154496-    # - warn: {lhs: reverse (sort x), rhs: sortOn Data.Ord.Down x, name: Avoid reverse, note: Stabilizes sort order}+    - warn: {lhs: reverse (sort x), rhs: sortBy (comparing Data.Ord.Down) x, name: Avoid reverse, note: Stabilizes sort order}     - hint: {lhs: flip (g `on` h), rhs: flip g `on` h, name: Move flip}     - hint: {lhs: (f `on` g) `on` h, rhs: f `on` (g . h), name: Fuse on/on}     - warn: {lhs: if a >= b then a else b, rhs: max a b}@@ -144,6 +146,7 @@      - warn: {lhs: concat (map f x), rhs: concatMap f x}     - warn: {lhs: concat (f <$> x), rhs: concatMap f x}+    - warn: {lhs: concat (x <&> f), rhs: concatMap f x}     - warn: {lhs: concat (fmap f x), rhs: concatMap f x}     - hint: {lhs: "concat [a, b]", rhs: a ++ b}     - hint: {lhs: map f (map g x), rhs: map (f . g) x, name: Use map once}@@ -152,6 +155,8 @@     - warn: {lhs: take n (repeat x), rhs: replicate n x}     - warn: {lhs: map f (replicate n x), rhs: replicate n (f x)}     - warn: {lhs: map f (repeat x), rhs: repeat (f x)}+    - warn: {lhs: concatMap f (repeat x), rhs: cycle (f x)}+    - warn: {lhs: concat (repeat x), rhs: cycle x}     - warn: {lhs: "cycle [x]", rhs: repeat x}     - warn: {lhs: head (reverse x), rhs: last x}     - warn: {lhs: last (reverse x), rhs: head x, note: IncreasesLaziness}@@ -173,6 +178,8 @@     - warn: {lhs: foldr (.) id l z, rhs: foldr ($) z l}     - warn: {lhs: span (not . p), rhs: break p}     - warn: {lhs: break (not . p), rhs: span p}+    - warn: {lhs: span (notElem x), rhs: break (elem x), name: Use break}+    - warn: {lhs: break (notElem x), rhs: span (elem x), name: Use span}     - warn: {lhs: "(takeWhile p x, dropWhile p x)", rhs: span p x, note: DecreasesLaziness}     - warn: {lhs: fst (span p x), rhs: takeWhile p x}     - warn: {lhs: snd (span p x), rhs: dropWhile p x}@@ -206,7 +213,9 @@     - hint: {lhs: "\\x -> [x]", rhs: "(:[])", name: "Use :"}     - hint: {lhs: map f (zip x y), rhs: zipWith (curry f) x y, side: not (isApp f)}     - hint: {lhs: "map f (fromMaybe [] x)", rhs: "maybe [] (map f) x"}+    - hint: {lhs: "concatMap f (fromMaybe [] x)", rhs: "maybe [] (concatMap f) x"}     - warn: {lhs: not (elem x y), rhs: notElem x y}+    - warn: {lhs: not (notElem x y), rhs: elem x y}     - hint: {lhs: foldr f z (map g x), rhs: foldr (f . g) z x, name: Fuse foldr/map}     - warn: {lhs: "x ++ concatMap (' ':) y", rhs: "unwords (x:y)"}     - warn: {lhs: intercalate " ", rhs: unwords}@@ -230,6 +239,10 @@     - warn: {lhs: notElem False, rhs: and}     - warn: {lhs: True `elem` l, rhs: or l}     - warn: {lhs: False `notElem` l, rhs: and l}+    - warn: {lhs: elem False, rhs: any not, name: Use any}+    - warn: {lhs: notElem True, rhs: all not, name: Use all}+    - warn: {lhs: False `elem` l, rhs: any not l, name: Use any}+    - warn: {lhs: True `notElem` l, rhs: all not l, name: Use all}     - warn: {lhs: findIndex ((==) a), rhs: elemIndex a}     - warn: {lhs: findIndex (a ==), rhs: elemIndex a}     - warn: {lhs: findIndex (== a), rhs: elemIndex a}@@ -254,9 +267,9 @@     - warn: {lhs: "foldl (\\x _ -> a) b [1..c]", rhs: "iterate (\\x -> a) b !! c"}     - warn: {lhs: iterate id, rhs: repeat}     - warn: {lhs: zipWith f (repeat x), rhs: map (f x)}-    - warn: {lhs: zip (repeat x), rhs: "map (_noParen_ x,)", note: RequiresExtension TupleSections}+    - warn: {lhs: zip (repeat x), rhs: "map (_noParen_ x,)", note: RequiresExtension TupleSections, name: "Use map with tuple-section"}     - warn: {lhs: zipWith f y (repeat z), rhs: map (`f` z) y}-    - warn: {lhs: zip y (repeat z), rhs: "map (,_noParen_ z) y", note: RequiresExtension TupleSections}+    - warn: {lhs: zip y (repeat z), rhs: "map (,_noParen_ z) y", note: RequiresExtension TupleSections, name: "Use map with tuple-section"}     - warn: {lhs: listToMaybe (filter p x), rhs: find p x}     - warn: {lhs: zip (take n x) (take n y), rhs: take n (zip x y)}     - warn: {lhs: zip (take n x) (take m y), rhs: take (min n m) (zip x y), side: notEq n m, note: [IncreasesLaziness, DecreasesLaziness], name: Redundant take}@@ -278,17 +291,27 @@     - warn: {lhs: traverse (pure . f) x, rhs: pure (fmap f x), name: "Traversable law"}     - warn: {lhs: sequenceA (map f x), rhs: traverse f x}     - warn: {lhs: sequenceA (f <$> x), rhs: traverse f x}+    - warn: {lhs: sequenceA (x <&> f), rhs: traverse f x}     - warn: {lhs: sequenceA (fmap f x), rhs: traverse f x}     - warn: {lhs: sequenceA_ (map f x), rhs: traverse_ f x}     - warn: {lhs: sequenceA_ (f <$> x), rhs: traverse_ f x}+    - warn: {lhs: sequenceA_ (x <&> f), rhs: traverse_ f x}     - warn: {lhs: sequenceA_ (fmap f x), rhs: traverse_ f x}     - warn: {lhs: foldMap id, rhs: fold}     - warn: {lhs: fold (f <$> x), rhs: foldMap f x}+    - warn: {lhs: fold (x <&> f), rhs: foldMap f x}     - warn: {lhs: fold (fmap f x), rhs: foldMap f x}     - warn: {lhs: fold (map f x), rhs: foldMap f x}-    - warn: {lhs: foldMap f (g <$> x), rhs: foldMap (f . g) x, name: Fuse foldMap/fmap}+    - warn: {lhs: foldMap f (g <$> x), rhs: foldMap (f . g) x, name: Fuse foldMap/<$>}+    - warn: {lhs: foldMap f (x <&> g), rhs: foldMap (f . g) x, name: Fuse foldMap/<&>}     - warn: {lhs: foldMap f (fmap g x), rhs: foldMap (f . g) x, name: Fuse foldMap/fmap}     - warn: {lhs: foldMap f (map g x), rhs: foldMap (f . g) x, name: Fuse foldMap/map}+    - warn: {lhs: traverse f (fmap g x), rhs: traverse (f . g) x, name: Fuse traverse/fmap}+    - warn: {lhs: traverse f (g <$> x), rhs: traverse (f . g) x, name: Fuse traverse/<$>}+    - warn: {lhs: traverse f (x <&> g), rhs: traverse (f . g) x, name: Fuse traverse/<&>}+    - warn: {lhs: traverse_ f (fmap g x), rhs: traverse_ (f . g) x, name: Fuse traverse_/fmap}+    - warn: {lhs: traverse_ f (g <$> x), rhs: traverse_ (f . g) x, name: Fuse traverse_/<$>}+    - warn: {lhs: traverse_ f (x <&> g), rhs: traverse_ (f . g) x, name: Fuse traverse_/<&>}      # BY @@ -450,10 +473,13 @@      - warn: {lhs: fmap f (fmap g x), rhs: fmap (f . g) x, name: Functor law}     - warn: {lhs: f <$> g <$> x, rhs: f . g <$> x, name: Functor law}+    - warn: {lhs: x <&> g <&> f, rhs: x <&> f . g, name: Functor law}     - warn: {lhs: fmap id, rhs: id, name: Functor law}     - warn: {lhs: id <$> x, rhs: x, name: Functor law}+    - warn: {lhs: x <&> id, rhs: x, name: Functor law}     - hint: {lhs: fmap f $ x, rhs: f <$> x, side: isApp x || isAtom x}     - hint: {lhs: \x -> a <$> b x, rhs: fmap a . b}+    - hint: {lhs: \x -> b x <&> a, rhs: fmap a . b}     - hint: {lhs: x *> pure y, rhs: x Data.Functor.$> y}     - hint: {lhs: x *> return y, rhs: x Data.Functor.$> y}     - hint: {lhs: pure x <* y, rhs: x Data.Functor.<$ y}@@ -464,6 +490,12 @@     - hint: {lhs: x <&> const y, rhs: x Data.Functor.$> y}     - hint: {lhs: x <&> pure y, rhs: x Data.Functor.$> y}     - hint: {lhs: x <&> return y, rhs: x Data.Functor.$> y}+    - warn: {lhs: "fmap f (x,b)", rhs: "(x,f b)", name: Using fmap on tuple}+    - warn: {lhs: "f <$> (x,b)", rhs: "(x,f b)", name: Using <$> on tuple}+    - warn: {lhs: "(x,b) <&> f", rhs: "(x,f b)", name: Using <&> on tuple}+    - warn: {lhs: "fmap f (x,y,b)", rhs: "(x,y,f b)", name: Using fmap on tuple}+    - warn: {lhs: "f <$> (x,y,b)", rhs: "(x,y,f b)", name: Using <$> on tuple}+    - warn: {lhs: "(x,y,b) <&> f", rhs: "(x,y,f b)", name: Using <&> on tuple}      # APPLICATIVE @@ -507,23 +539,29 @@     - warn: {lhs: sequence (map f x), rhs: mapM f x}     - warn: {lhs: sequence_ (map f x), rhs: mapM_ f x}     - warn: {lhs: sequence (f <$> x), rhs: mapM f x}+    - warn: {lhs: sequence (x <&> f), rhs: mapM f x}     - warn: {lhs: sequence (fmap f x), rhs: mapM f x}     - warn: {lhs: sequence_ (f <$> x), rhs: mapM_ f x}+    - warn: {lhs: sequence_ (x <&> f), rhs: mapM_ f x}     - warn: {lhs: sequence_ (fmap f x), rhs: mapM_ f x}     - hint: {lhs: flip mapM, rhs: Control.Monad.forM}     - hint: {lhs: flip mapM_, rhs: Control.Monad.forM_}     - hint: {lhs: flip forM, rhs: mapM}     - hint: {lhs: flip forM_, rhs: mapM_}     - warn: {lhs: when (not x), rhs: unless x}+    - warn: {lhs: when (notElem x y), rhs: unless (elem x y), name: Use unless}     - warn: {lhs: unless (not x), rhs: when x}+    - warn: {lhs: unless (notElem x y), rhs: when (elem x y), name: Use when}     - warn: {lhs: x >>= id, rhs: Control.Monad.join x}     - warn: {lhs: id =<< x, rhs: Control.Monad.join x}     - hint: {lhs: join (f <$> x), rhs: f =<< x}+    - hint: {lhs: join (x <&> f), rhs: f =<< x}     - hint: {lhs: join (fmap f x), rhs: f =<< x}     - hint: {lhs: a >> pure (), rhs: Control.Monad.void a, side: isAtom a || isApp a}     - hint: {lhs: a >> return (), rhs: Control.Monad.void a, side: isAtom a || isApp a}     - warn: {lhs: fmap (const ()), rhs: Control.Monad.void}     - warn: {lhs: const () <$> x, rhs: Control.Monad.void x}+    - warn: {lhs: x <&> const (), rhs: Control.Monad.void x}     - warn: {lhs: () <$ x, rhs: Control.Monad.void x}     - warn: {lhs: flip (>=>), rhs: (<=<)}     - warn: {lhs: flip (<=<), rhs: (>=>)}@@ -542,7 +580,9 @@     - warn: {lhs: fmap f (pure x), rhs: pure (f x)}     - warn: {lhs: fmap f (return x), rhs: return (f x)}     - warn: {lhs: f <$> pure x, rhs: pure (f x)}+    - warn: {lhs: pure x <&> f, rhs: pure (f x)}     - warn: {lhs: f <$> return x, rhs: return (f x)}+    - warn: {lhs: return x <&> f, rhs: return (f x)}     - warn: {lhs: mapM (uncurry f) (zip l m), rhs: zipWithM f l m}     - warn: {lhs: mapM_ (void . f), rhs: mapM_ f}     - warn: {lhs: forM_ x (void . f), rhs: forM_ x f}@@ -553,6 +593,10 @@     - warn: {lhs: return x *> m, rhs: m}     - warn: {lhs: pure x >> m, rhs: m}     - warn: {lhs: return x >> m, rhs: m}+    - warn: {lhs: "forM [1..n] (const f)", rhs: replicateM n f}+    - warn: {lhs: "for [1..n] (const f)", rhs: replicateM n f}+    - warn: {lhs: "forM [1..n] (\\_ -> x)", rhs: replicateM n x}+    - warn: {lhs: "for [1..n] (\\_ -> x)", rhs: replicateM n x}      # STATE MONAD @@ -562,6 +606,7 @@     # MONAD LIST      - warn: {lhs: unzip <$> mapM f x, rhs: Control.Monad.mapAndUnzipM f x}+    - warn: {lhs: mapM f x <&> unzip, rhs: Control.Monad.mapAndUnzipM f x}     - warn: {lhs: fmap unzip (mapM f x), rhs: Control.Monad.mapAndUnzipM f x}     - warn: {lhs: sequence (zipWith f x y), rhs: Control.Monad.zipWithM f x y}     - warn: {lhs: sequence_ (zipWith f x y), rhs: Control.Monad.zipWithM_ f x y}@@ -587,7 +632,7 @@     - warn: {lhs: flip traverse_, rhs: for_}     - warn: {lhs: flip for_, rhs: traverse_}     - warn: {lhs: foldr (*>) (pure ()), rhs: sequenceA_}-    - warn: {lhs: foldr (*>) (return ()), rhs: sequenceA_}+    - warn: {lhs: foldr (*>) (return ()), rhs: sequence_}     - warn: {lhs: foldr (<|>) empty, rhs: asum}     - warn: {lhs: liftA2 (flip ($)), rhs: (<**>)}     - warn: {lhs: liftA2 f (pure x), rhs: fmap (f x)}@@ -645,6 +690,7 @@     - warn: {lhs: "maybe [] (:[])", rhs: maybeToList}     - warn: {lhs: catMaybes (map f x), rhs: mapMaybe f x}     - warn: {lhs: catMaybes (f <$> x), rhs: mapMaybe f x}+    - warn: {lhs: catMaybes (x <&> f), rhs: mapMaybe f x}     - warn: {lhs: catMaybes (fmap f x), rhs: mapMaybe f x}     - hint: {lhs: case x of Nothing -> y; Just a -> a , rhs: Data.Maybe.fromMaybe y x, side: isAtom y, name: Replace case with fromMaybe}     - hint: {lhs: case x of Just a -> a; Nothing -> y, rhs: Data.Maybe.fromMaybe y x, side: isAtom y, name: Replace case with fromMaybe}@@ -654,6 +700,10 @@     - warn: {lhs: if isJust x then f (fromJust x) else y, rhs: maybe y f x}     - warn: {lhs: maybe Nothing (Just . f), rhs: fmap f}     - hint: {lhs: map fromJust (filter isJust x), rhs:  Data.Maybe.catMaybes x}+    - hint: {lhs: filter isJust (map f x), rhs: map Just (mapMaybe f x), name: Use mapMaybe}+    - hint: {lhs: filter isJust (f <*> x), rhs: map Just (mapMaybe f x), name: Use mapMaybe}+    - hint: {lhs: filter isJust (x <&> f), rhs: map Just (mapMaybe f x), name: Use mapMaybe}+    - hint: {lhs: filter isJust (fmap f x), rhs: map Just (mapMaybe f x), name: Use mapMaybe}     - warn: {lhs: x == Nothing , rhs:  isNothing x}     - warn: {lhs: Nothing == x , rhs:  isNothing x}     - warn: {lhs: x /= Nothing , rhs:  Data.Maybe.isJust x}@@ -664,23 +714,30 @@     - warn: {lhs: if isNothing x then y else fromJust x, rhs: fromMaybe y x}     - warn: {lhs: if isJust x then fromJust x else y, rhs: fromMaybe y x}     - warn: {lhs: isJust x && (fromJust x == y), rhs: x == Just y}+    - warn: {lhs: isJust y && (x == fromJust y), rhs: Just x == y}     - warn: {lhs: mapMaybe f (map g x), rhs: mapMaybe (f . g) x, name: Fuse mapMaybe/map}     - warn: {lhs: fromMaybe a (fmap f x), rhs: maybe a f x}     - warn: {lhs: fromMaybe a (f <$> x), rhs: maybe a f x}+    - warn: {lhs: fromMaybe a (x <&> f), rhs: maybe a f x}     - warn: {lhs: mapMaybe id, rhs: catMaybes}     - hint: {lhs: "[x | Just x <- a]", rhs: Data.Maybe.catMaybes a, side: isVar x}     - hint: {lhs: case m of Nothing -> Nothing; Just x -> x, rhs: Control.Monad.join m}     - hint: {lhs: maybe Nothing id, rhs: join}     - hint: {lhs: maybe Nothing f x, rhs: f =<< x}-    - warn: {lhs: maybe x f (g <$> y), rhs: maybe x (f . g) y, name: Redundant fmap}+    - warn: {lhs: maybe x f (g <$> y), rhs: maybe x (f . g) y, name: Redundant <$>}+    - warn: {lhs: maybe x f (y <&> g), rhs: maybe x (f . g) y, name: Redundant <&>}     - warn: {lhs: maybe x f (fmap g y), rhs: maybe x (f . g) y, name: Redundant fmap}     - warn: {lhs: isJust (f <$> x), rhs: isJust x}+    - warn: {lhs: isJust (x <&> f), rhs: isJust x}     - warn: {lhs: isJust (fmap f x), rhs: isJust x}     - warn: {lhs: isNothing (f <$> x), rhs: isNothing x}+    - warn: {lhs: isNothing (x <&> f), rhs: isNothing x}     - warn: {lhs: isNothing (fmap f x), rhs: isNothing x}     - warn: {lhs: fromJust (f <$> x), rhs: f (fromJust x), note: IncreasesLaziness}+    - warn: {lhs: fromJust (x <&> f), rhs: f (fromJust x), note: IncreasesLaziness}     - warn: {lhs: fromJust (fmap f x), rhs: f (fromJust x), note: IncreasesLaziness}-    - warn: {lhs: mapMaybe f (g <$> x), rhs: mapMaybe (f . g) x, name: Redundant fmap}+    - warn: {lhs: mapMaybe f (g <$> x), rhs: mapMaybe (f . g) x, name: Redundant <$>}+    - warn: {lhs: mapMaybe f (x <&> g), rhs: mapMaybe (f . g) x, name: Redundant <&>}     - warn: {lhs: mapMaybe f (fmap g x), rhs: mapMaybe (f . g) x, name: Redundant fmap}     - warn: {lhs: catMaybes (nub x), rhs: nub (catMaybes x), name: Move nub out}     - warn: {lhs: lefts (nub x), rhs: nub (lefts x), name: Move nub out}@@ -702,10 +759,20 @@     - warn: {lhs: "[a | Right a <- b]", rhs: rights b, side: isVar a}     - warn: {lhs: either Left (Right . f), rhs: fmap f}     - warn: {lhs: either f g (fmap h x), rhs: either f (g . h) x, name: Redundant fmap}+    - warn: {lhs: either f g (h <$> x), rhs: either f (g . h) x, name: Redundant <$>}+    - warn: {lhs: either f g (x <&> h), rhs: either f (g . h) x, name: Redundant <&>}     - warn: {lhs: isLeft (fmap f x), rhs: isLeft x}+    - warn: {lhs: isLeft (f <$> x), rhs: isLeft x}+    - warn: {lhs: isLeft (x <&> f), rhs: isLeft x}     - warn: {lhs: isRight (fmap f x), rhs: isRight x}+    - warn: {lhs: isRight (f <$> x), rhs: isRight x}+    - warn: {lhs: isRight (x <&> f), rhs: isRight x}     - warn: {lhs: fromLeft x (fmap f y), rhs: fromLeft x y}+    - warn: {lhs: fromLeft x (f <$> y), rhs: fromLeft x y}+    - warn: {lhs: fromLeft x (y <&> f), rhs: fromLeft x y}     - warn: {lhs: fromRight x (fmap f y), rhs: either (const x) f y}+    - warn: {lhs: fromRight x (f <$> y), rhs: either (const x) f y}+    - warn: {lhs: fromRight x (y <&> f), rhs: either (const x) f y}     - warn: {lhs: either (const x) id, rhs: fromRight x}     - warn: {lhs: either id (const x), rhs: fromLeft x}     - warn: {lhs: either Left f x, rhs: f =<< x}@@ -790,23 +857,59 @@      # FOLDABLE -    - warn: {lhs: case m of Nothing -> pure (); Just x -> f x, rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: case m of Nothing -> pure (); Just x -> f x, rhs: Data.Foldable.for_ m f}     - warn: {lhs: case m of Nothing -> return (); Just x -> f x, rhs: Data.Foldable.forM_ m f}-    - warn: {lhs: case m of Just x -> f x; Nothing -> pure (), rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: case m of Just x -> f x; Nothing -> pure (), rhs: Data.Foldable.for_ m f}     - warn: {lhs: case m of Just x -> f x; Nothing -> return (), rhs: Data.Foldable.forM_ m f}-    - warn: {lhs: case m of Just x -> f x; _ -> pure (), rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: case m of Just x -> f x; _ -> pure (), rhs: Data.Foldable.for_ m f}     - warn: {lhs: case m of Just x -> f x; _ -> return (), rhs: Data.Foldable.forM_ m f}-    - warn: {lhs: when (isJust m) (f (fromJust m)), rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: when (isJust m) (f (fromJust m)), rhs: Data.Foldable.for_ m f}+    - hint: {lhs: concatMap f (fmap g x), rhs: concatMap (f . g) x, name: Fuse concatMap/fmap}+    - hint: {lhs: concatMap f (g <$> x), rhs: concatMap (f . g) x, name: Fuse concatMap/<$>}+    - hint: {lhs: concatMap f (x <&> g), rhs: concatMap (f . g) x, name: Fuse concatMap/<&>}+    - warn: {lhs: null (concatMap f x), rhs: all (null . f) x}+    - warn: {lhs: or (concat x), rhs: any or x}+    - warn: {lhs: or (concatMap f x), rhs: any (or . f) x}+    - warn: {lhs: and (concat x), rhs: all and x}+    - warn: {lhs: and (concatMap f x), rhs: all (and . f) x}+    - warn: {lhs: any f (concat x), rhs: any (any f) x}+    - warn: {lhs: any f (concatMap g x), rhs: any (any f . g) x}+    - warn: {lhs: all f (concat x), rhs: all (all f) x}+    - warn: {lhs: all f (concatMap g x), rhs: all (all f . g) x}+    - warn: {lhs: fold (concatMap f x), rhs: foldMap (fold . f) x}+    - warn: {lhs: foldMap f (concatMap g x), rhs: foldMap (foldMap f . g) x}+    - warn: {lhs: catMaybes (concatMap f x), rhs: concatMap (catMaybes . f) x, name: Move concatMap out}+    - hint: {lhs: filter f (concatMap g x), rhs: concatMap (filter f . g) x, name: Move concatMap out}+    - warn: {lhs: mapMaybe f (concatMap g x), rhs: concatMap (mapMaybe f . g) x, name: Move concatMap out}+    - warn: {lhs: or (fmap p x), rhs: any p x}+    - warn: {lhs: or (p <$> x), rhs: any p x}+    - warn: {lhs: or (x <&> p), rhs: any p x}+    - warn: {lhs: and (fmap p x), rhs: all p x}+    - warn: {lhs: and (p <$> x), rhs: all p x}+    - warn: {lhs: and (x <&> p), rhs: all p x}+    - warn: {lhs: any f (fmap g x), rhs: any (f . g) x}+    - warn: {lhs: any f (g <$> x), rhs: any (f . g) x}+    - warn: {lhs: any f (x <&> g), rhs: any (f . g) x}+    - warn: {lhs: all f (fmap g x), rhs: all (f . g) x}+    - warn: {lhs: all f (g <$> x), rhs: all (f . g) x}+    - warn: {lhs: all f (x <&> g), rhs: all (f . g) x}+    - hint: {lhs: foldr f z (fmap g x), rhs: foldr (f . g) z x, name: Fuse foldr/fmap}+    - hint: {lhs: foldr f z (g <$> x), rhs: foldr (f . g) z x, name: Fuse foldr/<$>}+    - hint: {lhs: foldr f z (x <&> g), rhs: foldr (f . g) z x, name: Fuse foldr/<&>}      # STATE MONAD      - warn: {lhs: f <$> Control.Monad.State.get, rhs: gets f}+    - warn: {lhs: Control.Monad.State.get <&> f, rhs: gets f}     - warn: {lhs: fmap f  Control.Monad.State.get, rhs: gets f}     - warn: {lhs: f <$> Control.Monad.State.gets g, rhs: gets (f . g)}+    - warn: {lhs: Control.Monad.State.gets g <&> f, rhs: gets (f . g)}     - warn: {lhs: fmap f (Control.Monad.State.gets g), rhs: gets (f . g)}     - warn: {lhs: f <$> Control.Monad.Reader.ask, rhs: asks f}+    - warn: {lhs: Control.Monad.Reader.ask <&> f, rhs: asks f}     - warn: {lhs: fmap f Control.Monad.Reader.ask, rhs: asks f}     - warn: {lhs: f <$> Control.Monad.Reader.asks g, rhs: asks (f . g)}+    - warn: {lhs: Control.Monad.Reader.asks g <&> f, rhs: asks (f . g)}     - warn: {lhs: fmap f (Control.Monad.Reader.asks g), rhs: asks (f . g)}     - warn: {lhs: fst (runState m s), rhs: evalState m s}     - warn: {lhs: snd (runState m s), rhs: execState m s}@@ -825,6 +928,14 @@     - warn: {lhs: either f g (Right y), rhs: g y, name: Evaluate}     - warn: {lhs: "fst (x,y)", rhs: x, name: Evaluate}     - warn: {lhs: "snd (x,y)", rhs: "y", name: Evaluate}+    - warn: {lhs: fromJust (Just x), rhs: x, name: Evaluate}+    - warn: {lhs: fromLeft y (Left x), rhs: x, name: Evaluate}+    - warn: {lhs: fromLeft y (Right x), rhs: "y", name: Evaluate}+    - warn: {lhs: fromRight y (Right x), rhs: x, name: Evaluate}+    - warn: {lhs: fromRight y (Left x), rhs: "y", name: Evaluate}+    - warn: {lhs: "head [x]", rhs: "x", name: Evaluate}+    - warn: {lhs: "last [x]", rhs: "x", name: Evaluate}+    - warn: {lhs: "tail [x]", rhs: "[]", name: Evaluate}     - warn: {lhs: "init [x]", rhs: "[]", name: Evaluate}     - warn: {lhs: "null [x]", rhs: "False", name: Evaluate}     - warn: {lhs: "null []", rhs: "True", name: Evaluate}@@ -855,6 +966,8 @@     - warn: {lhs: x / 1, rhs: x, name: Evaluate}     - warn: {lhs: "concat [a]", rhs: a, name: Evaluate}     - warn: {lhs: "concat []", rhs: "[]", name: Evaluate}+    - warn: {lhs: "concatMap f [a]", rhs: f a, name: Evaluate}+    - warn: {lhs: "concatMap f []", rhs: "[]", name: Evaluate}     - warn: {lhs: "zip [] []", rhs: "[]", name: Evaluate}     - warn: {lhs: const x y, rhs: x, name: Evaluate}     - warn: {lhs: any (const False), rhs: const False, note: IncreasesLaziness, name: Evaluate}@@ -886,9 +999,11 @@     - warn: {lhs: "toList      (x,b)", rhs: b, name: Using toList on tuple}     - warn: {lhs: "maximum     (x,b)", rhs: b, name: Using maximum on tuple}     - warn: {lhs: "minimum     (x,b)", rhs: b, name: Using minimum on tuple}+    - warn: {lhs: "notElem e   (x,b)", rhs: e /= b, name: Using notElem on tuple}     - warn: {lhs: "sum         (x,b)", rhs: b, name: Using sum on tuple}     - warn: {lhs: "product     (x,b)", rhs: b, name: Using product on tuple}     - warn: {lhs: "concat      (x,b)", rhs: b, name: Using concat on tuple}+    - warn: {lhs: "concatMap f (x,b)", rhs: f b, name: Using concatMap on tuple}     - warn: {lhs: "and         (x,b)", rhs: b, name: Using and on tuple}     - warn: {lhs: "or          (x,b)", rhs: b, name: Using or on tuple}     - warn: {lhs: "any     f   (x,b)", rhs: f b, name: Using any on tuple}@@ -906,9 +1021,11 @@     - warn: {lhs: "toList      (x,y,b)", rhs: b, name: Using toList on tuple}     - warn: {lhs: "maximum     (x,y,b)", rhs: b, name: Using maximum on tuple}     - warn: {lhs: "minimum     (x,y,b)", rhs: b, name: Using minimum on tuple}+    - warn: {lhs: "notElem e   (x,y,b)", rhs: e /= b, name: Using notElem on tuple}     - warn: {lhs: "sum         (x,y,b)", rhs: b, name: Using sum on tuple}     - warn: {lhs: "product     (x,y,b)", rhs: b, name: Using product on tuple}     - warn: {lhs: "concat      (x,y,b)", rhs: b, name: Using concat on tuple}+    - warn: {lhs: "concatMap f (x,y,b)", rhs: f b, name: Using concatMap on tuple}     - warn: {lhs: "and         (x,y,b)", rhs: b, name: Using and on tuple}     - warn: {lhs: "or          (x,y,b)", rhs: b, name: Using or on tuple}     - warn: {lhs: "any     f   (x,y,b)", rhs: f b, name: Using any on tuple}@@ -1041,16 +1158,114 @@     - hint: {lhs: "\\(x, y) -> [x, y]", rhs: Data.Bifoldable.biList, note: IncreasesLaziness}     - hint: {lhs: const mempty, rhs: mempty}     - hint: {lhs: \x -> mempty, rhs: mempty, name: Redundant lambda}+    - warn: {lhs: map f x >>= g, rhs: x >>= g . f}+    - warn: {lhs: g =<< map f x, rhs: g . f =<< x}+    - hint: {lhs: join (map f x), rhs: f =<< x}+    - warn: {lhs: map unzip (mapM f x), rhs: Control.Monad.mapAndUnzipM f x} +# Warn on partial functions whose use can be avoided relatively easily.+# These functions are in the base package, excluding IO and GHC modules.+- group:+    name: partial+    enabled: false+    imports:+    - package base+    rules:++    # Data.Bifoldable++    - warn: {lhs: bifoldr1, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: bifoldl1, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: bimaximum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: biminimum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: bimaximumBy, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: biminimumBy, rhs: undefined, name: Avoid partial function}++    # Data.Bits++    - warn: {lhs: bitSize x, rhs: "case bitSizeMaybe x of Just n -> n; Nothing -> error _", name: Avoid partial function}+    - warn: {lhs: shiftL x b, rhs: shift x b, name: Avoid partial function}+    - warn: {lhs: shiftR x b, rhs: shift x (-b), name: Avoid partial function}+    - warn: {lhs: unsafeShiftL x b, rhs: shift x b, name: Avoid partial function}+    - warn: {lhs: unsafeShiftR x b, rhs: shift x (-b), name: Avoid partial function}+    - warn: {lhs: rotateL x b, rhs: rotate x b, name: Avoid partial function}+    - warn: {lhs: rotateR x b, rhs: rotate x (-b), name: Avoid partial function}++    # Data.Foldable++    - warn: {lhs: foldr1, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: foldl1, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: maximum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: minimum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: maximumBy, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: minimumBy, rhs: undefined, name: Avoid partial function}++    # Data.List++    - warn: {lhs: head l, rhs: "case l of x:_ -> x; [] -> error _", side: not (isNonEmpty l), name: Avoid partial function}+    - warn: {lhs: last l, rhs: "case reverse l of x:_ -> x; [] -> error _", side: not (isNonEmpty l), name: Avoid partial function}+    - warn: {lhs: tail l, rhs: "case l of _:xs -> xs; [] -> error _", side: not (isNonEmpty x), name: Avoid partial function}+    - warn: {lhs: init l, rhs: "case reverse l of _:xs -> reverse xs; [] -> error _", side: not (isNonEmpty x), name: Avoid partial function}+    - warn: {lhs: l !! n, rhs: "case drop n l of x:_ -> x; [] -> error _", name: Avoid partial function}++    # Data.List.NonEmpty++    - warn: {lhs: Data.List.NonEmpty.fromList l, rhs: "case nonEmpty l of Just xs -> xs; Nothing -> error _", name: Avoid partial function}++    # Data.Maybe++    - warn: {lhs: fromJust v, rhs: "case v of Just x -> x; Nothing -> error _", name: Avoid partial function}++# Strictly warn even on partial functions in the base package whose use+# are almost unavoidable for their functionality.+- group:+    name: partial-strict+    enabled: false+    imports:+    - package base+    rules:++    # Data.Char++    - warn: {lhs: digitToInt, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: intToDigit, rhs: undefined, name: Avoid partial function}++    # Data.Fixed++    - warn: {lhs: div', rhs: undefined, name: Avoid partial function}+    - warn: {lhs: mod', rhs: undefined, name: Avoid partial function}+    - warn: {lhs: divMod', rhs: undefined, name: Avoid partial function}++    # Data.List++    - warn: {lhs: cycle, rhs: undefined, name: Avoid partial function}++    # Data.Ratio++    - warn: {lhs: x % y, rhs: undefined, name: Avoid partial function}++    # Prelude++    - warn: {lhs: succ, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: pred, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: toEnum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: fromEnum, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: quot, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: rem, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: div, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: mod, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: quotRem, rhs: undefined, name: Avoid partial function}+    - warn: {lhs: divMod, rhs: undefined, name: Avoid partial function}+ # hints that use the 'extra' library - group:     name: extra     enabled: false     rules:     - warn: {lhs: fmap concat (forM a b), rhs: concatForM a b}+    - warn: {lhs: map concat (forM a b), rhs: concatForM a b}     - warn: {lhs: concat <$> forM a b, rhs: concatForM a b}-    - warn: {lhs: fmap concat (forM_ a b), rhs: concatForM_ a b}-    - warn: {lhs: concat <$> forM_ a b, rhs: concatForM_ a b}+    - warn: {lhs: forM a b <&> concat, rhs: concatForM a b}     - warn: {lhs: "maybe (pure ()) b a", rhs: "whenJust a b"}     - warn: {lhs: "maybe (return ()) b a", rhs: "whenJust a b"}     - warn: {lhs: "maybeM (pure ()) b a", rhs: "whenJustM a b"}@@ -1095,7 +1310,11 @@     - warn: {lhs: "map toUpper", rhs: "upper"}     - warn: {lhs: "mergeBy compare", rhs: "merge"}     - warn: {lhs: "breakEnd (not . a)", rhs: "spanEnd a"}+    - warn: {lhs: "breakEnd notNull", rhs: "spanEnd null", name: Use spanEnd}+    - warn: {lhs: "breakEnd (notElem x)", rhs: "spanEnd (elem x)", name: Use spanEnd}     - warn: {lhs: "spanEnd (not . a)", rhs: "breakEnd a"}+    - warn: {lhs: "spanEnd notNull", rhs: "breakEnd null", name: Use breakEnd}+    - warn: {lhs: "spanEnd (notElem x)", rhs: "breakEnd (elem x)", name: Use breakEnd}     - warn: {lhs: "mconcat (map a b)", rhs: "mconcatMap a b"}     - warn: {lhs: "fromMaybe b (stripPrefix a b)", rhs: "dropPrefix a b"}     - warn: {lhs: "fromMaybe b (stripSuffix a b)", rhs: "dropSuffix a b"}@@ -1110,15 +1329,29 @@     - warn: {lhs: "readFileEncoding' utf8", rhs: "readFileUTF8'"}     - warn: {lhs: "withBinaryFile a ReadMode hGetContents'", rhs: "readFileBinary' a"}     - warn: {lhs: "writeFileEncoding utf8", rhs: "writeFileUTF8"}-    - warn: {lhs: "head $ x ++ [y]", rhs: "headDef y x"}-    - warn: {lhs: "last $ x : y", rhs: "lastDef x y"}+    - warn: {lhs: "head (x ++ [y])", rhs: "headDef y x"}+    - warn: {lhs: "last (x : y)", rhs: "lastDef x y"}     - warn: {lhs: "drop 1", rhs: "drop1"}     - warn: {lhs: "dropEnd 1", rhs: "dropEnd1"}+    - warn: {lhs: span notNull, rhs: break null, name: Use break}+    - warn: {lhs: break notNull, rhs: span null, name: Use span}+    - warn: {lhs: when (notNull x), rhs: unless (null x), name: Use unless}+    - warn: {lhs: unless (notNull x), rhs: when (null x), name: Use when}+    - warn: {lhs: not (notNull x), rhs: null x}     - warn: {lhs: notNull (concat x), rhs: any notNull x}+    - warn: {lhs: notNull (concatMap f x), rhs: any (notNull . f) x}     - warn: {lhs: notNull (filter f x), rhs: any f x}     - warn: {lhs: "notNull [x]", rhs: "True", name: Evaluate}     - warn: {lhs: "notNull []", rhs: "False", name: Evaluate}+    - warn: {lhs: "notNull \"\"", rhs: "False", name: Evaluate}     - hint: {lhs: "\\(x,y) -> (f x, f y)", rhs: both f}+    - warn: {lhs: fromLeft' (Left x), rhs: x, name: Evaluate}+    - warn: {lhs: fromRight' (Right x), rhs: x, name: Evaluate}+    - warn: {lhs: fromEither (Left x), rhs: x, name: Evaluate}+    - warn: {lhs: fromEither (Right x), rhs: x, name: Evaluate}+    - hint: {lhs: nub (sort x), rhs: nubSort x}+    - warn: {lhs: sort (nub x), rhs: nubSort x}+    - warn: {lhs: notNull x, rhs: "True", side: isTuple x, name: Using notNull on tuple}  # hints that will be enabled in future - group:@@ -1267,6 +1500,8 @@ # yes = a & (mapped . b) %~ c -- a <&> b %~ c # test a = foo (\x -> True) -- const True # test a = foo (\_ -> True) -- const True+# {-# LANGUAGE NamedFieldPuns #-}; data Foo = Foo {foo :: Int}; issue1430_ctor x = f (\foo-> Foo{foo})+# {-# LANGUAGE NamedFieldPuns #-}; data Foo = Foo {foo :: Int}; issue1430_update x = f (\foo -> x{foo}) # test a = foo (\x -> x) -- id # h a = flip f x (y z) -- f (y z) x # h a = flip f x $ y z@@ -1420,7 +1655,9 @@ # main = hello .~ Just 12 -- hello ?~ 12 # foo = liftIO $ window `on` deleteEvent $ do a; b # no = sort <$> f input `shouldBe` sort <$> x-# sortBy (comparing length) -- sortOn length+# no = sortBy (comparing Down)+# yes = sortBy (flip (comparing f)) -- sortBy (comparing (Data.Ord.Down . f))+# yes = reverse (sort x) -- sortBy (comparing Data.Ord.Down) x # myJoin = on $ child ^. ChildParentId ==. parent ^. ParentId # foo = typeOf (undefined :: Foo Int) -- typeRep (Proxy :: Proxy (Foo Int)) # foo = typeOf (undefined :: a) -- typeRep (Proxy :: Proxy a)

@@ -1,13 +1,13 @@ cabal-version:      1.18 build-type:         Simple name:               hlint-version:            3.5+version:            3.6 license:            BSD3 license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2006-2022+copyright:          Neil Mitchell 2006-2023 synopsis:           Source code suggestions description:     HLint gives suggestions on how to improve your source code.@@ -36,7 +36,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==9.2, GHC==9.0+tested-with:        GHC==9.6, GHC==9.4, GHC==9.2  source-repository head     type:     git@@ -72,7 +72,7 @@         utf8-string,         data-default >= 0.3,         cpphs >= 1.20.1,-        cmdargs >= 0.10,+        cmdargs >= 0.10.22,         uniplate >= 1.5,         ansi-terminal >= 0.8.1,         extra >= 1.7.3,@@ -81,16 +81,16 @@         deriving-aeson >= 0.2,         filepattern >= 0.1.1 -    if !flag(ghc-lib) && impl(ghc >= 9.4.1) && impl(ghc < 9.5.0)+    if !flag(ghc-lib) && impl(ghc >= 9.6.1) && impl(ghc < 9.7.0)       build-depends:-        ghc == 9.4.*,+        ghc == 9.6.*,         ghc-boot-th,         ghc-boot     else       build-depends:-          ghc-lib-parser == 9.4.*+          ghc-lib-parser == 9.6.*     build-depends:-        ghc-lib-parser-ex >= 9.4.0.0 && < 9.4.1+        ghc-lib-parser-ex >= 9.6.0.0 && < 9.6.1      if flag(gpl)         build-depends: hscolour >= 1.21@@ -124,6 +124,7 @@         Timing         CC         EmbedData+        SARIF         Summary         Config.Compute         Config.Haskell@@ -170,7 +171,7 @@         Test.Annotations         Test.InputOutput         Test.Util-    ghc-options: -Wunused-binds -Wunused-imports -Worphans+    ghc-options: -Wunused-binds -Wunused-imports -Worphans -Wprepositive-qualified-module   executable hlint

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-}  module Apply(applyHints, applyHintFile, applyHintFiles) where @@ -18,9 +19,10 @@ import GHC.Types.SrcLoc import GHC.Hs import Language.Haskell.GhclibParserEx.GHC.Hs-import qualified Data.HashSet as Set+import Data.HashSet qualified as Set import Prelude import Util+import Timing   -- | Apply hints to a single file, you may have the contents of the file.@@ -29,14 +31,14 @@     res <- parseModuleApply flags s file src     pure $ case res of         Left err -> [err]-        Right m -> executeHints s [m]+        Right m -> timed "Execute hints" file (forceList $ executeHints s [m])   -- | Apply hints to multiple files, allowing cross-file hints to fire. applyHintFiles :: ParseFlags -> [Setting] -> [FilePath] -> IO [Idea] applyHintFiles flags s files = do     (err, ms) <- partitionEithers <$> mapM (\file -> parseModuleApply flags s file Nothing) files-    pure $ err ++ executeHints s ms+    pure $ err ++ timed "Execute hints" "all modules" (forceList $ executeHints s ms)   -- | Given a way of classifying results, and a 'Hint', apply to a set of modules generating a list of 'Idea's.@@ -72,7 +74,7 @@ removeRequiresExtensionNotes :: ModuleEx -> Idea -> Idea removeRequiresExtensionNotes m = \x -> x{ideaNote = filter keep $ ideaNote x}     where-        exts = Set.fromList $ concatMap snd $ languagePragmas $ pragmas (comments (hsmodAnn (unLoc . ghcModule $ m)))+        exts = Set.fromList $ concatMap snd $ languagePragmas $ pragmas (comments (hsmodAnn (hsmodExt . unLoc . ghcModule $ m)))         keep (RequiresExtension x) = not $ x `Set.member` exts         keep _ = True 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- |@@ -14,13 +15,13 @@ import Data.Char (toUpper) import Data.Text (Text) -import qualified Data.Text as T-import qualified Data.ByteString.Lazy.Char8 as C8+import Data.Text qualified as T+import Data.ByteString.Lazy.Char8 qualified as C8  import Idea (Idea(..), Severity(..)) -import qualified GHC.Types.SrcLoc as GHC-import qualified GHC.Util as GHC+import GHC.Types.SrcLoc qualified as GHC+import GHC.Util qualified as GHC  data Issue = Issue     { issueType :: Text

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost, CPP #-} {-# LANGUAGE PatternGuards, DeriveDataTypeable, TupleSections #-} {-# OPTIONS_GHC -Wno-missing-fields -fno-cse -O0 #-} @@ -9,7 +10,7 @@  import Control.Monad.Extra import Control.Exception.Extra-import qualified Data.ByteString as BS+import Data.ByteString qualified as BS import Data.Char import Data.List.Extra import Data.Maybe@@ -20,7 +21,7 @@ import GHC.Driver.Session hiding (verbosity)  import Language.Preprocessor.Cpphs-import System.Console.ANSI(hSupportsANSIWithoutEmulation)+import System.Console.ANSI(hSupportsANSI) import System.Console.CmdArgs.Explicit(helpText, HelpFormat(..)) import System.Console.CmdArgs.Implicit import System.Directory.Extra@@ -84,7 +85,7 @@ data ColorMode     = Never  -- ^ Terminal output will never be coloured.     | Always -- ^ Terminal output will always be coloured.-    | Auto   -- ^ Terminal output will be coloured if $TERM and stdout appear to support it.+    | Auto   -- ^ Terminal output will be coloured if $TERM and stdout appear to support it, and NO_COLOR is not set.       deriving (Show, Typeable, Data)  @@ -96,13 +97,14 @@     = CmdMain         {cmdFiles :: [FilePath]    -- ^ which files to run it on, nothing = none given         ,cmdReports :: [FilePath]        -- ^ where to generate reports-        ,cmdGivenHints :: [FilePath]     -- ^ which settignsfiles were explicitly given+        ,cmdGivenHints :: [FilePath]     -- ^ which settings files were explicitly given         ,cmdWithGroups :: [String]       -- ^ groups that are given on the command line         ,cmdGit :: Bool                  -- ^ use git ls-files to find files         ,cmdColor :: ColorMode           -- ^ color the result-        ,cmdThreads :: Int              -- ^ Numbmer of threads to use, 0 = whatever GHC has+        ,cmdThreads :: Int              -- ^ Number of threads to use, 0 = whatever GHC has         ,cmdIgnore :: [String]           -- ^ the hints to ignore         ,cmdShowAll :: Bool              -- ^ display all skipped items+        ,cmdIgnoreSuggestions :: Bool    -- ^ ignore suggestions         ,cmdExtension :: [String]        -- ^ extensions         ,cmdLanguage :: [String]      -- ^ the extensions (may be prefixed by "No")         ,cmdCross :: Bool                -- ^ work between source files, applies to hints such as duplicate code between modules@@ -117,6 +119,7 @@         ,cmdCppAnsi :: Bool         ,cmdJson :: Bool                -- ^ display hint data as JSON         ,cmdCC :: Bool                  -- ^ display hint data as Code Climate Issues+        ,cmdSARIF :: Bool               -- ^ display hint data as SARIF         ,cmdNoSummary :: Bool           -- ^ do not show the summary info         ,cmdOnly :: [String]            -- ^ specify which hints explicitly         ,cmdNoExitCode :: Bool@@ -144,6 +147,7 @@         ,cmdThreads = 1 &= name "threads" &= name "j" &= opt (0 :: Int) &= help "Number of threads to use (-j for all)"         ,cmdIgnore = nam "ignore" &= typ "HINT" &= help "Ignore a particular hint"         ,cmdShowAll = nam "show" &= help "Show all ignored ideas"+        ,cmdIgnoreSuggestions = nam_ "ignore-suggestions" &= help "Ignore suggestions, only show warnings and errors"         ,cmdExtension = nam "extension" &= typ "EXT" &= help "File extensions to search (default hs/lhs)"         ,cmdLanguage = nam_ "language" &= name "X" &= typ "EXTENSION" &= help "Language extensions (Arrows, NoCPP)"         ,cmdCross = nam_ "cross" &= help "Work between modules"@@ -158,6 +162,7 @@         ,cmdCppAnsi = nam_ "cpp-ansi" &= help "Use CPP in ANSI compatibility mode"         ,cmdJson = nam_ "json" &= help "Display hint data as JSON"         ,cmdCC = nam_ "cc" &= help "Display hint data as Code Climate Issues"+        ,cmdSARIF = nam_ "sarif" &= help "Display hint data as SARIF"         ,cmdNoSummary = nam_ "no-summary" &= help "Do not show summary information"         ,cmdOnly = nam "only" &= typ "HINT" &= help "Specify which hints explicitly"         ,cmdNoExitCode = nam_ "no-exit-code" &= help "Do not give a negative exit if hints"@@ -167,7 +172,7 @@         ,cmdRefactorOptions = nam_ "refactor-options" &= typ "OPTIONS" &= help "Options to pass to the `refactor` executable"         ,cmdWithRefactor = nam_ "with-refactor" &= help "Give the path to refactor"         ,cmdIgnoreGlob = nam_ "ignore-glob" &= help "Ignore paths matching glob pattern (e.g. foo/bar/*.hs)"-        ,cmdGenerateMdSummary = nam_ "generate-summary" &= opt "hints.md" &= help "Generate a summary of available hints, in Mardown format"+        ,cmdGenerateMdSummary = nam_ "generate-summary" &= opt "hints.md" &= help "Generate a summary of available hints, in Markdown format"         ,cmdGenerateJsonSummary = nam_ "generate-summary-json" &= opt "hints.json" &= help "Generate a summary of available hints, in JSON format"         ,cmdGenerateExhaustiveConf = nam_ "generate-config" &= opt Warning &= typ "LEVEL" &= help "Generate a .hlint.yaml config file with all hints set to the specified severity level (default level: warn, alternatives: ignore, suggest, error)"         ,cmdTest = nam_ "test" &= help "Run the test suite"@@ -177,7 +182,7 @@                    ,"To check all Haskell files in 'src' and generate a report type:"                    ,"  hlint src --report"]     ] &= program "hlint" &= verbosity-    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2022")+    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2023")     where         nam xs = nam_ xs &= name [head xs]         nam_ xs = def &= explicit &= name xs@@ -219,19 +224,22 @@         {boolopts=defaultBoolOptions{hashline=False, stripC89=True, ansi=cmdCppAnsi cmd}         ,includes = cmdCppInclude cmd         ,preInclude = cmdCppFile cmd-        ,defines = ("__HLINT__","1") : [(a,drop1 b) | x <- cmdCppDefine cmd, let (a,b) = break (== '=') x]+        ,defines = ("__HLINT__","1") : [(a,drop1 b) | x <- cmdCppDefine cmd, let (a,b) = break (== '=') x] ++ [("__GLASGOW_HASKELL__", show (__GLASGOW_HASKELL__ :: Int))]         }   -- | Determines whether to use colour or not. cmdUseColour :: Cmd -> IO Bool-cmdUseColour cmd = case cmdColor cmd of-  Always -> pure True-  Never  -> pure False-  Auto   -> do-    supportsANSI <- hSupportsANSIWithoutEmulation stdout-    pure $ Just True == supportsANSI-+cmdUseColour cmd = do+  -- https://no-color.org+  -- if NO_COLOR is set, regardless of value, we do not colour output.+  noColor <- lookupEnv "NO_COLOR"+  case cmdColor cmd of+    Always -> pure True+    Never  -> pure False+    Auto   -> do+      supportsANSI <- hSupportsANSI stdout+      pure $ supportsANSI && isNothing noColor  "." <\> x = x x <\> y = x </> y

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-} module Config.Haskell(     readPragma,@@ -23,7 +24,7 @@ import GHC.Data.FastString import GHC.Parser.Annotation import GHC.Utils.Outputable-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader@@ -31,7 +32,7 @@ -- | Read an {-# ANN #-} pragma and determine if it is intended for HLint. --   Return Nothing if it is not an HLint pragma, otherwise what it means. readPragma :: AnnDecl GhcPs -> Maybe Classify-readPragma (HsAnnotation _ _ provenance expr) = f expr+readPragma (HsAnnotation _ provenance expr) = f expr     where         name = case provenance of             ValueAnnProvenance (L _ x) -> occNameStr x

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DataKinds #-}@@ -18,7 +19,7 @@ import Prelude  -import qualified GHC.Hs+import GHC.Hs qualified import Fixity import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings, ViewPatterns, RecordWildCards, GeneralizedNewtypeDeriving, TupleSections #-}@@ -31,10 +32,10 @@ import Data.List.Extra import Data.Tuple.Extra import Control.Monad.Extra-import qualified Data.Text as T-import qualified Data.Vector as V-import qualified Data.ByteString.Char8 as BS-import qualified Data.HashMap.Strict as Map+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.ByteString.Char8 qualified as BS+import Data.HashMap.Strict qualified as Map import Data.Generics.Uniplate.DataOnly import GHC.All import Fixity@@ -67,7 +68,7 @@ import Data.YAML.Aeson (encode1Strict, decode1Strict) import Data.Aeson hiding (encode) import Data.Aeson.Types (Parser)-import qualified Data.ByteString as BSS+import Data.ByteString qualified as BSS  decodeFileEither :: FilePath -> IO (Either (Pos, String) ConfigYaml) decodeFileEither path = decode1Strict <$> BSS.readFile path@@ -235,7 +236,7 @@         POk _ x -> pure x         PFailed ps ->           let errMsg = head . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps)-              msg = showSDoc baseDynFlags $ pprLocMsgEnvelope errMsg+              msg = showSDoc baseDynFlags $ pprLocMsgEnvelopeDefault errMsg           in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n " ++ x  ---------------------------------------------------------------------@@ -440,7 +441,7 @@               scope'= asScope' packageMap' (map (fmap unextendInstances) groupImports)  asScope' :: Map.HashMap String [LocatedA (ImportDecl GhcPs)] -> [Either String (LocatedA (ImportDecl GhcPs))] -> Scope-asScope' packages xs = scopeCreate (HsModule EpAnnNotUsed NoLayoutInfo Nothing Nothing (concatMap f xs) [] Nothing Nothing)+asScope' packages xs = scopeCreate (HsModule (XModulePs EpAnnNotUsed NoLayoutInfo Nothing Nothing) Nothing Nothing (concatMap f xs) [])     where         f (Right x) = [x]         f (Left x) | Just pkg <- Map.lookup x packages = pkg

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} module Extension(   defaultExtensions,   configExtensions,@@ -6,9 +7,9 @@   ) where  import Data.List.Extra-import qualified Data.Map as Map+import Data.Map qualified as Map import GHC.LanguageExtensions.Type-import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx+import Language.Haskell.GhclibParserEx.GHC.Driver.Session qualified as GhclibParserEx  badExtensions =   reallyBadExtensions ++

@@ -5,7 +5,7 @@     CppFlags(..), ParseFlags(..), defaultParseFlags,     parseFlagsAddFixities, parseFlagsSetLanguage,     ParseError(..), ModuleEx(..),-    parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments,+    parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments, firstDeclComments,     parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode,     ) where @@ -85,7 +85,7 @@  -- | Result of 'parseModuleEx', representing a parsed module. newtype ModuleEx = ModuleEx {-    ghcModule :: Located HsModule+    ghcModule :: Located (HsModule GhcPs) }  -- | Extract a complete list of all the comments in a module.@@ -94,8 +94,15 @@  -- | Extract just the list of a modules' leading comments (pragmas). modComments :: ModuleEx -> EpAnnComments-modComments = comments . hsmodAnn . unLoc . ghcModule+modComments = comments . hsmodAnn . hsmodExt . unLoc . ghcModule +-- | Extract comments associated with the first declaration of a module.+firstDeclComments :: ModuleEx -> EpAnnComments+firstDeclComments m =+  case hsmodDecls . unLoc . ghcModule $ m of+        [] -> EpaCommentsBalanced [] []+        L (SrcSpanAnn ann _) _ : _ -> comments ann+ -- | The error handler invoked when GHC parsing has failed. ghcFailOpParseModuleEx :: String                        -> FilePath@@ -117,7 +124,7 @@ ghcFixitiesFromParseFlags :: ParseFlags -> [(String, GHC.Types.Fixity.Fixity)] ghcFixitiesFromParseFlags = map toFixity . fixities --- These next two functions get called frorm 'Config/Yaml.hs' for user+-- These next two functions get called from 'Config/Yaml.hs' for user -- defined hint rules.  parseModeToFlags :: ParseFlags -> DynFlags@@ -147,10 +154,10 @@ -- | Create a 'ModuleEx' from a GHC module. It is assumed the incoming -- parsed module has not been adjusted to account for operator -- fixities (it uses the HLint default fixities).-createModuleEx :: Located HsModule -> ModuleEx+createModuleEx :: Located (HsModule GhcPs) -> ModuleEx createModuleEx = createModuleExWithFixities (map toFixity defaultFixities) -createModuleExWithFixities :: [(String, Fixity)] -> Located HsModule -> ModuleEx+createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx createModuleExWithFixities fixities ast =   ModuleEx (applyFixities (fixitiesFromModule ast ++ fixities) ast) @@ -201,7 +208,7 @@     parseFailureErr dynFlags ppstr file str errs =       let errMsg = head errs           loc = errMsgSpan errMsg-          doc = pprLocMsgEnvelope errMsg+          doc = pprLocMsgEnvelopeDefault errMsg       in ghcFailOpParseModuleEx ppstr file str (loc, doc)  -- | Given a line number, and some source code, put bird ticks around the appropriate bit.

@@ -41,7 +41,7 @@ import System.FilePath import Language.Preprocessor.Unlit -fileToModule :: FilePath -> String -> DynFlags -> ParseResult (Located HsModule)+fileToModule :: FilePath -> String -> DynFlags -> ParseResult (Located (HsModule GhcPs)) fileToModule filename str flags =   parseFile filename flags     (if takeExtension filename /= ".lhs" then str else unlit filename str)

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-}  module GHC.Util.ApiAnnotation (     comment_, commentText, isCommentMultiline@@ -16,7 +17,7 @@ import Control.Applicative import Data.List.Extra import Data.Maybe-import qualified Data.Set as Set+import Data.Set qualified as Set  trimCommentStart :: String -> String trimCommentStart s@@ -64,8 +65,7 @@  -- All the extensions defined to be used. extensions :: EpAnnComments -> Set.Set Extension-extensions = Set.fromList . mapMaybe readExtension .-    concatMap snd . languagePragmas . pragmas+extensions = Set.fromList . concatMap (mapMaybe readExtension . snd) . languagePragmas . pragmas  -- Utility for a case insensitive prefix strip. stripPrefixCI :: String -> String -> Maybe String@@ -87,7 +87,7 @@  -- Language pragmas. The first element of the -- pair is the (located) annotation comment that enables the--- pragmas enumerated by he second element of the pair.+-- pragmas enumerated by the second element of the pair. languagePragmas :: [(LEpaComment, String)] -> [(LEpaComment, [String])] languagePragmas ps =   [(c, exts) | (c, s) <- ps

@@ -38,6 +38,8 @@       HsUnboundVar{} -> True       -- Technically atomic, but lots of people think it shouldn't be       HsRecSel{} -> False+      -- Only relevant for OverloadedRecordDot extension+      HsGetField{} -> True       HsOverLabel{} -> True       HsIPVar{} -> True       -- Note that sections aren't atoms (but parenthesized sections are).@@ -52,7 +54,8 @@       HsUntypedBracket{} -> True       -- HsSplice might be $foo, where @($foo) would require brackets,       -- but in that case the $foo is a type, so we can still mark Splice as atomic-      HsSpliceE{} -> True+      HsTypedSplice{} -> True+      HsUntypedSplice{} -> True       HsOverLit _ x | not $ isNegativeOverLit x -> True       HsLit _ x     | not $ isNegativeLit x     -> True       _  -> False@@ -107,6 +110,7 @@ instance Brackets (LocatedA (Pat GhcPs)) where   remParen (L _ (ParPat _ _ x _)) = Just x   remParen _ = Nothing+   addParen = nlParPat    isAtom (L _ x) = case x of@@ -115,7 +119,9 @@     ListPat{} -> True     -- This is technically atomic, but lots of people think it shouldn't be     ConPat _ _ RecCon{} -> False-    ConPat _ _ (PrefixCon _ []) -> True+    -- Before we only checked args, but not type args, resulting in a+    -- false positive for things like (Proxy @a)+    ConPat _ _ (PrefixCon [] []) -> True     VarPat{} -> True     WildPat{} -> True     SumPat{} -> True

@@ -8,7 +8,7 @@ -- 'parsePragmasIntoDynFlags' based solely on the parse flags -- (and source level annotations). baseDynFlags :: DynFlags-baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig+baseDynFlags = defaultDynFlags fakeSettings  initGlobalDynFlags :: IO () initGlobalDynFlags = setUnsafeGlobalDynFlags baseDynFlags

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}@@ -19,7 +20,7 @@ import Data.Semigroup import Data.List.Extra import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Prelude  ( ^+ ) :: Set OccName -> Set OccName -> Set OccName@@ -44,7 +45,7 @@     mconcat vs = Vars (Set.unions $ map bound vs) (Set.unions $ map free vs)  -- A type `a` is a model of `AllVars a` if exists a function--- `allVars` for producing a pair of the bound and free varaiable+-- `allVars` for producing a pair of the bound and free variable -- sets in a value of `a`. class AllVars a where     -- | Return the variables, erring on the side of more free@@ -52,7 +53,7 @@     allVars :: a -> Vars  -- A type `a` is a model of `FreeVars a` if exists a function--- `freeVars` for producing a set of free varaiable of a value of+-- `freeVars` for producing a set of free variables of a value of -- `a`. class FreeVars a where     -- | Return the variables, erring on the side of more free@@ -97,12 +98,27 @@  instance FreeVars (LocatedA (HsExpr GhcPs)) where   freeVars (L _ (HsVar _ x)) = Set.fromList $ unqualNames x -- Variable.-  freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [x] -- Unbound variable; also used for "holes".+  freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [rdrNameOcc x] -- Unbound variable; also used for "holes".   freeVars (L _ (HsLam _ mg)) = free (allVars mg) -- Lambda abstraction. Currently always a single match.   freeVars (L _ (HsLamCase _ _ MG{mg_alts=(L _ ms)})) = free (allVars ms) -- Lambda case   freeVars (L _ (HsCase _ of_ MG{mg_alts=(L _ ms)})) = freeVars of_ ^+ free (allVars ms) -- Case expr.   freeVars (L _ (HsLet _ _ binds _ e)) = inFree binds e -- Let (rec).-  freeVars (L _ (HsDo _ ctxt (L _ stmts))) = free (allVars stmts) -- Do block.+  freeVars (L _ (HsDo _ ctxt (L _ stmts))) = snd $ foldl' alg mempty stmts -- Do block.+    where+      alg ::+        (Set OccName, Set OccName) ->+        LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))) ->+        (Set OccName, Set OccName)+      alg (accBound0, accFree0) stmt = (accBound, accFree)+        where+          accBound =+            accBound0+              ^+ ( case stmt of+                     L _ (BindStmt _ pat _) -> bound (allVars pat)+                     L _ (LetStmt _ binds) -> bound (allVars binds)+                     _ -> mempty+                 )+          accFree = accFree0 ^+ (free (allVars stmt) ^- accBound0)   freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map freeVars flds -- Record construction.   freeVars (L _ (RecordUpd _ e flds)) =     case flds of@@ -158,6 +174,7 @@    freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x  instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where+  freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ rdrNameAmbiguousFieldOcc $ unLoc x -- a pun   freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x  instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where@@ -165,7 +182,7 @@  instance AllVars (LocatedA (Pat GhcPs)) where   allVars (L _ (VarPat _ (L _ x))) = Vars (Set.singleton $ rdrNameOcc x) Set.empty -- Variable pattern.-  allVars (L _ (AsPat _  n x)) = allVars (noLocA $ VarPat noExtField n :: LocatedA (Pat GhcPs)) <> allVars x -- As pattern.+  allVars (L _ (AsPat _  n _ x)) = allVars (noLocA $ VarPat noExtField n :: LocatedA (Pat GhcPs)) <> allVars x -- As pattern.   allVars (L _ (ConPat _ _ (RecCon (HsRecFields flds _)))) = allVars flds   allVars (L _ (NPlusKPat _ n _ _ _ _)) = allVars (noLocA $ VarPat noExtField n :: LocatedA (Pat GhcPs)) -- n+k pattern.   allVars (L _ (ViewPat _ e p)) = freeVars_ e <> allVars p -- View pattern.@@ -216,7 +233,7 @@   allVars (L _ (PatSynBind _ PSB{})) = mempty -- Come back to it.  instance AllVars (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where-  allVars (MG _ _alts@(L _ alts) _) = inVars (foldMap (allVars . m_pats) ms) (allVars (map m_grhss ms))+  allVars (MG _ _alts@(L _ alts)) = inVars (foldMap (allVars . m_pats) ms) (allVars (map m_grhss ms))     where ms = map unLoc alts  instance AllVars (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}@@ -26,7 +27,6 @@ import GHC.Util.FreeVars import GHC.Util.View -import Control.Applicative import Control.Monad.Trans.Class import Control.Monad.Trans.State import Control.Monad.Trans.Writer.CPS@@ -39,7 +39,7 @@  import Refact (substVars, toSSA) import Refact.Types hiding (SrcSpan, Match)-import qualified Refact.Types as R (SrcSpan)+import Refact.Types qualified as R (SrcSpan)  import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr@@ -58,7 +58,7 @@  -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@ lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs-lambda vs body = noLocA $ HsLam noExtField (MG noExtField (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]) Generated)+lambda vs body = noLocA $ HsLam noExtField (MG Generated (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]))  -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic. paren :: LHsExpr GhcPs -> LHsExpr GhcPs@@ -86,7 +86,7 @@ universeApps x = x : concatMap universeApps (childrenApps x)  descendAppsM :: Monad m => (LHsExpr GhcPs  -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)-descendAppsM f (L l (HsApp _ x y)) = liftA2 (\x y -> L l $ HsApp EpAnnNotUsed x y) (descendAppsM f x) (f y)+descendAppsM f (L l (HsApp _ x y)) = (\x y -> L l $ HsApp EpAnnNotUsed x y) <$> descendAppsM f x <*> f y descendAppsM f x = descendM f x  transformAppsM :: Monad m => (LHsExpr GhcPs -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)@@ -125,7 +125,7 @@ simplifyExp e@(L _ (HsLet _ _ ((HsValBinds _ (ValBinds _ binds []))) _ z)) =   -- An expression of the form, 'let x = y in z'.   case bagToList binds of-    [L _ (FunBind _ _ (MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _) [] (GRHSs _[L _ (GRHS _ [] y)] ((EmptyLocalBinds _))))]) _) _)]+    [L _ (FunBind _ _ (MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _) [] (GRHSs _[L _ (GRHS _ [] y)] ((EmptyLocalBinds _))))])))]          -- If 'x' is not in the free variables of 'y', beta-reduce to          -- 'z[(y)/x]'.       | occNameStr x `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->@@ -242,7 +242,7 @@   let grhs = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs)       grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs], grhssLocalBinds=EmptyLocalBinds noExtField}       match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)-      matchGroup = MG {mg_ext=noExtField, mg_origin=Generated, mg_alts=noLocA [match]}+      matchGroup = MG {mg_ext=Generated, mg_alts=noLocA [match]}   in (noLocA $ HsLam noExtField matchGroup, const [])  @@ -251,8 +251,8 @@ replaceBranches :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs) replaceBranches (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf EpAnnNotUsed a b c)) -replaceBranches (L s (HsCase _ a (MG _ (L l bs) FromSource))) =-  (concatMap f bs, \xs -> L s (HsCase EpAnnNotUsed a (MG noExtField (L l (g bs xs)) Generated)))+replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) =+  (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG Generated . L l . g bs)   where     f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]     f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs]

@@ -10,7 +10,6 @@ import GHC.Hs import GHC.Types.SrcLoc import GHC.Types.SourceText-import GHC.Unit.Module import GHC.Data.FastString import GHC.Types.Name.Reader import GHC.Types.Name.Occurrence@@ -21,6 +20,7 @@  import Data.List.Extra import Data.Maybe+import Data.Bifunctor  -- A scope is a list of import declarations. newtype Scope = Scope [LImportDecl GhcPs]@@ -30,7 +30,7 @@     show (Scope x) = unsafePrettyPrint x  -- Create a 'Scope from a module's import declarations.-scopeCreate :: HsModule -> Scope+scopeCreate :: HsModule GhcPs -> Scope scopeCreate xs = Scope $ [prelude | not $ any isPrelude res] ++ res   where     -- Package qualifier of an import declaration.@@ -40,13 +40,13 @@         RawPkgQual s -> Just s         NoRawPkgQual -> Nothing -    -- The import declaraions contained by the module 'xs'.+    -- The import declarations contained by the module 'xs'.     res :: [LImportDecl GhcPs]     res = [x | x <- hsmodImports xs              , pkg x /= Just (StringLiteral NoSourceText (fsLit "hint") Nothing)           ] -    -- Mock up an import declaraion corresponding to 'import Prelude'.+    -- Mock up an import declaration corresponding to 'import Prelude'.     prelude :: LImportDecl GhcPs     prelude = noLocA $ simpleImportDecl (mkModuleName "Prelude") @@ -116,7 +116,7 @@   where ms = map unLoc $ ideclName i : maybeToList (ideclAs i) possImport (L _ i) (L _ (Unqual x)) =   if ideclQualified i == NotQualified-    then maybe PossiblyImported f (ideclHiding i)+    then maybe PossiblyImported (f . first (== EverythingBut)) (ideclImportList i)     else NotImported   where     f :: (Bool, LocatedL [LIE GhcPs]) -> IsImported@@ -137,6 +137,6 @@     g (L _ (IEThingWith _ y _wildcard ys)) = Just $ tag `elem` unwrapName y : map unwrapName ys     g _ = Just False -    unwrapName :: LIEWrappedName RdrName -> String+    unwrapName :: LIEWrappedName GhcPs -> String     unwrapName x = occNameString (rdrNameOcc $ ieWrappedName (unLoc x)) possImport _ _ = NotImported

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  module GHC.Util.SrcLoc (@@ -10,7 +11,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Data.FastString-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified  import Data.Default import Data.Data

@@ -61,10 +61,10 @@ removeParens noParens (Subst xs) = Subst $   map (\(x, y) -> if x `elem` noParens then (x, fromParen y) else (x, y)) xs --- Peform a substition.+-- Perform a substitution. -- Returns (suggested replacement, (refactor template, no bracket vars)). It adds/removes brackets -- for both the suggested replacement and the refactor template appropriately. The "no bracket vars"--- is a list of substituation variables which, when expanded, should have the brackets stripped.+-- is a list of substitution variables which, when expanded, should have the brackets stripped. -- -- Examples: --   (traverse foo (bar baz), (traverse f (x), []))@@ -95,7 +95,7 @@     typ :: LHsType GhcPs -> LHsType GhcPs     -- Type variables.     typ (L _ (HsTyVar _ _ x))-      | Just (L _ (HsAppType _ _ (HsWC _ y))) <- lookup (rdrNameStr x) bind = y+      | Just (L _ (HsAppType _ _ _ (HsWC _ y))) <- lookup (rdrNameStr x) bind = y     typ x = x :: LHsType GhcPs  @@ -114,30 +114,29 @@     | Just (x, y) <- cast (x, y) = if (x :: FastString) == y then Just mempty else Nothing      -- We need some type magic to reduce this.-    | Just (x :: EpAnn AnnsModule) <- cast x = Just mempty-    | Just (x :: EpAnn NameAnn) <- cast x = Just mempty-    | Just (x :: EpAnn AnnListItem) <- cast x = Just mempty-    | Just (x :: EpAnn AnnList) <- cast x = Just mempty-    | Just (x :: EpAnn AnnPragma) <- cast x = Just mempty-    | Just (x :: EpAnn AnnContext) <- cast x = Just mempty-    | Just (x :: EpAnn AnnParen) <- cast x = Just mempty     | Just (x :: EpAnn Anchor) <- cast x = Just mempty-    | Just (x :: EpAnn NoEpAnns) <- cast x = Just mempty-    | Just (x :: EpAnn GrhsAnn) <- cast x = Just mempty-    | Just (x :: EpAnn [AddEpAnn]) <- cast x = Just mempty-    | Just (x :: EpAnn EpAnnHsCase) <- cast x = Just mempty-    | Just (x :: EpAnn EpAnnUnboundVar) <- cast x = Just mempty+    | Just (x :: EpAnn AnnContext) <- cast x = Just mempty     | Just (x :: EpAnn AnnExplicitSum) <- cast x = Just mempty+    | Just (x :: EpAnn AnnFieldLabel) <- cast x = Just mempty+    | Just (x :: EpAnn AnnList) <- cast x = Just mempty+    | Just (x :: EpAnn AnnListItem) <- cast x = Just mempty+    | Just (x :: EpAnn AnnParen) <- cast x = Just mempty+    | Just (x :: EpAnn AnnPragma) <- cast x = Just mempty     | Just (x :: EpAnn AnnProjection) <- cast x = Just mempty-    | Just (x :: EpAnn Anchor) <- cast x = Just mempty+    | Just (x :: EpAnn AnnsIf) <- cast x = Just mempty+    | Just (x :: EpAnn AnnSig) <- cast x = Just mempty+    | Just (x :: EpAnn AnnsModule) <- cast x = Just mempty     | Just (x :: EpAnn EpaLocation) <- cast x = Just mempty-    | Just (x :: EpAnn AnnFieldLabel) <- cast x = Just mempty+    | Just (x :: EpAnn EpAnnHsCase) <- cast x = Just mempty+    | Just (x :: EpAnn EpAnnImportDecl) <- cast x = Just mempty     | Just (x :: EpAnn EpAnnSumPat) <- cast x = Just mempty-    | Just (x :: EpAnn AnnSig) <- cast x = Just mempty+    | Just (x :: EpAnn EpAnnUnboundVar) <- cast x = Just mempty+    | Just (x :: EpAnn GrhsAnn) <- cast x = Just mempty     | Just (x :: EpAnn HsRuleAnn) <- cast x = Just mempty-    | Just (x :: EpAnn EpAnnImportDecl) <- cast x = Just mempty+    | Just (x :: EpAnn NameAnn) <- cast x = Just mempty+    | Just (x :: EpAnn NoEpAnns) <- cast x = Just mempty+    | Just (x :: EpAnn [AddEpAnn]) <- cast x = Just mempty     | Just (x :: EpAnn (AddEpAnn, AddEpAnn)) <- cast x = Just mempty-    | Just (x :: EpAnn AnnsIf) <- cast x = Just mempty     | Just (x :: TokenLocation) <- cast y = Just mempty     | Just (y :: SrcSpan) <- cast y = Just mempty @@ -228,7 +227,7 @@ -- dot at the root, since otherwise you get two matches because of -- 'readRule' (Bug #570). unifyExp' :: NameMatch -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst (LHsExpr GhcPs))--- Don't subsitute for type apps, since no one writes rules imagining+-- Don't substitute for type apps, since no one writes rules imagining -- they exist. unifyExp' nm root (L _ (HsVar _ (rdrNameStr -> v))) y | isUnifyVar v, not $ isTypeApp y = Just $ Subst [(v, y)] unifyExp' nm root (L _ (HsVar _ x)) (L _ (HsVar _ y)) | nm x y = Just mempty@@ -288,7 +287,7 @@ unifyType' :: NameMatch -> LHsType GhcPs -> LHsType GhcPs -> Maybe (Subst (LHsExpr GhcPs)) unifyType' nm (L loc (HsTyVar _ _ x)) y =   let wc = HsWC noExtField y :: LHsWcType (NoGhcTc GhcPs)-      unused = strToVar "__unused__" :: LHsExpr GhcPs-      appType = L loc (HsAppType noSrcSpan unused wc) :: LHsExpr GhcPs+      unused = strToVar "__unused__"+      appType = L loc (HsAppType noExtField unused noHsTok wc)  in Just $ Subst [(rdrNameStr x, appType)] unifyType' nm x y = unifyDef' nm x y

@@ -32,8 +32,8 @@ data LamConst1 = NoLamConst1 | LamConst1 (LocatedA (HsExpr GhcPs))  instance View (LocatedA (HsExpr GhcPs)) LamConst1 where-  view (fromParen -> (L _ (HsLam _ (MG _ (L _ [L _ (Match _ LambdaExpr [L _ WildPat {}]-    (GRHSs _ [L _ (GRHS _ [] x)] ((EmptyLocalBinds _))))]) FromSource)))) = LamConst1 x+  view (fromParen -> (L _ (HsLam _ (MG FromSource (L _ [L _ (Match _ LambdaExpr [L _ WildPat {}]+    (GRHSs _ [L _ (GRHS _ [] x)] ((EmptyLocalBinds _))))]))))) = LamConst1 x   view _ = NoLamConst1  instance View (LocatedA (HsExpr GhcPs)) RdrName_ where@@ -62,4 +62,4 @@  -- A lambda with no guards and no where clauses pattern SimpleLambda :: [LocatedA (Pat GhcPs)] -> LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)-pattern SimpleLambda vs body <- L _ (HsLam _ (MG _ (L _ [L _ (Match _ _ vs (GRHSs _ [L _ (GRHS _ [] body)] ((EmptyLocalBinds _))))]) _))+pattern SimpleLambda vs body <- L _ (HsLam _ (MG _ (L _ [L _ (Match _ _ vs (GRHSs _ [L _ (GRHS _ [] body)] ((EmptyLocalBinds _))))])))

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-}@@ -17,6 +18,7 @@ import System.IO.Extra import System.Time.Extra import Data.Tuple.Extra+import Data.Bifunctor (bimap) import Prelude  import CmdLine@@ -36,6 +38,7 @@ import CC import EmbedData +import SARIF qualified  -- | This function takes a list of command line arguments, and returns the given hints. --   To see a list of arguments type @hlint --help@ at the console.@@ -167,12 +170,13 @@ runHints args settings cmd@CmdMain{..} =     withNumCapabilities cmdThreads $ do         let outStrLn = whenNormal . putStrLn-        ideas <- getIdeas cmd settings-        ideas <- pure $ if cmdShowAll then ideas else  filter (\i -> ideaSeverity i /= Ignore) ideas+        ideas <- filterIdeas <$> getIdeas cmd settings         if cmdJson then             putStrLn $ showIdeasJson ideas          else if cmdCC then             mapM_ (printIssue . fromIdea) ideas+         else if cmdSARIF then+            SARIF.printIdeas ideas          else if cmdSerialise then do             hSetBuffering stdout NoBuffering             print $ map (show &&& ideaRefactoring) ideas@@ -184,6 +188,12 @@             mapM_ (outStrLn . showItem) ideas             handleReporting ideas cmd         pure ideas+  where+    filteredSeverities+        | cmdShowAll = []+        | cmdIgnoreSuggestions = [Ignore, Suggestion]+        | otherwise = [Ignore]+    filterIdeas = filter (\i -> ideaSeverity i `notElem` filteredSeverities)  getIdeas :: Cmd -> [Setting] -> IO [Idea] getIdeas cmd@CmdMain{..} settings = do@@ -219,8 +229,14 @@         outStrLn $ "Writing report to " ++ x ++ " ..."         writeReport cmdDataDir x showideas     unless cmdNoSummary $ do-        let n = length showideas-        outStrLn $ if n == 0 then "No hints" else show n ++ " hint" ++ ['s' | n/=1]+        let (nbErrors, nbHints) = bimap length length $ partition (\idea -> ideaSeverity idea == Error) showideas+        when (nbErrors > 0) (outStrLn $ formatOutput nbErrors "error")+        unless (nbErrors > 0 && nbHints == 0) (outStrLn $ formatOutput nbHints "hint")++    where+        formatOutput :: Int -> String -> String+        formatOutput number name =+            if number == 0 then "No " ++ name ++ "s" else show number ++ " " ++ name ++ ['s' | number/=1]  evaluateList :: [a] -> IO [a] evaluateList xs = do

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}@@ -45,6 +46,13 @@ issue1179 = do(this is a test) -- do this is a test issue1212 = $(Git.hash) +-- no record dot syntax+referenceDesignator = ReferenceDesignator (p.placementReferenceDesignator)++-- record dot syntax+{-# LANGUAGE OverloadedRecordDot #-} \+referenceDesignator = ReferenceDesignator (p.placementReferenceDesignator) -- p.placementReferenceDesignator @NoRefactor: refactor requires GHC >= 9.2.1+ -- type bracket reduction foo :: (Int -> Int) -> Int foo :: (Maybe Int) -> a -- @Suggestion Maybe Int -> a@@ -104,6 +112,17 @@  -- template haskell is harder issue1292 = [e| handleForeignCatch $ \ $(varP pylonExPtrVarName) -> $(quoteExp C.block modifiedStr) |]++-- no warnings for single-argument constraint contexts+foo :: (A) => ()+bar :: (A a) => ()+foo' :: ((A) => ()) -> ()+bar' :: ((A a) => ()) -> ()+data Dict c where Dict :: (c) => Dict c+data Dict' c a where Dict' :: (c a) => Dict' c a++-- issue1501: Redundant bracket hint resulted in a parse error+x = f $ \(Proxy @a) -> True </TEST> -} @@ -127,10 +146,17 @@ bracketHint :: DeclHint bracketHint _ _ x =   concatMap (\x -> bracket prettyExpr isPartialAtom True x ++ dollar x) (childrenBi (descendBi splices $ descendBi annotations x) :: [LHsExpr GhcPs]) ++-  concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi x :: [LHsType GhcPs]) +++  concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi (preprocess x) :: [LHsType GhcPs]) ++   concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi x :: [LPat GhcPs]) ++   concatMap fieldDecl (childrenBi x)    where+     preprocess = transformBi removeSingleAtomConstrCtxs+       where+         removeSingleAtomConstrCtxs :: LHsContext GhcPs -> LHsContext GhcPs+         removeSingleAtomConstrCtxs = fmap $ \case+           [ty] | isAtom ty -> []+           tys -> tys+      -- Brackets the roots of annotations are fine, so we strip them.      annotations :: AnnDecl GhcPs -> AnnDecl GhcPs      annotations= descendBi $ \x -> case (x :: LHsExpr GhcPs) of@@ -145,7 +171,7 @@      splices x = x  -- If we find ourselves in the context of a section and we want to--- issue a warning that a child therein has unneccessary brackets,+-- issue a warning that a child therein has unnecessary brackets, -- we'd rather report 'Found : (`Foo` (Bar Baz))' rather than 'Found : -- `Foo` (Bar Baz)'. If left to 'unsafePrettyPrint' we'd get the -- latter (in contrast to the HSE pretty printer). This patches things@@ -162,12 +188,15 @@   where     go e = maybe e go (remParen e) +-- note(sf, 2022-06-02): i've completely bluffed my way through this.+-- see+-- https://gitlab.haskell.org/ghc/ghc/-/commit/7975202ba9010c581918413808ee06fbab9ac85f+-- for where splice expressions were refactored. isPartialAtom :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool -- Might be '$x', which was really '$ x', but TH enabled misparsed it.-isPartialAtom _ (L _ (HsSpliceE _ (HsTypedSplice _ DollarSplice _ _) )) = True-isPartialAtom _ (L _ (HsSpliceE _ (HsUntypedSplice _ DollarSplice _ _) )) = True+isPartialAtom _ (L _ (HsUntypedSplice _ HsUntypedSpliceExpr{})) = True -- Might be '$(x)' where the brackets are required in GHC 8.10 and below-isPartialAtom (Just (L _ HsSpliceE{})) _ = True+isPartialAtom (Just (L _ HsUntypedSplice{})) _ = True isPartialAtom _ x = isRecConstr x || isRecUpdate x  bracket :: forall a . (Data a, Outputable a, Brackets (LocatedA a)) => (LocatedA a -> String) -> (Maybe (LocatedA a) -> LocatedA a -> Bool) -> Bool -> LocatedA a -> [Idea]

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-}  {- <TEST>@@ -21,7 +22,7 @@ import GHC.Types.SrcLoc import GHC.Parser.Annotation import GHC.Util-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified  directives :: [String] directives = words $

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE PatternGuards, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} @@ -30,8 +31,8 @@ import Data.Maybe import Data.Tuple.Extra import Data.List hiding (find)-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as Map+import Data.List.NonEmpty qualified as NE+import Data.Map qualified as Map  import GHC.Types.SrcLoc import GHC.Hs

@@ -16,7 +16,6 @@ import Hint.Type(ModuHint, ModuleEx(..),ideaNote,ignore,Note(..))  import GHC.Hs-import GHC.Unit.Module import GHC.Types.SrcLoc import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader@@ -33,11 +32,11 @@   , exports' <- [x | x <- xs, not (matchesModName modName x)]   , modName `elem` names =       let dots = mkRdrUnqual (mkVarOcc " ... ")-          r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA (IEName (noLocA dots)))) : exports') )}+          r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA (IEName noExtField (noLocA dots)))) : exports') )}       in         [ignore "Use explicit module export list" (L s o) (noLoc r) []]       where-          o = m{hsmodImports=[], hsmodDecls=[], hsmodDeprecMessage=Nothing, hsmodHaddockModHeader=Nothing }+          o = m{hsmodImports=[], hsmodDecls=[] }           isMod (L _ (IEModuleContents _ _)) = True           isMod _ = False 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase, NamedFieldPuns, ScopedTypeVariables #-}  {-@@ -98,7 +99,7 @@ {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} \ newtype Micro = Micro Int deriving Generic -- {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric, TypeFamilies #-} \-data family Bar a; data instance Bar Foo = Foo deriving (Generic)+data family Bar a; data instance Bar Foo = Foo deriving Generic {-# LANGUAGE GeneralizedNewtypeDeriving #-} \ instance Class Int where {newtype MyIO a = MyIO a deriving NewClass} {-# LANGUAGE UnboxedTuples #-} \@@ -248,13 +249,18 @@ foo = [|| x ||] {-# LANGUAGE TemplateHaskell #-} \ foo = $bar+{-# LANGUAGE TypeData # -} \+type data Nat = Zero | Succ Nat  -- @NoRefactor: refactor requires GHC >= 9.6.1+{-# LANGUAGE TypeData #-} \+data T = MkT -- @NoRefactor: refactor requires GHC >= 9.6.1 </TEST> -}  + module Hint.Extensions(extensionsHint) where -import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments)+import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,firstDeclComments) import Extension  import Data.Generics.Uniplate.DataOnly@@ -263,8 +269,8 @@ import Data.List.Extra import Data.Data import Refact.Types-import qualified Data.Set as Set-import qualified Data.Map as Map+import Data.Set qualified as Set+import Data.Map qualified as Map  import GHC.Types.SrcLoc import GHC.Types.SourceText@@ -272,7 +278,7 @@ import GHC.Types.Basic import GHC.Types.Name.Reader import GHC.Types.ForeignCall-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified import GHC.Types.PkgQual  import GHC.Util@@ -299,7 +305,13 @@             [ Note $ "Extension " ++ s ++ " is " ++ reason x             | (s, Just x) <- explainedRemovals])         [ModifyComment (toSSAnc (mkLanguagePragmas sl exts)) newPragma]-    | (L sl _,  exts) <- languagePragmas $ pragmas (modComments x)+    | (L sl _,  exts) <-+      -- Comments appearing without an empty line before the first+      -- declaration in a module are now associated with the+      -- declaration not the module so to be safe, look also at+      -- `firstDeclComments x`+      -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+      languagePragmas $ pragmas (modComments x) ++ pragmas (firstDeclComments x)     , let before = [(x, readExtension x) | x <- exts]     , let after = filter (maybe True (`Set.member` keep) . snd) before     , before /= after@@ -319,8 +331,16 @@      -- All the extensions defined to be used.     extensions :: Set.Set Extension-    extensions = Set.fromList $ mapMaybe readExtension $-        concatMap snd $ languagePragmas (pragmas (modComments x))+    extensions = Set.fromList $+      concatMap+      (mapMaybe readExtension . snd)+      (languagePragmas+        (pragmas (modComments x) ++ pragmas (firstDeclComments x)))+      -- Comments appearing without an empty line before the first+      -- declaration in a module are now associated with the+      -- declaration not the module so to be safe, look also at+      -- `firstDeclComments x`+      -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).      -- Those extensions we detect to be useful.     useful :: Set.Set Extension@@ -370,7 +390,7 @@ deriveStock :: [String] deriveStock = deriveHaskell ++ deriveGenerics ++ deriveCategory -usedExt :: Extension -> Located HsModule -> Bool+usedExt :: Extension -> Located (HsModule GhcPs) -> Bool usedExt NumDecimals = hasS isWholeFrac   -- Only whole number fractions are permitted by NumDecimals   -- extension.  Anything not-whole raises an error.@@ -378,23 +398,30 @@ usedExt DeriveAnyClass = not . null . derivesAnyclass . derives usedExt x = used x -used :: Extension -> Located HsModule -> Bool+used :: Extension -> Located (HsModule GhcPs) -> Bool  used RecursiveDo = hasS isMDo ||^ hasS isRecStmt used ParallelListComp = hasS isParComp used FunctionalDependencies = hasT (un :: FunDep GhcPs) used ImplicitParams = hasT (un :: HsIPName)+ used TypeApplications = hasS isTypeApp ||^ hasS isKindTyApp+ used EmptyDataDecls = hasS f   where     f :: HsDataDefn GhcPs -> Bool-    f (HsDataDefn _ _ _ _ _ [] _) = True+    f (HsDataDefn _ _ _ _ (DataTypeCons _ []) _) = True     f _ = False+used TypeData  = hasS f+  where+    f :: HsDataDefn GhcPs -> Bool+    f (HsDataDefn _ _ _ _ (DataTypeCons True _) _) = True+    f _ = False used EmptyCase = hasS f   where     f :: HsExpr GhcPs -> Bool-    f (HsCase _ _ (MG _ (L _ []) _)) = True-    f (HsLamCase _ _ (MG _ (L _ []) _)) = True+    f (HsCase _ _ (MG _ (L _ []))) = True+    f (HsLamCase _ _ (MG _ (L _ []))) = True     f _ = False used KindSignatures = hasT (un :: HsKind GhcPs) used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch@@ -497,7 +524,7 @@  used _= const True -hasDerive :: [String] -> Located HsModule -> Bool+hasDerive :: [String] -> Located (HsModule GhcPs) -> Bool hasDerive want = any (`elem` want) . derivesStock' . derives  -- Derivations can be implemented using any one of 3 strategies, so for each derivation@@ -526,14 +553,14 @@     ,derivesNewtype' = if maybe True isNewType nt then filter (`notElem` noDeriveNewtype) xs else []}     where (stock, other) = partition (`elem` deriveStock) xs -derives :: Located HsModule -> Derives+derives :: Located (HsModule GhcPs) -> Derives derives (L _ m) =  mconcat $ map decl (childrenBi m) ++ map idecl (childrenBi m)   where     idecl :: DataFamInstDecl GhcPs -> Derives-    idecl (DataFamInstDecl FamEqn {feqn_rhs=HsDataDefn {dd_ND=dn, dd_derivs=ds}}) = g dn ds+    idecl (DataFamInstDecl FamEqn {feqn_rhs=HsDataDefn {dd_cons=data_defn_cons, dd_derivs=ds}}) = g (dataDefnConsNewOrData data_defn_cons) ds      decl :: LHsDecl GhcPs -> Derives-    decl (L _ (TyClD _ (DataDecl _ _ _ _ HsDataDefn {dd_ND=dn, dd_derivs=ds}))) = g dn ds -- Data declaration.+    decl (L _ (TyClD _ (DataDecl _ _ _ _ HsDataDefn {dd_cons=data_defn_cons, dd_derivs=ds}))) = g (dataDefnConsNewOrData data_defn_cons) ds -- Data declaration.     decl (L _ (DerivD _ (DerivDecl _ (HsWC _ sig) strategy _))) = addDerives Nothing (fmap unLoc strategy) [derivedToStr sig] -- A deriving declaration.     decl _ = mempty 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase, PatternGuards, RecordWildCards #-} {-     Reduce the number of import declarations.@@ -39,7 +40,7 @@  import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),suggest,toSSA,rawIdea) import Refact.Types hiding (ModuleName)-import qualified Refact.Types as R+import Refact.Types qualified as R import Data.Tuple.Extra import Data.List.Extra import Data.Generics.Uniplate.DataOnly@@ -51,7 +52,6 @@ import GHC.Types.SourceText import GHC.Hs import GHC.Types.SrcLoc-import GHC.Unit.Types -- for 'NotBoot' import GHC.Types.PkgQual  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -107,15 +107,15 @@     -- Both (un/)qualified, common 'as', different names : Merge the     -- second into the first and delete it.   | qual, as-  , Just (False, xs) <- ideclHiding x'-  , Just (False, ys) <- ideclHiding y' =-      let newImp = L loc x'{ideclHiding = Just (False, noLocA (unLoc xs ++ unLoc ys))}+  , Just (False, xs) <- first (== EverythingBut) <$> ideclImportList x'+  , Just (False, ys) <- first (== EverythingBut) <$> ideclImportList y' =+      let newImp = L loc x'{ideclImportList = Just (Exactly, noLocA (unLoc xs ++ unLoc ys))}       in Just (newImp, [Replace Import (toSSA x) [] (unsafePrettyPrint (unLoc newImp))                        , Delete Import (toSSA y)])   -- Both (un/qualified), common 'as', one has names the other doesn't   -- : Delete the one with names.-  | qual, as, isNothing (ideclHiding x') || isNothing (ideclHiding y') =-       let (newImp, toDelete) = if isNothing (ideclHiding x') then (x, y) else (y, x)+  | qual, as, isNothing (ideclImportList x') || isNothing (ideclImportList y') =+       let (newImp, toDelete) = if isNothing (ideclImportList x') then (x, y) else (y, x)        in Just (newImp, [Delete Import (toSSA toDelete)])   -- Both unqualified, same names, one (and only one) has an 'as'   -- clause : Delete the one without an 'as'.@@ -133,8 +133,8 @@         qual = ideclQualified x' == ideclQualified y'         as = ideclAs x' `eqMaybe` ideclAs y'         ass = mapMaybe ideclAs [x', y']-        specs = transformBi (const noSrcSpan) (ideclHiding x') ==-                    transformBi (const noSrcSpan) (ideclHiding y')+        specs = transformBi (const noSrcSpan) (ideclImportList x') ==+                    transformBi (const noSrcSpan) (ideclImportList y')  stripRedundantAlias :: LImportDecl GhcPs -> [Idea] stripRedundantAlias x@(L _ i@ImportDecl {..})

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase, PatternGuards, TupleSections, ViewPatterns #-}  {-@@ -110,7 +111,7 @@ import Util import Data.List.Extra import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Refact.Types hiding (Match) import Data.Generics.Uniplate.DataOnly (universe, universeBi, transformBi) @@ -169,7 +170,7 @@     where           reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)           reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD noExtField $-             origBind {fun_matches = MG noExtField (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField]) Generated}+             origBind {fun_matches = MG Generated (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])}            mkSubtsAndTpl newPats newBody = (sub, tpl)             where@@ -265,7 +266,7 @@                  -- we need to                  --     * add brackets to the match, because matches in lambdas require them                  --     * mark match as being in a lambda context so that it's printed properly-                 oldMG@(MG _ (L _ [L _ oldmatch]) _)+                 oldMG@(MG _ (L _ [L _ oldmatch]))                    | all (\(L _ (GRHS _ stmts _)) -> null stmts) (grhssGRHSs (m_grhss oldmatch)) ->                      let patLocs = fmap (locA . getLoc) (m_pats oldmatch)                          bodyLocs = concatMap (\case L _ (GRHS _ _ body) -> [locA (getLoc body)])@@ -293,7 +294,7 @@                          ]                   -- otherwise we should use @LambdaCase@-                 MG _ (L _ _) _ ->+                 MG _ (L _ _) ->                      [(suggestN "Use lambda-case" (reLoc o) $ noLoc $ HsLamCase EpAnnNotUsed LamCase matchGroup)                          {ideaNote=[RequiresExtension "LambdaCase"]}]         _ -> []

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ViewPatterns, PatternGuards, FlexibleContexts #-} {-     Find and match:@@ -47,14 +48,13 @@ import Data.Maybe import Prelude -import Hint.Type(DeclHint,Idea,suggest,ignore,substVars,toRefactSrcSpan,toSSA,modComments)+import Hint.Type(DeclHint,Idea,suggest,ignore,substVars,toRefactSrcSpan,toSSA,modComments,firstDeclComments)  import Refact.Types hiding (SrcSpan)-import qualified Refact.Types as R+import Refact.Types qualified as R  import GHC.Hs import GHC.Types.SrcLoc-import GHC.Types.Basic hiding (Pattern) import GHC.Types.SourceText import GHC.Types.Name.Reader import GHC.Data.FastString@@ -72,7 +72,11 @@ listHint :: DeclHint listHint _ modu = listDecl overloadedListsOn   where-    exts = concatMap snd (languagePragmas (pragmas (modComments modu)))+    -- Comments appearing without a line-break before the first+    -- declaration in a module are now associated with the declaration+    -- not the module so to be safe, look also at `firstDeclComments+    -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+    exts = concatMap snd (languagePragmas (pragmas (modComments modu) ++ pragmas (firstDeclComments modu)))     overloadedListsOn = "OverloadedLists" `elem` exts  listDecl :: Bool -> LHsDecl GhcPs -> [Idea]@@ -271,7 +275,7 @@   InstD _ ClsInstD{     cid_inst=         ClsInstDecl{cid_binds=x, cid_tyfam_insts=y, cid_datafam_insts=z}} ->-    f x ++ f y ++ f z -- Pretty much everthing but the instance type.+    f x ++ f y ++ f z -- Pretty much everything but the instance type.   _ -> f x   where     f x = concatMap g $ childrenBi x

@@ -135,7 +135,7 @@ asDo (view ->        App2 bind lhs          (L _ (HsLam _ MG {-              mg_origin=FromSource+              mg_ext=FromSource             , mg_alts=L _ [                  L _ Match {  m_ctxt=LambdaExpr                             , m_pats=[v@(L _ VarPat{})]@@ -157,7 +157,7 @@ findCase x = do   -- Match a function binding with two alternatives.   (L _ (ValD _ FunBind {fun_matches=-              MG{mg_origin=FromSource, mg_alts=+              MG{mg_ext=FromSource, mg_alts=                      (L _                             [ x1@(L _ Match{..}) -- Match fields.                             , x2]), ..} -- Match group fields.@@ -176,7 +176,7 @@       gRHS e = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.       gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs set.       match e = Match{m_ext=EpAnnNotUsed,m_pats=ps12, m_grhss=gRHSSs e, ..} -- Match.-      matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_origin=Generated, ..} -- Match group.+      matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated, ..} -- Match group.       funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind.    pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind)

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-} {-# LANGUAGE PatternGuards, ViewPatterns, FlexibleContexts #-} @@ -43,8 +44,8 @@  import Util import Timing-import qualified Data.Set as Set-import qualified Refact.Types as R+import Data.Set qualified as Set+import Refact.Types qualified as R  import Control.Monad import Data.Tuple.Extra@@ -200,7 +201,7 @@       isType "Compare" x = True -- Just a hint for proof stuff       isType "Atom" x = isAtom x       isType "WHNF" x = isWHNF x-      isType "Wildcard" x = any isFieldPun (universeBi x) || any hasFieldsDotDot (universeBi x)+      isType "Wildcard" x = any hasFieldsDotDot (universeBi x)       isType "Nat" (asInt -> Just x) | x >= 0 = True       isType "Pos" (asInt -> Just x) | x >  0 = True       isType "Neg" (asInt -> Just x) | x <  0 = True

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-}@@ -77,7 +78,7 @@ import GHC.Types.Name.Reader import GHC.Types.Name.Occurrence import GHC.Data.Bag-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified  import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr@@ -90,7 +91,7 @@ import Data.Maybe import Data.List.Extra import Refact.Types hiding (Match)-import qualified Refact.Types as R+import Refact.Types qualified as R   badFuncs :: [String]@@ -173,9 +174,9 @@ doAsBrackets Nothing x = False  --- Sometimes people write do, to avoid identation, see+-- Sometimes people write do, to avoid indentation, see -- https://github.com/ndmitchell/hlint/issues/978--- Return True if they are using do as avoiding identation+-- Return True if they are using do as avoiding indentation doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool doAsAvoidingIndentation (Just (L _ (HsDo _ _ (L anna _)))) (L _ (HsDo _ _ (L annb _)))   | SrcSpanAnn _ (RealSrcSpan a _) <- anna@@ -189,7 +190,7 @@ modifyAppHead f = go id   where     go :: (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)-    go wrap (L l (HsPar _ p x q )) = go (wrap . L l . \x -> HsPar EpAnnNotUsed p x q) x+    go wrap (L l (HsPar _ p x q)) = go (wrap . L l . \y -> HsPar EpAnnNotUsed p y q) x     go wrap (L l (HsApp _ x y)) = go (\x -> wrap $ L l (HsApp EpAnnNotUsed x y)) x     go wrap (L l (OpApp _ x op y)) | isDol op = go (\x -> wrap $ L l (OpApp EpAnnNotUsed x op y)) x     go wrap (L l (HsVar _ x)) = (wrap (L l (HsVar NoExtField x')), Just a)@@ -297,7 +298,7 @@             grhs = noLocA (GRHS EpAnnNotUsed [] rhs)             grhss = GRHSs emptyComments [grhs] (EmptyLocalBinds noExtField)             match = noLocA $ Match EpAnnNotUsed (FunRhs p Prefix NoSrcStrict) [] grhss-            fb = noLocA $ FunBind noExtField p (MG noExtField (noLocA [match]) Generated) []+            fb = noLocA $ FunBind noExtField p (MG Generated (noLocA [match]))             binds = unitBag fb             valBinds = ValBinds NoAnnSortKey binds []             localBinds = HsValBinds EpAnnNotUsed valBinds

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-@@ -44,10 +45,11 @@ import Hint.Type (Idea,DeclHint,suggest,ghcModule) import Data.Generics.Uniplate.DataOnly import Data.List.Extra (nubOrd, isPrefixOf)+import Data.List.NonEmpty (toList) import Data.Data import Data.Char import Data.Maybe-import qualified Data.Set as Set+import Data.Set qualified as Set  import GHC.Types.Basic import GHC.Types.SourceText@@ -85,9 +87,9 @@         replacedDecl = replaceNames suggestedNames originalDecl  shorten :: LHsDecl GhcPs -> LHsDecl GhcPs-shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG _ (L locMatches matches) FromSource) _))) =+shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG FromSource (L locMatches matches))))) =     L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ map shortenMatch matches}})-shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ grhss@(GRHSs _ rhss _) _))) =+shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ grhss@(GRHSs _ rhss _)))) =     L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = map shortenLGRHS rhss}}) shorten x = x @@ -106,14 +108,17 @@ getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)  getConstructorNames :: HsDecl GhcPs -> [String]-getConstructorNames (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ _ cons _))) =-    concatMap (map unsafePrettyPrint . getConNames' . unLoc) cons-    where-      getConNames' ConDeclH98  {con_name  = name}  = [name]-      getConNames' ConDeclGADT {con_names = names} = names-      getConNames' XConDecl{} = []+getConstructorNames tycld = case tycld of+    (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (NewTypeCon con) _))) -> conNames [con]+    (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (DataTypeCons _ cons) _))) -> conNames cons+    _ -> []+  where+    conNames :: [LConDecl GhcPs] -> [String]+    conNames =  concatMap (map unsafePrettyPrint . conNamesInDecl . unLoc) -getConstructorNames _ = []+    conNamesInDecl :: ConDecl GhcPs -> [LIdP GhcPs]+    conNamesInDecl ConDeclH98  {con_name  = name}  = [name]+    conNamesInDecl ConDeclGADT {con_names = names} = Data.List.NonEmpty.toList names  isSym :: String -> Bool isSym (x:_) = not $ isAlpha x || x `elem` "_'"

@@ -72,12 +72,11 @@ shouldSuggestStrategies dataDef = not (isData dataDef) && not (hasAllStrategies dataDef)  hasAllStrategies :: HsDataDefn GhcPs -> Bool-hasAllStrategies (HsDataDefn _ NewType _ _ _ _  xs) = all hasStrategyClause xs-hasAllStrategies _ = False+hasAllStrategies (HsDataDefn _ _ _ _ _  xs) = all hasStrategyClause xs  isData :: HsDataDefn GhcPs -> Bool-isData (HsDataDefn _ NewType _ _ _ _ _) = False-isData (HsDataDefn _ DataType _ _ _ _ _) = True+isData (HsDataDefn _ _ _ _ (NewTypeCon _) _) = False+isData (HsDataDefn _ _ _ _ (DataTypeCons _ _) _) = True  hasStrategyClause :: LHsDerivingClause GhcPs -> Bool hasStrategyClause (L _ (HsDerivingClause _ (Just _) _)) = True@@ -98,31 +97,39 @@ singleSimpleField :: LHsDecl GhcPs -> Maybe WarnNewtype singleSimpleField (L loc (TyClD ext decl@(DataDecl _ _ _ _ dataDef)))     | Just inType <- simpleHsDataDefn dataDef =-        Just WarnNewtype+        case dropBangs dataDef of+          DataTypeCons False [con] ->+            Just WarnNewtype               { newDecl = L loc $ TyClD ext decl {tcdDataDefn = dataDef-                  { dd_ND = NewType-                  , dd_cons = dropBangs dataDef-                  }}+                  { dd_cons = NewTypeCon con }}               , insideType = inType               }+          DataTypeCons True [_] -> Nothing -- Extension "TypeData": `type data T x = ...`+          _ -> Nothing singleSimpleField (L loc (InstD ext (DataFamInstD instExt (DataFamInstDecl famEqn@(FamEqn _ _ _ _ _ dataDef)))))     | Just inType <- simpleHsDataDefn dataDef =-        Just WarnNewtype-          { newDecl = L loc $ InstD ext $ DataFamInstD instExt $ DataFamInstDecl $ famEqn {feqn_rhs = dataDef-                  { dd_ND = NewType-                  , dd_cons = dropBangs dataDef-                  }}+        case dropBangs dataDef of+          DataTypeCons False [con] ->+            Just WarnNewtype+              { newDecl = L loc $ InstD ext $ DataFamInstD instExt $ DataFamInstDecl $ famEqn {feqn_rhs = dataDef+                      { dd_cons = NewTypeCon con }}               , insideType = inType               }+          DataTypeCons True [_] -> Nothing --  -- Extension "TypeData": `type data T x = ...`+          _ -> Nothing singleSimpleField _ = Nothing -dropBangs :: HsDataDefn GhcPs -> [LConDecl GhcPs]-dropBangs = map (fmap dropConsBang) . dd_cons+dropBangs :: HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)+dropBangs def =+  case dd_cons def of+    NewTypeCon a -> NewTypeCon (dropConsBang <$> a)+    DataTypeCons isTypeData as -> DataTypeCons isTypeData (map (dropConsBang <$>) as) --- | Checks whether its argument is a \"simple\" data definition (see 'singleSimpleField')--- returning the type inside its constructor if it is.+-- | Checks whether its argument is a \"simple\" data definition (see+-- 'singleSimpleField') returning the single thing under its+-- constructor if it is. simpleHsDataDefn :: HsDataDefn GhcPs -> Maybe (HsType GhcPs)-simpleHsDataDefn (HsDataDefn _ DataType _ _ _ [L _ constructor] _) = simpleCons constructor+simpleHsDataDefn (HsDataDefn _ _ _ _ (DataTypeCons _ [L _ constructor]) _) = simpleCons constructor simpleHsDataDefn _ = Nothing  -- | Checks whether its argument is a \"simple\" constructor (see criteria in 'singleSimpleField')

@@ -4,6 +4,8 @@ <TEST> 123456 {-# LANGUAGE NumericUnderscores #-} \+1234+{-# LANGUAGE NumericUnderscores #-} \ 12345 -- @Suggestion 12_345 @NoRefactor {-# LANGUAGE NumericUnderscores #-} \ 123456789.0441234e-123456 -- @Suggestion 123_456_789.044_123_4e-123_456 @NoRefactor@@ -26,15 +28,21 @@ import GHC.Util.ApiAnnotation (extensions) import Data.Char (isDigit, isOctDigit, isHexDigit) import Data.List (intercalate)+import Data.Set (union) import Data.Generics.Uniplate.DataOnly (universeBi) import Refact.Types -import Hint.Type (DeclHint, toSSA, modComments)+import Hint.Type (DeclHint, toSSA, modComments, firstDeclComments) import Idea (Idea, suggest)  numLiteralHint :: DeclHint numLiteralHint _ modu =-  if NumericUnderscores `elem` extensions (modComments modu) then+  -- Comments appearing without an empty line before the first+  -- declaration in a module are now associated with the declaration+  -- not the module so to be safe, look also at `firstDeclComments+  -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+  let exts = union (extensions (modComments modu)) (extensions (firstDeclComments modu)) in+  if NumericUnderscores `elem` exts then      concatMap suggestUnderscore . universeBi   else      const []@@ -44,12 +52,14 @@   [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]   where     underscoredSrcTxt = addUnderscore srcTxt+    y :: LocatedAn an (HsExpr GhcPs)     y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText underscoredSrcTxt}}     r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _))))) =   [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ]   where     underscoredSrcTxt = addUnderscore srcTxt+    y :: LocatedAn an (HsExpr GhcPs)     y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText underscoredSrcTxt}}     r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore _ = mempty@@ -65,7 +75,9 @@    chunkSize = if null (nl_prefix numLit) then 3 else 4     underscore chunkSize = intercalate "_" . chunk chunkSize-   underscoreFromRight chunkSize = reverse . underscore chunkSize . reverse+   underscoreFromRight chunkSize str+     | length str < 5 = str+     | otherwise = reverse . underscore chunkSize . reverse $ str    chunk chunkSize [] = []    chunk chunkSize xs = a:chunk chunkSize b where (a, b) = splitAt chunkSize xs 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ViewPatterns, PatternGuards, TypeFamilies #-}  {-@@ -58,7 +59,7 @@  module Hint.Pattern(patternHint) where -import Hint.Type(DeclHint,Idea,modComments,ideaTo,toSSA,toRefactSrcSpan,suggest,suggestRemove,warn)+import Hint.Type(DeclHint,Idea,modComments,firstDeclComments,ideaTo,toSSA,toRefactSrcSpan,suggest,suggestRemove,warn) import Data.Generics.Uniplate.DataOnly import Data.Function import Data.List.Extra@@ -66,7 +67,7 @@ import Data.Maybe import Data.Either import Refact.Types hiding (RType(Pattern, Match), SrcSpan)-import qualified Refact.Types as R (RType(Pattern, Match), SrcSpan)+import Refact.Types qualified as R (RType(Pattern, Match), SrcSpan)  import GHC.Hs import GHC.Types.SrcLoc@@ -74,7 +75,7 @@ import GHC.Types.Name.Occurrence import GHC.Data.Bag import GHC.Types.Basic hiding (Pattern)-import qualified GHC.Data.Strict+import GHC.Data.Strict qualified  import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.Pat@@ -87,11 +88,16 @@     concatMap (uncurry hints . swap) (asPattern x) ++     -- PatBind (used in 'let' and 'where') contains lazy-by-default     -- patterns, everything else is strict.-    concatMap (patHint strict False) [p | PatBind _ p _ _ <- universeBi x :: [HsBind GhcPs]] +++    concatMap (patHint strict False) [p | PatBind _ p _ <- universeBi x :: [HsBind GhcPs]] ++     concatMap (patHint strict True) (universeBi $ transformBi noPatBind x) ++     concatMap expHint (universeBi x)   where-    exts = nubOrd $ concatMap snd (languagePragmas (pragmas (modComments modu))) -- language extensions enabled at source+    -- Comments appearing without an empty line before the first+    -- declaration in a module are now associated with the declaration+    -- not the module so to be safe, look also at `firstDeclComments+    -- modu`+    -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+    exts = nubOrd $ concatMap snd (languagePragmas (pragmas (modComments modu) ++ pragmas (firstDeclComments modu))) -- language extensions enabled at source     strict = "Strict" `elem` exts      noPatBind :: LHsBind GhcPs -> LHsBind GhcPs@@ -184,8 +190,8 @@ asPattern (L loc x) = concatMap decl (universeBi x)   where     decl :: HsBind GhcPs -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]-    decl o@(PatBind _ pat rhs _) = [(Pattern (locA loc) Bind [pat] rhs, \msg (Pattern _ _ [pat] rhs) rs -> suggest msg (noLoc o :: Located (HsBind GhcPs)) (noLoc (PatBind EpAnnNotUsed pat rhs ([], [])) :: Located (HsBind GhcPs)) rs)]-    decl (FunBind _ _ (MG _ (L _ xs) _) _) = map match xs+    decl o@(PatBind _ pat rhs) = [(Pattern (locA loc) Bind [pat] rhs, \msg (Pattern _ _ [pat] rhs) rs -> suggest msg (noLoc o :: Located (HsBind GhcPs)) (noLoc (PatBind EpAnnNotUsed pat rhs) :: Located (HsBind GhcPs)) rs)]+    decl (FunBind _ _ (MG _ (L _ xs))) = map match xs     decl _ = []      match :: LMatch GhcPs (LHsExpr GhcPs) -> (Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)@@ -208,7 +214,7 @@   where     f :: Pat GhcPs -> Bool     f (ParPat _ _ (L _ x) _) = f x-    f (AsPat _ _ (L _ x)) = f x+    f (AsPat _ _ _ (L _ x)) = f x     f LitPat {} = True     f NPat {} = True     f ConPat {} = True@@ -222,22 +228,22 @@   where     f :: Pat GhcPs -> Bool     f (ParPat _ _ (L _ x) _) = f x-    f (AsPat _ _ (L _ x)) = f x+    f (AsPat _ _ _ (L _ x)) = f x     f WildPat{} = True     f VarPat{} = True     f _ = False     r = Replace R.Pattern (toSSA o) [("x", toSSA pat)] "x"-patHint _ _ o@(L _ (AsPat _ v (L _ (WildPat _)))) =+patHint _ _ o@(L _ (AsPat _ v _ (L _ (WildPat _)))) =   [warn "Redundant as-pattern" (reLoc o) (reLoc v) [Replace R.Pattern (toSSA o) [] (rdrNameStr v)]] patHint _ _ _ = []  expHint :: LHsExpr GhcPs -> [Idea]  -- Note the 'FromSource' in these equations (don't warn on generated match groups).-expHint o@(L _ (HsCase _ _ (MG _ (L _ [L _ (Match _ CaseAlt [L _ (WildPat _)] (GRHSs _ [L _ (GRHS _ [] e)] (EmptyLocalBinds _))) ]) FromSource ))) =+expHint o@(L _ (HsCase _ _ (MG FromSource (L _ [L _ (Match _ CaseAlt [L _ (WildPat _)] (GRHSs _ [L _ (GRHS _ [] e)] (EmptyLocalBinds _))) ])))) =   [suggest "Redundant case" (reLoc o) (reLoc e) [r]]   where     r = Replace Expr (toSSA o) [("x", toSSA e)] "x"-expHint o@(L _ (HsCase _ (L _ (HsVar _ (L _ x))) (MG _ (L _ [L _ (Match _ CaseAlt [L _ (VarPat _ (L _ y))] (GRHSs _ [L _ (GRHS _ [] e)] (EmptyLocalBinds _))) ]) FromSource )))+expHint o@(L _ (HsCase _ (L _ (HsVar _ (L _ x))) (MG FromSource (L _ [L _ (Match _ CaseAlt [L _ (VarPat _ (L _ y))] (GRHSs _ [L _ (GRHS _ [] e)] (EmptyLocalBinds _))) ]))))   | occNameStr x == occNameStr y =       [suggest "Redundant case" (reLoc o) (reLoc e) [r]]   where

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleContexts #-} @@ -32,12 +33,12 @@  module Hint.Pragma(pragmaHint) where -import Hint.Type(ModuHint,Idea(..),Severity(..),toSSAnc,rawIdea,modComments)+import Hint.Type(ModuHint,Idea(..),Severity(..),toSSAnc,rawIdea,modComments,firstDeclComments) import Data.List.Extra-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe import Refact.Types-import qualified Refact.Types as R+import Refact.Types qualified as R  import GHC.Hs import GHC.Types.SrcLoc@@ -48,7 +49,11 @@  pragmaHint :: ModuHint pragmaHint _ modu =-  let ps = pragmas (modComments modu)+  -- Comments appearing without a line-break before the first+  -- declaration in a module are now associated with the declaration+  -- not the module so to be safe, look also at `firstDeclComments+  -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+  let ps = pragmas (modComments modu) ++ pragmas (firstDeclComments modu)       opts = flags ps       lang = languagePragmas ps in     languageDupes lang ++ optToPragma opts lang

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}@@ -20,14 +21,14 @@ </TEST> -} -import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea,modComments)+import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea,modComments,firstDeclComments) import Config.Type import Util  import Data.Generics.Uniplate.DataOnly-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Set as Set-import qualified Data.Map as Map+import Data.List.NonEmpty qualified as NonEmpty+import Data.Set qualified as Set+import Data.Map qualified as Map import Data.List.Extra import Data.List.NonEmpty (nonEmpty) import Data.Maybe@@ -41,7 +42,6 @@  import GHC.Hs import GHC.Types.Name.Reader-import GHC.Unit.Module import GHC.Types.SrcLoc import GHC.Types.Name.Occurrence import Language.Haskell.GhclibParserEx.GHC.Hs@@ -51,8 +51,14 @@ -- FIXME: The settings should be partially applied, but that's hard to orchestrate right now restrictHint :: [Setting] -> ModuHint restrictHint settings scope m =-    let anns = modComments m-        ps   = pragmas anns+    -- Comments appearing without an empty line before the first+    -- declaration in a module are now associated with the declaration+    -- not the module so to be safe, look also at `firstDeclComments+    -- modu`+    -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).+    let annsMod = modComments m+        annsFirstDecl = firstDeclComments m+        ps   = pragmas annsMod ++ pragmas annsFirstDecl         opts = flags ps         exts = languagePragmas ps in     checkPragmas modu opts exts rOthers ++@@ -162,7 +168,7 @@           Left $ ideaNoTo $ warn "Avoid restricted module" (reLoc i) (reLoc i) []          let importedIdents = Set.fromList $-              case ideclHiding of+              case first (== EverythingBut) <$> ideclImportList of                 Just (False, lxs) -> concatMap (importListToIdents . unLoc) (unLoc lxs)                 _ -> []             invalidIdents = case riRestrictIdents of@@ -187,15 +193,15 @@                   | otherwise -> (second (<> " or unqualified") <$> expectedQualStyle, Nothing)                 ImportStyleQualified -> (expectedQualStyleDef, Nothing)                 ImportStyleExplicitOrQualified-                  | Just (False, _) <- ideclHiding -> (Nothing, Nothing)+                  | Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)                   | otherwise ->                       ( second (<> " or with an explicit import list") <$> expectedQualStyleDef                       , Nothing )                 ImportStyleExplicit-                  | Just (False, _) <- ideclHiding -> (Nothing, Nothing)+                  | Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)                   | otherwise ->                       ( Just (NotQualified, "unqualified")-                      , Just $ Just (False, noLocA []) )+                      , Just $ Just (Exactly, noLocA []) )                 ImportStyleUnqualified -> (Just (NotQualified, "unqualified"), Nothing)             expectedQualStyleDef = expectedQualStyle <|> Just (QualifiedPre, "qualified")             expectedQualStyle =@@ -208,7 +214,7 @@               | otherwise = expectedQual         whenJust qualIdea $ \(qual, hint) -> do           let i' = noLoc $ (unLoc i){ ideclQualified = qual-                                    , ideclHiding = fromMaybe ideclHiding expectedHiding }+                                    , ideclImportList = fromMaybe ideclImportList expectedHiding }               msg = moduleNameString (unLoc ideclName) <> " should be imported " <> hint           Left $ warn msg (reLoc i) i' [] @@ -237,10 +243,10 @@         (IEThingWith _ n _ ns)   -> fromName n : map fromName ns         _                        -> []   where-    fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String+    fromName :: LIEWrappedName GhcPs -> Maybe String     fromName wrapped =       case unLoc wrapped of-        IEName      n -> fromId (unLoc n)+        IEName    _ n -> fromId (unLoc n)         IEPattern _ n -> ("pattern " ++) <$> fromId (unLoc n)         IEType    _ n -> ("type " ++) <$> fromId (unLoc n) 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-}  module Hint.Smell (smellModuleHint,smellHint) where @@ -80,7 +81,7 @@  import Data.Generics.Uniplate.DataOnly import Data.List.Extra-import qualified Data.Map as Map+import Data.Map qualified as Map  import GHC.Utils.Outputable import GHC.Types.Basic@@ -128,7 +129,7 @@ declSpans    (L _ (ValD _      FunBind {fun_matches=MG {-                   mg_origin=FromSource+                   mg_ext=FromSource                  , mg_alts=(L _ [L _ Match {                        m_ctxt=ctx                      , m_grhss=GRHSs{grhssGRHSs=[locGrhs]

@@ -54,8 +54,8 @@      -- 'x' does not declare a new function.      | d@(ValD _            FunBind {fun_id=L _ (Unqual x)-                      , fun_matches=MG{mg_origin=FromSource,mg_alts=L _ [L _ Match {m_pats=[]}]}}) <- [d]-     -- 'x' is a synonym for an appliciation involing 'unsafePerformIO'+                      , fun_matches=MG{mg_ext=FromSource,mg_alts=L _ [L _ Match {m_pats=[]}]}}) <- [d]+     -- 'x' is a synonym for an application involving 'unsafePerformIO'      , isUnsafeDecl d      -- 'x' is not marked 'NOINLINE'.      , x `notElem` noinline]@@ -70,7 +70,7 @@         ) <- hsmodDecls m]  isUnsafeDecl :: HsDecl GhcPs -> Bool-isUnsafeDecl (ValD _ FunBind {fun_matches=MG {mg_origin=FromSource,mg_alts=L _ alts}}) =+isUnsafeDecl (ValD _ FunBind {fun_matches=MG {mg_ext=FromSource,mg_alts=L _ alts}}) =   any isUnsafeApp (childrenBi alts) || any isUnsafeDecl (childrenBi alts) isUnsafeDecl _ = False 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-}  module Idea(@@ -13,7 +14,7 @@ import Config.Type import HsColour import Refact.Types hiding (SrcSpan)-import qualified Refact.Types as R+import Refact.Types qualified as R import Prelude import GHC.Types.SrcLoc import GHC.Utils.Outputable@@ -36,7 +37,7 @@     deriving Eq  -- I don't use aeson here for 2 reasons:--- 1) Aeson doesn't esape unicode characters, and I want to (allows me to ignore encoding)+-- 1) Aeson doesn't escape unicode characters, and I want to (allows me to ignore encoding) -- 2) I want to control the format so it's slightly human readable as well showIdeaJson :: Idea -> String showIdeaJson idea@Idea{ideaSpan=srcSpan@SrcSpan{..}, ..} = dict

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE PatternGuards, RecordWildCards #-}  -- |  This module provides a way to apply HLint hints. If you want to just run @hlint@ in-process@@ -33,13 +34,13 @@ import Config.Type import Config.Read import Idea-import qualified Apply as H+import Apply qualified as H import HLint import Fixity import GHC.Data.FastString ( unpackFS ) import GHC.All import Hint.All hiding (resolveHints)-import qualified Hint.All as H+import Hint.All qualified as H import GHC.Types.SrcLoc import CmdLine import Paths_hlint@@ -49,7 +50,7 @@ import System.FilePath import Data.Functor import Prelude-import qualified Hint.Restrict as Restrict+import Hint.Restrict qualified as Restrict   -- | Get the Cabal configured data directory of HLint.@@ -57,7 +58,7 @@ getHLintDataDir = getDataDir  --- | The function produces a tuple containg 'ParseFlags' (for 'parseModuleEx'),+-- | The function produces a tuple containing 'ParseFlags' (for 'parseModuleEx'), --   and 'Classify' and 'Hint' for 'applyHints'. --   It approximates the normal HLint configuration steps, roughly: --@@ -144,7 +145,7 @@ -- -- > (filename, (startLine, startCol), (endLine, endCol)) -----   Following the GHC API, he end column is the column /after/ the end of the error.+--   Following the GHC API, end column is the column /after/ the end of the error. --   Lines and columns are 1-based. Returns 'Nothing' if there is no helpful location information. unpackSrcSpan :: SrcSpan -> Maybe (FilePath, (Int, Int), (Int, Int)) unpackSrcSpan (RealSrcSpan x _) = Just

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-}  module Refact@@ -17,10 +18,10 @@ import System.Exit import System.IO.Extra import System.Process.Extra-import qualified Refact.Types as R+import Refact.Types qualified as R -import qualified GHC.Types.SrcLoc as GHC-import qualified GHC.Parser.Annotation as GHC+import GHC.Types.SrcLoc qualified as GHC+import GHC.Parser.Annotation qualified as GHC  import GHC.Util.SrcLoc (getAncLoc) 

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE RecordWildCards #-}  module Report(writeReport) where@@ -5,14 +6,14 @@ import Idea import Data.Tuple.Extra import Data.List.Extra-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Version import Timing import Paths_hlint import HsColour import EmbedData-import qualified GHC.Util as GHC+import GHC.Util qualified as GHC   writeTemplate :: FilePath -> [(String,[String])] -> FilePath -> IO ()

@@ -0,0 +1,178 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Description: Formats hlint ideas in the Statis Analysis Results Interchange Format (SARIF).+License: BSD-3-Clause++Supports the conversion of a list of HLint 'Idea's into SARIF.++SARIF (Static Analysis Results Interchange Format) is an open interchange format+for storing results from static analyses.+-}+module SARIF ( printIdeas+             , showIdeas+             , toJSONEncoding+             -- * See also+             --+             -- $references+             ) where++import Data.Aeson hiding (Error)+import Data.Aeson.Encoding+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Lazy qualified as B+import Data.Text.Lazy (Text)+import Data.Version (showVersion)+import GHC.Util+import Idea+import Paths_hlint (version)++-- | Print the given ideas to standard output.+--+-- For example:+--+-- >>> hlint ["src"] >>= printIdeas+--+-- For printing ideas in SARIF without dependent modules+-- having to import "Data.Aeson" or "Data.ByteString.Lazy".+printIdeas :: [Idea] -> IO ()+printIdeas = B.putStr . showIdeas++-- | Format the given ideas in SARIF.+--+-- For converting ideas to SARIF without dependent modules+-- having to import "Data.Aeson".+showIdeas :: [Idea] -> ByteString+showIdeas = encodingToLazyByteString . toJSONEncoding++-- | Converts the given ideas to a "Data.Aeson" encoding in SARIF.+toJSONEncoding :: [Idea] -> Encoding+toJSONEncoding = pairs . sarif++-- | Converts the given object to a top-level @sarifLog@ object.+--+-- See section 3.13 "sarifLog object", SARIF specification.+sarif :: [Idea] -> Series+sarif ideas =+  pair "version" (lazyText "2.1.0") <>+  pair "$schema" (lazyText schemaURI) <>+  pair "runs" runs+  where runs = list pairs [ pair "tool" (pairs tool) <>+                            pair "results" (list (pairs . toResult) ideas) ]++-- | A @tool@ object describing what created the output.+--+-- Obviously, it will describe that HLint created the output.+--+-- See section 3.18 "tool object", SARIF specification.+tool :: Series+tool = pair "driver" $ pairs $+  pair "name" (lazyText "hlint") <>+  pair "version" (string $ showVersion version) <>+  pair "informationUri" (lazyText hlintURI)++-- | Converts a given idea into a @result@ object.+--+-- It will describe the hint, the severity, suggestions for fixes, etc.+--+-- See section 3.27 "result object", SARIF specification.+toResult :: Idea -> Series+toResult idea@Idea{..} =+  pair "message" (pairs $ pair "text" $ string $ show idea) <>+  pair "level" (lazyText $ showSeverity ideaSeverity) <>+  pair "locations" (list (pairs . toLocation) [idea]) <>+  pair "fixes" (list (pairs . toFix) [idea]) <>+  -- Use 'ideaHint' as the rule identifier.+  --+  -- "ruleId" is supposed to a stable, opaque identifier.+  -- 'ideaHint' is not opaque, nor is it quite guaranteed to be stable,+  -- but they will usually be stable enough, and disabling a hint is+  -- based on the name in 'ideaHint'.+  --+  -- Most importantly, there is no requirement that "ruleId"+  -- be a /unique/ identifier.+  pair "ruleId" (string ideaHint)++-- | Convert HLint severity to SARIF level.+--+-- See section 3.58.6 "level property", SARIF specification.+showSeverity :: Severity -> Text+showSeverity Error = "error"+showSeverity Warning = "warning"+showSeverity Suggestion = "note"+showSeverity Ignore = "none"++-- | Converts the location information in a given idea to a @location@ object.+--+-- See section 3.28 "location object", SARIF specification.+toLocation :: Idea -> Series+toLocation idea@Idea{ideaSpan=SrcSpan{..}, ..} =+  physicalLocation <> logicalLocations ideaModule ideaDecl+  where physicalLocation = pair "physicalLocation" $ pairs $+          pair "artifactLocation"+              (pairs $ pair "uri" (string srcSpanFilename)) <>+          pair "region" (pairs $ toRegion idea)++        logicalLocations [mod] [decl] = pair "logicalLocations" $+          list pairs [ pair "name" (string decl) <>+                       pair "fullyQualifiedName" (string $ mod ++ "." ++ decl) ]+          -- It would be nice to include whether it is a function or type+          -- in the "kind" field, but we do not have that information.++        -- If the lists are empty, then there is obviously no logical location.+        -- Logical location is still omitted when the lists are not singleton,+        -- because the associations between modules and declarations are+        -- not clear.+        logicalLocations _ _ = mempty++-- | Converts a given idea to a @fix@ object.+--+-- It will suggest how code can be improved to deal with an issue.+-- This includes the file to be changed and how to change it.+--+-- See section 3.55 "fix object", SARIF specification.+toFix :: Idea -> Series+toFix idea@Idea{..} =+  pair "description" (pairs $ pair "text" $ string ideaHint) <>+  pair "artifactChanges" (list (pairs . toChange) [idea])++-- | Converts a given idea to a @artifactChange@ object.+--+-- It will describe the details as to how the code can be changed.+-- I.e., the text to remove and what it should be replaced with.+--+-- See section 3.56 "artifactChange object", SARIF specification.+toChange :: Idea -> Series+toChange idea@Idea{ideaSpan=SrcSpan{..}, ..} =+  pair "artifactLocation" (pairs uri) <>+  pair "replacements" (list pairs [deleted <> inserted])+  where uri  = pair "uri" $ string srcSpanFilename+        deleted = pair "deletedRegion" $ pairs $ toRegion idea+        inserted = maybe mempty insertedContent ideaTo+        insertedContent = pair "insertedContent" . pairs . pair "text" . string++-- | Converts the source span in an idea to a SARIF region.+--+-- See 3.30 "region object", SARIF specification.+toRegion :: Idea -> Series+toRegion Idea{ideaSpan=SrcSpan{..}, ..} =+  pair "startLine" (int srcSpanStartLine') <>+  pair "startColumn" (int srcSpanStartColumn) <>+  pair "endLine" (int srcSpanEndLine') <>+  pair "endColumn" (int srcSpanEndColumn)++-- | URI to SARIF schema definition.+schemaURI :: Text+schemaURI = "https://raw.githubusercontent.com/" <>+            "oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json"++-- | URI to HLint home page.+hlintURI :: Text+hlintURI = "https://github.com/ndmitchell/hlint"++-- $references+--+-- * [SARIF Tutorials](https://github.com/microsoft/sarif-tutorials)+-- * [Static Analysis Results Interchange Format](https://docs.oasis-open.org/sarif/sarif/v2.1.0/cs01/sarif-v2.1.0-cs01.html), version 2.1.0

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-}@@ -5,7 +6,7 @@  module Summary (generateMdSummary, generateJsonSummary, generateExhaustiveConfig) where -import qualified Data.Map as Map+import Data.Map qualified as Map import Control.Monad.Extra import System.FilePath import Data.List.Extra

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE CPP, PatternGuards, RecordWildCards, ViewPatterns #-}  -- | Check the <TEST> annotations within source and hint files.@@ -17,7 +18,7 @@ import System.FilePath import System.IO.Extra import GHC.All-import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Char8 qualified as BS  import Config.Type import Idea@@ -163,7 +164,7 @@ testRefactor Nothing _ _ = pure [] -- Skip refactoring test if there is no hint. testRefactor _ Nothing _ = pure []--- Skip refactoring test if the hint has no suggestion (such as "Parse error" or "Avoid restricted fuction").+-- Skip refactoring test if the hint has no suggestion (such as "Parse error" or "Avoid restricted function"). testRefactor _ (Just idea) _ | isNothing (ideaTo idea) = pure [] -- Skip refactoring test if the hint does not support refactoring. testRefactor _ (Just idea) _ | null (ideaRefactoring idea) = pure []

@@ -17,6 +17,8 @@ import System.Exit import System.IO.Extra import Prelude+import Data.Version (showVersion)+import Paths_hlint (version)  import Test.Util @@ -48,6 +50,8 @@     where         z = InputOutput "unknown" [] [] "" Nothing         interest x = any (`isPrefixOf` x) ["----","FILE","RUN","OUTPUT","EXIT"]+        outputTemplateVars = [ ("__VERSION__", showVersion version) ]+        substituteTemplateVars = mconcatMap (uncurry replace) outputTemplateVars          f io ((stripPrefix "RUN " -> Just flags):xs) = f io{run = splitArgs flags} xs         f io ((stripPrefix "EXIT " -> Just code):xs) = f io{exit = Just $ let i = read code in if i == 0 then ExitSuccess else ExitFailure i} xs@@ -57,7 +61,7 @@         f io [] = [io | io /= z]         f io (x:xs) = error $ "Unknown test item, " ++ x -        g = first (reverse . dropWhile null . reverse) . break interest+        g = first (fmap substituteTemplateVars . reverse . dropWhile null . reverse) . break interest   ---------------------------------------------------------------------

@@ -1,3 +1,4 @@+{-# LANGUAGE ImportQualifiedPost #-}  module Timing(     timed, timedIO,@@ -5,7 +6,7 @@     printTimings     ) where -import qualified Data.HashMap.Strict as Map+import Data.HashMap.Strict qualified as Map import Control.Exception import Data.IORef.Extra import Data.Tuple.Extra

@@ -44,7 +44,8 @@ main = undefined EXIT 1 OUTPUT-tests/cpp-ext-enable.hs:1:1: Error: Parse error: tests/cpp-ext-enable.hs:3:14: error: Unsupported extension: Foo+tests/cpp-ext-enable.hs:1:1: Error: Parse error: tests/cpp-ext-enable.hs:3:14: error: [GHC-46537]+    Unsupported extension: Foo Found:   {-# LANGUAGE CPP #-} @@ -52,7 +53,7 @@    main = undefined -1 hint+1 error  --------------------------------------------------------------------- RUN tests/cpp-ext-disable.hs@@ -128,3 +129,39 @@ #endif OUTPUT No hints++---------------------------------------------------------------------+RUN tests/cpp-file5.hs+FILE tests/cpp-file5.hs+{-# LANGUAGE CPP #-}+main =+#if __GLASGOW_HASKELL__ > 800+  print __GLASGOW_HASKELL__+#else+  putStrLn $ show __GLASGOW_HASKELL__+#endif+OUTPUT+tests/cpp-file5.hs:1:1-20: Warning: Avoid restricted extensions+Found:+  {-# LANGUAGE CPP #-}+Note: may break the code++1 hint++---------------------------------------------------------------------+RUN --cpp-define "__GLASGOW_HASKELL__=123" tests/cpp-file6.hs+FILE tests/cpp-file6.hs+{-# LANGUAGE CPP #-}+main =+#if __GLASGOW_HASKELL__ == 123+  print __GLASGOW_HASKELL__+#else+  putStrLn $ show __GLASGOW_HASKELL__+#endif+OUTPUT+tests/cpp-file6.hs:1:1-20: Warning: Avoid restricted extensions+Found:+  {-# LANGUAGE CPP #-}+Note: may break the code++1 hint

@@ -0,0 +1,17 @@+---------------------------------------------------------------------+RUN tests/do-block.hs --hint=data/do-block.yaml+FILE tests/do-block.hs+h x = case f x of+  Just n -> g n+  Nothing -> Nothing+OUTPUT+tests/do-block.hs:(1,7)-(3,20): Warning: Redundant Nothing+Found:+  case f x of+    Just n -> g n+    Nothing -> Nothing+Perhaps:+  do n <- f x+     g n++1 hint

@@ -0,0 +1,38 @@+---------------------------------------------------------------------+RUN tests/flag-ignore-suggestions-1.hs --ignore-suggestions+FILE tests/flag-ignore-suggestions-1.hs+main = map f $ map g xs+OUTPUT+No hints++EXIT 0+---------------------------------------------------------------------+RUN tests/flag-ignore-suggestions-2.hs --ignore-suggestions+FILE tests/flag-ignore-suggestions-2.hs+foo = (+1)+bar x = foo x+main = map f $ map g xs+OUTPUT+tests/flag-ignore-suggestions-2.hs:2:1-13: Warning: Eta reduce+Found:+  bar x = foo x+Perhaps:+  bar = foo++1 hint++EXIT 1+---------------------------------------------------------------------+RUN tests/flag-ignore-suggestions-3.hs --ignore-suggestions --show+FILE tests/flag-ignore-suggestions-3.hs+main = map f $ map g xs+OUTPUT+tests/flag-ignore-suggestions-3.hs:1:8-23: Suggestion: Use map once+Found:+  map f $ map g xs+Perhaps:+  map (f . g) xs++1 hint++EXIT 1

@@ -31,7 +31,7 @@    > -1 hint+1 error  --------------------------------------------------------------------- RUN tests/lhs-first-line.lhs

@@ -18,16 +18,16 @@    > where -1 hint+1 error  --------------------------------------------------------------------- RUN tests/ignore-parse-error3.hs FILE tests/ignore-parse-error3.hs {-# LANGUAGE InvalidExtension #-} OUTPUT-tests/ignore-parse-error3.hs:1:1: Error: Parse error: tests/ignore-parse-error3.hs:1:14: error:+tests/ignore-parse-error3.hs:1:1: Error: Parse error: tests/ignore-parse-error3.hs:1:14: error: [GHC-46537]     Unsupported extension: InvalidExtension Found:   {-# LANGUAGE InvalidExtension #-} -1 hint+1 error

@@ -0,0 +1,38 @@+---------------------------------------------------------------------+RUN tests/sarif-none.hs --sarif+FILE tests/sarif-none.hs+foo = (+1)+OUTPUT+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[]}]}++---------------------------------------------------------------------+RUN tests/sarif-one.hs --sarif+FILE tests/sarif-one.hs+foo = (+1)+bar x = foo x+OUTPUT+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-one.hs:2:1-13: Warning: Eta reduce\nFound:\n  bar x = foo x\nPerhaps:\n  bar = foo\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-one.hs"},"region":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Eta reduce"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-one.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14},"insertedContent":{"text":"bar = foo"}}]}]}],"ruleId":"Eta reduce"}]}]}++---------------------------------------------------------------------+RUN tests/sarif-two.hs --sarif+FILE tests/sarif-two.hs+foo = (+1)+bar x = foo x+baz = getLine >>= pure . upper+OUTPUT+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-two.hs:2:1-13: Warning: Eta reduce\nFound:\n  bar x = foo x\nPerhaps:\n  bar = foo\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-two.hs"},"region":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Eta reduce"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-two.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14},"insertedContent":{"text":"bar = foo"}}]}]}],"ruleId":"Eta reduce"},{"message":{"text":"tests/sarif-two.hs:3:7-30: Suggestion: Use <&>\nFound:\n  getLine >>= pure . upper\nPerhaps:\n  getLine Data.Functor.<&> upper\n"},"level":"note","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-two.hs"},"region":{"startLine":3,"startColumn":7,"endLine":3,"endColumn":31}},"logicalLocations":[{"name":"baz","fullyQualifiedName":"Main.baz"}]}],"fixes":[{"description":{"text":"Use <&>"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-two.hs"},"replacements":[{"deletedRegion":{"startLine":3,"startColumn":7,"endLine":3,"endColumn":31},"insertedContent":{"text":"getLine Data.Functor.<&> upper"}}]}]}],"ruleId":"Use <&>"}]}]}++---------------------------------------------------------------------+RUN tests/sarif-parse-error.hs --sarif+FILE tests/sarif-parse-error.hs+@+OUTPUT+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-parse-error.hs:1:1: Error: Parse error: on input `@'\nFound:\n  > @\n"},"level":"error","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-parse-error.hs"},"region":{"startLine":1,"startColumn":1,"endLine":1,"endColumn":2}}}],"fixes":[{"description":{"text":"Parse error: on input `@'"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-parse-error.hs"},"replacements":[{"deletedRegion":{"startLine":1,"startColumn":1,"endLine":1,"endColumn":2}}]}]}],"ruleId":"Parse error: on input `@'"}]}]}++---------------------------------------------------------------------+RUN tests/sarif-note.hs --sarif+FILE tests/sarif-note.hs+foo = any (a ==)+bar = foldl (&&) True+OUTPUT+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-note.hs:1:7-16: Warning: Use elem\nFound:\n  any (a ==)\nPerhaps:\n  elem a\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-note.hs"},"region":{"startLine":1,"startColumn":7,"endLine":1,"endColumn":17}},"logicalLocations":[{"name":"foo","fullyQualifiedName":"Main.foo"}]}],"fixes":[{"description":{"text":"Use elem"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-note.hs"},"replacements":[{"deletedRegion":{"startLine":1,"startColumn":7,"endLine":1,"endColumn":17},"insertedContent":{"text":"elem a"}}]}]}],"ruleId":"Use elem"},{"message":{"text":"tests/sarif-note.hs:2:7-21: Warning: Use and\nFound:\n  foldl (&&) True\nPerhaps:\n  and\nNote: increases laziness\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-note.hs"},"region":{"startLine":2,"startColumn":7,"endLine":2,"endColumn":22}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Use and"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-note.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":7,"endLine":2,"endColumn":22},"insertedContent":{"text":"and"}}]}]}],"ruleId":"Use and"}]}]}

@@ -40,7 +40,6 @@ [("tests/serialise-four.hs:2:1-20: Warning: Use fewer LANGUAGE pragmas\nFound:\n  {-# LANGUAGE CPP #-}\n  {-# LANGUAGE CPP #-}\nPerhaps:\n  {-# LANGUAGE CPP #-}\n",[ModifyComment {pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 21}, newComment = "{-# LANGUAGE CPP #-}"},ModifyComment {pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 21}, newComment = ""}])]  - --------------------------------------------------------------------- RUN tests/serialise-five.hs --serialise FILE tests/serialise-five.hs