hlint 1.9.41 → 2.0

raw patch · 42 files changed

+1670/−1953 lines, 42 filesdep +bytestringdep +textdep +unordered-containersdep ~extraPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, text, unordered-containers, vector, yaml

Dependency ranges changed: extra

API changes (from Hackage documentation)

Files

• CHANGES.txt +21/−0
• README.md +30/−38
• data/Default.hs +0/−762
• data/Dollar.hs +0/−11
• data/Generalise.hs +0/−11
• data/HLint.hs +0/−5
• data/Test.hs +0/−3
• data/default.yaml +56/−0
• data/hlint.yaml +764/−0
• hlint.cabal +10/−7
• src/Apply.hs +12/−8
• src/CmdLine.hs +37/−30
• src/Config/All.hs +17/−0
• src/Config/Compute.hs +62/−0
• src/Config/Haskell.hs +17/−111
• src/Config/Type.hs +31/−2
• src/Config/Yaml.hs +289/−0
• src/Grep.hs +3/−1
• src/HLint.hs +63/−60
• src/HSE/All.hs +4/−5
• src/HSE/Bracket.hs +1/−1
• src/HSE/FreeVars.hs +1/−1
• src/HSE/Match.hs +1/−1
• src/HSE/Scope.hs +5/−4
• src/HSE/Type.hs +8/−668
• src/HSE/Util.hs +23/−5
• src/Hint/All.hs +12/−8
• src/Hint/Export.hs +26/−0
• src/Hint/Extensions.hs +10/−0
• src/Hint/Import.hs +1/−1
• src/Hint/List.hs +1/−1
• src/Hint/Match.hs +3/−4
• src/Hint/Naming.hs +1/−1
• src/Hint/NewType.hs +3/−1
• src/Hint/Restrict.hs +99/−0
• src/Hint/Type.hs +16/−8
• src/Idea.hs +11/−4
• src/Language/Haskell/HLint2.hs +0/−87
• src/Language/Haskell/HLint3.hs +7/−24
• src/Test/All.hs +12/−8
• src/Test/Annotations.hs +2/−2
• src/Util.hs +11/−70

@@ -1,5 +1,26 @@ Changelog for HLint +2.0+    #319, add a hint \x -> f <$> g x ==> fmap f . g+    Don't say how many hints were ignored+    Add a --default flag+    #314, allow arguments in YAML configuration files+    Add maybe False (== x) ==> (== Just x) hint, plus for /=+    Remove the ability to pass the file on stdin using - as the file+    Remove encoding from ParseFlags+    Remove the --encoding/--utf8 options, always use UTF8+    #311, suggest writeFile instead of withFile/hPutStr+    #288, add configurable restrictions+    Suggest using an export list on modules+    Look for nearby .hlint.yaml files to supply configuration+    Support YAML configuration files+    #308, don't suggest newtype for unboxed types+    Remove the import "hint" feature for hint inclusion+    Builtin hints do not need to be imported, can only be ignored+    Delete HLint2 API+    #290, add hints suggesting traverse/traverse_+    #303, detect unused OverloadedStrings extension+    #302, detect unused TupleSections extension 1.9.41     #299, warn in some cases when NumDecimals extension is unused     #300, warn when LambdaCase extension is unused

@@ -23,9 +23,9 @@  ## Installing and running HLint -Installation follows the standard pattern of any Haskell library or program, type `cabal update` to update your local hackage database, then `cabal install hlint` to install HLint.+Installation follows the standard pattern of any Haskell library or program: type `cabal update` to update your local hackage database, then `cabal install hlint` to install HLint. -Once HLint is installed, run hlint source where source is either a Haskell file, or a directory containing Haskell files. A directory will be searched recursively for any files ending with .hs or .lhs. For example, running HLint over darcs would give:+Once HLint is installed, run `hlint source` where `source` is either a Haskell file, or a directory containing Haskell files. A directory will be searched recursively for any files ending with `.hs` or `.lhs`. For example, running HLint over darcs would give:       $ hlint darcs-2.1.2@@ -85,7 +85,7 @@  ### Language Extensions -HLint enables most Haskell extensions, disabling only those which steal too much syntax (currently Arrows, TransformListComp, XmlSyntax and RegularPatterns). Individual extensions can be enabled or disabled with, for instance, `-XArrows`, or `-XNoMagicHash`. The flag `-XHaskell98` selects Haskell 98 compatibility.+HLint enables most Haskell extensions, disabling only those which steal too much syntax (currently Arrows, TransformListComp, XmlSyntax and RegularPatterns). Individual extensions can be enabled or disabled with, for instance, `-XArrows`, or `-XNoMagicHash`. The flag `-XHaskell2010` selects Haskell 2010 compatibility.  ### Emacs Integration @@ -113,10 +113,6 @@ * HLint will only check one branch of an `#if`, based on which macros have been defined. * Any missing `#include` files will produce a warning on the console, but no information in the reports. -### Unicode support--By default, HLint uses the current locale encoding. The encoding can be overridden with either `--utf8` or `--encoding=value`. For descriptions of some valid [encodings see the mkTextEncoding documentation](http://haskell.org/ghc/docs/latest/html/libraries/base/System-IO.html#v%3AmkTextEncoding).- ## FAQ  ### Why are hints not applied recursively?@@ -142,9 +138,9 @@  HLint knows the fixities for all the operators in the base library, but no others. HLint works on a single file at a time, and does not resolve imports, so cannot see fixity declarations from imported modules. You can tell HLint about fixities by putting them in a hint file, or passing them on the command line. For example, pass `--with=infixr 5 !@%$`, or put all the fixity declarations in a file and pass `--hint=fixities.hs`. You can also use [--find](https://rawgithub.com/ndmitchell/hlint/master/hlint.htm#find) to automatically produce a list of fixity declarations in a file. -### How can I use `--with` or `--hint` with the default hints?+### Which hints are used? -HLint does not use the default set of hints if custom hints are specified on the command line using `--with` or `--hint`. To include the default hints either pass `--hint=HLint` on the command line, or add import `"hint" HLint.HLint` in one of the hint files you specify with `--hint`.+HLint uses the `hlint.yaml` file it ships with by default (containing things like the `concatMap` hint above), along with with the first `.hlint.yaml` file it finds in the current directory or any parent thereof. To include other hints, pass `--hint=filename.yaml`. If you pass any `--with` hint you will need to explicitly add any `--hint` flags required.  ### Why do I sometimes get a "Note" with my hint? @@ -166,20 +162,18 @@  ## Customizing the hints -Many of the hints that are applied by HLint are contained in Haskell source files which are installed in the data directory by Cabal. These files may be edited, to add library specific knowledge, to include hints that may have been missed, or to ignore unwanted hints.--### Choosing a package of hints+To customize the hints given by HLint, create a file `.hlint.yaml` in the root of your project. For a suitable default run: -By default, HLint will use the `HLint.hs` file either from the current working directory, or from the data directory. Alternatively, hint files can be specified with the `--hint` flag. HLint comes with a number of hint packages:+    hlint --default > .hlint.yaml -* __Default__ - these are the hints that are used by default, covering most of the base libraries.-* __Dollar__ - suggests the replacement `a $ b $ c` with `a . b $ c`. This hint is especially popular on the [\#haskell IRC channel](http://www.haskell.org/haskellwiki/IRC_channel).-* __Generalise__ - suggests replacing specific variants of functions (i.e. `map`) with more generic functions (i.e. `fmap`).+This default configuration contains lots of examples, including: -As an example, to check the file `Example.hs` with both the default hints and the dollar hint, I could type: `hlint Example.hs --hint=Default --hint=Dollar`. Alternatively, I could create the file `HLint.hs` in the working directory and give it the contents:+* Adding command line arguments to all runs, e.g. `--color` or `-XNoMagicHash`.+* Ignoring certain hints, perhaps within certain modules/functions.+* Restricting use of GHC flags/extensions/functions, e.g. banning `Arrows` and `unsafePerformIO`.+* Adding additional project-specific hints. -    import "hint" HLint.Default-    import "hint" HLint.Dollar+You can see the output of `--default` [here](https://github.com/ndmitchell/hlint/blob/master/data/default.yaml).  ### Ignoring hints @@ -188,45 +182,43 @@ * `{-# ANN module "HLint: ignore Eta reduce" #-}` - ignore all eta reduction suggestions in this module (use `module` literally, not the name of the module). * `{-# ANN myFunction "HLint: ignore" #-}` - don't give any hints in the function `myFunction`. * `{-# ANN myFunction "HLint: error" #-}` - any hint in the function `myFunction` is an error.-* `{-# ANN module "HLint: error Use concatMap" #-}` - the hint to use `concatMap` is an error.-* `{-# ANN module "HLint: warn Use concatMap" #-}` - the hint to use `concatMap` is a warning.-* `{-# ANN module "HLint: suggest Use concatMap" #-}` - the hint to use `concatMap` is a suggestion.+* `{-# ANN module "HLint: error Use concatMap" #-}` - the hint to use `concatMap` is an error (you may also use `warn` or `suggest` in place of `error` for other severity levels).  Ignore directives can also be written in the hint files: -* `ignore "Eta reduce"` - suppress all eta reduction suggestions.-* `ignore "Eta reduce" = MyModule1 MyModule2` - suppress eta reduction hints in the `MyModule1` and `MyModule2` modules.-* `ignore = MyModule.myFunction` - don't give any hints in the function `MyModule.myFunction`.-* `error = MyModule.myFunction` - any hint in the function `MyModule.myFunction` is an error.-* `error "Use concatMap"` - the hint to use `concatMap` is an error.-* `warn "Use concatMap"` - the hint to use `concatMap` is a warning.-* `suggest "Use concatMap"` - the hint to use `concatMap` is a suggestion.+* `- ignore: {name: Eta reduce}` - suppress all eta reduction suggestions.+* `- ignore: {name: Eta reduce, within: [MyModule1, MyModule2]}` - suppress eta reduction hints in the `MyModule1` and `MyModule2` modules.+* `- ignore: {within: MyModule.myFunction}` - don't give any hints in the function `MyModule.myFunction`.+* `- error: {within: MyModule.myFunction}` - any hint in the function `MyModule.myFunction` is an error.+* `- error: {name: Use concatMap}` - the hint to use `concatMap` is an error (you may also use `warn` or `suggest` in place of `error` for other severity levels).  These directives are applied in the order they are given, with later hints overriding earlier ones.  ### Adding hints -The hint suggesting `concatMap` is defined as:+The hint suggesting `concatMap` can be defined as: -    warn = concat (map f x) ==> concatMap f x+    - warn: {lhs: concat (map f x), rhs: concatMap f x} -This line can be read as replace `concat (map f x)` with `concatMap f x`. All single-letter variables are treated as substitution parameters. For examples of more complex hints see the supplied hints file. This hint will automatically match `concat . map f` and `concat $ map f x`, so there is no need to give eta-reduced variants of the hints. Hints may start with `error`, `warn` or `suggest` to denote how severe they are by default. In addition, `hint` is a synonym for `suggest`. If you come up with interesting hints, please submit them for inclusion.+This line can be read as replace `concat (map f x)` with `concatMap f x`. All single-letter variables are treated as substitution parameters. For examples of more complex hints see the supplied `hlint.yaml` file in the data directory. This hint will automatically match `concat . map f` and `concat $ map f x`, so there is no need to give eta-reduced variants of the hints. Hints may tagged with `error`, `warn` or `suggest` to denote how severe they are by default. In addition, `hint` is a synonym for `suggest`. If you come up with interesting hints, please submit them for inclusion.  You can search for possible hints to add from a source file with the `--find` flag, for example:      $ hlint --find=src/Utils.hs     -- hints found in src/Util.hs-    warn = null (intersect a b) ==> disjoint a b-    warn = dropWhile isSpace ==> trimStart-    infixr 5 !:+    - warn: {lhs: "null (intersect a b)", rhs: "disjoint a b"}+    - warn: {lhs: "dropWhile isSpace", rhs: "trimStart"}+    - fixity: "infixr 5 !:"  These hints are suitable for inclusion in a custom hint file. You can also include Haskell fixity declarations in a hint file, and these will also be extracted. If you pass only `--find` flags then the hints will be written out, if you also pass files/folders to check, then the found hints will be automatically used when checking. -## Hacking HLint+### More Advanced Hints -### Tests+Hints can specify more advanced aspects, with names and side conditions. To see examples and descriptions of these features look at [the default hint file](https://github.com/ndmitchell/hlint/blob/master/data/hlint.yaml) and [the hint interpretation module comments](https://github.com/ndmitchell/hlint/blob/master/src/Hint/Match.hs). -Tests can be run either from within a `ghci` session by typing `:test` or by running the standalone binary's tests via `stack exec hlint test`.+## Hacking HLint++Contributions to HLint are most welcome, following [my standard contribution guidelines](https://github.com/ndmitchell/neil/blob/master/README.md#contributions). You can run the tests either from within a `ghci` session by typing `:test` or by running the standalone binary's tests via `stack exec hlint test`.  New tests for individual hints can be added directly to source and hint files by adding annotations bracketed in `<TEST></TEST>` code comment blocks. As some examples: 

@@ -1,762 +0,0 @@--module HLint.Default where--import Control.Arrow-import Control.Exception-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.Function-import Data.Int-import Data.Char-import Data.List as Data.List-import Data.List as X-import Data.Maybe-import Data.Monoid-import System.IO-import Control.Concurrent.Chan-import System.Mem.Weak-import Control.Exception.Base-import System.Exit-import Data.Either-import Numeric--import IO as System.IO-import List as Data.List-import Maybe as Data.Maybe-import Monad as Control.Monad-import Char as Data.Char---- I/O--warn = putStrLn (show x) ==> print x-warn = mapM_ putChar ==> putStr-warn = hGetChar stdin ==> getChar-warn = hGetLine stdin ==> getLine-warn = hGetContents stdin ==> getContents-warn = hPutChar stdout ==> putChar-warn = hPutStr stdout ==> putStr-warn = hPutStrLn stdout ==> putStrLn-warn = hPrint stdout ==> print-warn = hWaitForInput a 0 ==> hReady a-warn = hPutStrLn a (show b) ==> hPrint a b-warn = hIsEOF stdin ==> isEOF---- EXIT--warn = exitWith ExitSuccess ==> exitSuccess---- ORD--warn = not (a == b) ==> a /= b where note = "incorrect if either value is NaN"-warn = not (a /= b) ==> a == b where note = "incorrect if either value is NaN"-warn = not (a >  b) ==> a <= b where note = "incorrect if either value is NaN"-warn = not (a >= b) ==> a <  b where note = "incorrect if either value is NaN"-warn = not (a <  b) ==> a >= b where note = "incorrect if either value is NaN"-warn = not (a <= b) ==> a >  b where note = "incorrect if either value is NaN"-warn = compare x y /= GT ==> x <= y-warn = compare x y == LT ==> x < y-warn = compare x y /= LT ==> x >= y-warn = compare x y == GT ==> x > y-warn = compare x y == EQ ==> x == y-warn = compare x y /= EQ ==> x /= y---warning = x == a || x == b || x == c ==> x `elem` [a,b,c] where note = ValidInstance "Eq" x---warning = x /= a && x /= b && x /= c ==> x `notElem` [a,b,c] where note = ValidInstance "Eq" x---warn = compare (f x) (f y) ==> Data.Ord.comparing f x y -- not that great---warn = on compare f ==> Data.Ord.comparing f -- not that great-warn = head (sort x) ==> minimum x-warn = last (sort x) ==> maximum x-warn = head (sortBy f x) ==> minimumBy f x-    where _ = isCompare f-warn = last (sortBy f x) ==> maximumBy f x-    where _ = isCompare f-warn "Avoid reverse" = reverse (sort x) ==> sortBy (flip compare) x-warn "Avoid reverse" = reverse (sortBy f x) ==> sortBy (flip f) x-    where _ = isCompare f-hint = flip (g `on` h) ==> flip g `on` h-hint = (f `on` g) `on` h ==> f `on` (g . h)----- READ/SHOW--warn = showsPrec 0 x "" ==> show x-warn = readsPrec 0 ==> reads-warn = showsPrec 0 ==> shows-hint = showIntAtBase 16 intToDigit ==> showHex-hint = showIntAtBase 8 intToDigit ==> showOct---- LIST--warn = concat (map f x) ==> concatMap f x-warn = concat (fmap f x) ==> concatMap f x-hint = concat [a, b] ==> a ++ b-hint "Use map once" = map f (map g x) ==> map (f . g) x-hint "Fuse concatMap/map" = concatMap f (map g x) ==> concatMap (f . g) x-hint = x !! 0 ==> head x-warn = take n (repeat x) ==> replicate n x-    where _ = noQuickCheck -- takes too long-warn = map f (replicate n x) ==> replicate n (f x)-    where _ = noQuickCheck -- takes too long-warn = map f (repeat x) ==> repeat (f x)-    where _ = noQuickCheck -- takes forever-warn = cycle [x] ==> repeat x-    where _ = noQuickCheck -- takes forever-warn = head (reverse x) ==> last x-warn = head (drop n x) ==> x !! n where _ = isNat n-warn = reverse (tail (reverse x)) ==> init x where note = IncreasesLaziness-warn "Avoid reverse" = reverse (reverse x) ==> x where note = IncreasesLaziness--- warn = take (length x - 1) x ==> init x -- not true for x == []-warn = isPrefixOf (reverse x) (reverse y) ==> isSuffixOf x y-warn = foldr (++) [] ==> concat-warn = foldr (++) "" ==> concat-warn = foldl (++) [] ==> concat where note = IncreasesLaziness-warn = foldl (++) "" ==> concat where note = IncreasesLaziness-warn = foldl f (head x) (tail x) ==> foldl1 f x-warn = foldr f (last x) (init x) ==> foldr1 f x-warn = span (not . p) ==> break p-warn = break (not . p) ==> span p-warn = (takeWhile p x, dropWhile p x) ==> span p x-warn = fst (span p x) ==> takeWhile p x-warn = snd (span p x) ==> dropWhile p x-warn = fst (break p x) ==> takeWhile (not . p) x-warn = snd (break p x) ==> dropWhile (not . p) x-warn = concatMap (++ "\n") ==> unlines-warn = map id ==> id-warn = concatMap id ==> concat-warn = or (map p x) ==> any p x-warn = and (map p x) ==> all p x-warn = zipWith (,) ==> zip-warn = zipWith3 (,,) ==> zip3-hint = length x == 0 ==> null x where note = IncreasesLaziness-hint = x == [] ==> null x-hint "Use null" = length x /= 0 ==> not (null x) where note = IncreasesLaziness-hint "Use :" = (\x -> [x]) ==> (:[])-warn = map (uncurry f) (zip x y) ==> zipWith f x y-hint = map f (zip x y) ==> zipWith (curry f) x y where _ = isVar f-warn = not (elem x y) ==> notElem x y-hint = foldr f z (map g x) ==> foldr (f . g) z x-warn = x ++ concatMap (' ':) y ==> unwords (x:y)-warn = intercalate " " ==> unwords-hint = concat (intersperse x y) ==> intercalate x y where _ = notEq x " "-hint = concat (intersperse " " x) ==> unwords x-warn "Use any" = null (filter f x) ==> not (any f x)-warn "Use any" = filter f x == [] ==> not (any f x)-warn = filter f x /= [] ==> any f x-warn = any id ==> or-warn = all id ==> and-warn = any ((==) a) ==> elem a where note = ValidInstance "Eq" a-warn = any (== a) ==> elem a-warn = any (a ==) ==> elem a where note = ValidInstance "Eq" a-warn = all ((/=) a) ==> notElem a where note = ValidInstance "Eq" a-warn = all (/= a) ==> notElem a where note = ValidInstance "Eq" a-warn = all (a /=) ==> notElem a where note = ValidInstance "Eq" a-warn = elem True ==> or-warn = notElem False ==> and-warn = findIndex ((==) a) ==> elemIndex a-warn = findIndex (a ==) ==> elemIndex a-warn = findIndex (== a) ==> elemIndex a-warn = findIndices ((==) a) ==> elemIndices a-warn = findIndices (a ==) ==> elemIndices a-warn = findIndices (== a) ==> elemIndices a-warn = lookup b (zip l [0..]) ==> elemIndex b l-hint = elem x [y] ==> x == y where note = ValidInstance "Eq" a-hint = notElem x [y] ==> x /= y where note = ValidInstance "Eq" a-hint "Length always non-negative" = length x >= 0 ==> True-hint "Use null" = length x > 0 ==> not (null x) where note = IncreasesLaziness-hint "Use null" = length x >= 1 ==> not (null x) where note = IncreasesLaziness-warn "Take on a non-positive" = take i x ==> [] where _ = isNegZero i-warn "Drop on a non-positive" = drop i x ==> x where _ = isNegZero i-warn = last (scanl f z x) ==> foldl f z x-warn = head (scanr f z x) ==> foldr f z x-warn = iterate id ==> repeat-    where _ = noQuickCheck -- takes forever-warn = zipWith f (repeat x) ==> map (f x)-warn = zipWith f y (repeat z) ==> map (\x -> f x z) y---- BY--warn = deleteBy (==) ==> delete-warn = groupBy (==) ==> group-warn = insertBy compare ==> insert-warn = intersectBy (==) ==> intersect-warn = maximumBy compare ==> maximum-warn = minimumBy compare ==> minimum-warn = nubBy (==) ==> nub-warn = sortBy compare ==> sort-warn = unionBy (==) ==> union---- FOLDS--warn = foldr  (>>) (return ()) ==> sequence_-    where _ = noQuickCheck-warn = foldr  (&&) True ==> and-warn = foldl  (&&) True ==> and where note = IncreasesLaziness-warn = foldr1 (&&)  ==> and where note = RemovesError "on []"; _ = noQuickCheck-warn = foldl1 (&&)  ==> and where note = RemovesError "on []"-warn = foldr  (||) False ==> or-warn = foldl  (||) False ==> or where note = IncreasesLaziness-warn = foldr1 (||)  ==> or where note = RemovesError "on []"-warn = foldl1 (||)  ==> or where note = RemovesError "on []"-warn = foldl  (+) 0 ==> sum-warn = foldr  (+) 0 ==> sum-warn = foldl1 (+)   ==> sum where note = RemovesError "on []"-warn = foldr1 (+)   ==> sum where note = RemovesError "on []"-warn = foldl  (*) 1 ==> product-warn = foldr  (*) 1 ==> product-warn = foldl1 (*)   ==> product where note = RemovesError "on []"-warn = foldr1 (*)   ==> product where note = RemovesError "on []"-warn = foldl1 max   ==> maximum-warn = foldr1 max   ==> maximum-warn = foldl1 min   ==> minimum-warn = foldr1 min   ==> minimum-warn = foldr mplus mzero ==> msum-    where _ = noQuickCheck---- FUNCTION--warn = (\x -> x) ==> id-warn = (\x y -> x) ==> const-warn = (\(x,y) -> y) ==> snd-warn = (\(x,y) -> x) ==> fst-hint "Use curry" = (\x y -> f (x,y)) ==> curry f-hint "Use uncurry" = (\(x,y) -> f x y) ==> uncurry f where note = IncreasesLaziness-warn "Redundant $" = (($) . f) ==> f-warn "Redundant $" = (f $) ==> f-hint = (\x -> y) ==> const y where _ = isAtom y && not (isWildcard y)-    -- isWildcard because some people like to put brackets round them even though they are atomic-warn "Redundant flip" = flip f x y ==> f y x where _ = isApp original-warn "Evaluate" = id x ==> x-    where _ = not (isTypeApp x)-warn "Redundant id" = id . x ==> x-warn "Redundant id" = x . id ==> x---- CHAR--warn = a >= 'a' && a <= 'z' ==> isAsciiLower a-warn = a >= 'A' && a <= 'Z' ==> isAsciiUpper a-warn = a >= '0' && a <= '9' ==> isDigit a-warn = a >= '0' && a <= '7' ==> isOctDigit a-warn = isLower a || isUpper a ==> isAlpha a-warn = isUpper a || isLower a ==> isAlpha a---- BOOL--warn "Redundant ==" = x == True ==> x-hint "Redundant ==" = x == False ==> not x-warn "Redundant ==" = True == a ==> a-hint "Redundant ==" = False == a ==> not a-warn "Redundant /=" = a /= True ==> not a-hint "Redundant /=" = a /= False ==> a-warn "Redundant /=" = True /= a ==> not a-hint "Redundant /=" = False /= a ==> a-warn "Redundant if" = (if a then x else x) ==> x where note = IncreasesLaziness-warn "Redundant if" = (if a then True else False) ==> a-warn "Redundant if" = (if a then False else True) ==> not a-warn "Redundant if" = (if a then t else (if b then t else f)) ==> if a || b then t else f-warn "Redundant if" = (if a then (if b then t else f) else f) ==> if a && b then t else f-warn "Redundant if" = (if x then True else y) ==> x || y where _ = notEq y False-warn "Redundant if" = (if x then y else False) ==> x && y where _ = notEq y True-hint "Use if" = case a of {True -> t; False -> f} ==> if a then t else f-hint "Use if" = case a of {False -> f; True -> t} ==> if a then t else f-hint "Use if" = case a of {True -> t; _ -> f} ==> if a then t else f-hint "Use if" = case a of {False -> f; _ -> t} ==> if a then t else f-hint "Redundant if" = (if c then (True, x) else (False, x)) ==> (c, x) where note = IncreasesLaziness-hint "Redundant if" = (if c then (False, x) else (True, x)) ==> (not c, x) where note = IncreasesLaziness-hint = or [x, y] ==> x || y-hint = or [x, y, z] ==> x || y || z-hint = and [x, y] ==> x && y-hint = and [x, y, z] ==> x && y && z-warn "Redundant if" = (if x then False else y) ==> not x && y where _ = notEq y True-warn "Redundant if" = (if x then y else True) ==> not x || y where _ = notEq y False-warn "Redundant not" = not (not x) ==> x--- warn "Too strict if" = (if c then f x else f y) ==> f (if c then x else y) where note = IncreasesLaziness--- also breaks types, see #87---- ARROW--warn = id *** g ==> second g-warn = f *** id ==> first f-warn = zip (map f x) (map g x) ==> map (f Control.Arrow.&&& g) x-hint = (\(x,y) -> (f x, g y)) ==> f Control.Arrow.*** g-hint = (\x -> (f x, g x)) ==> f Control.Arrow.&&& g-hint = (\(x,y) -> (f x,y)) ==> Control.Arrow.first f-hint = (\(x,y) -> (x,f y)) ==> Control.Arrow.second f-hint = (f (fst x), g (snd x)) ==> (f Control.Arrow.*** g) x-hint "Redundant pair" = (fst x, snd x) ==>  x where note = DecreasesLaziness---- FUNCTOR--warn "Functor law" = fmap f (fmap g x) ==> fmap (f . g) x where _ = noQuickCheck-warn "Functor law" = f <$> g <$> x ==> f . g <$> x where _ = noQuickCheck-warn "Functor law" = fmap id ==> id where _ = noQuickCheck-warn "Functor law" = id <$> x ==> x where _ = noQuickCheck-hint = fmap f $ x ==> f Control.Applicative.<$> x-    where _ = (isApp x || isAtom x) && noQuickCheck---- MONAD--warn "Monad law, left identity" = return a >>= f ==> f a where _ = noQuickCheck-warn "Monad law, left identity" = f =<< return a ==> f a where _ = noQuickCheck-warn "Monad law, right identity" = m >>= return ==> m where _ = noQuickCheck-warn "Monad law, right identity" = return =<< m ==> m where _ = noQuickCheck-warn = liftM ==> fmap-warn = liftA ==> fmap-hint = m >>= return . f ==> fmap f m where _ = noQuickCheck -- cannot be fmap, because is in Functor not Monad-hint = return . f =<< m ==> fmap f m where _ = noQuickCheck-warn = (if x then y else return ()) ==> Control.Monad.when x $ _noParen_ y where _ = not (isAtom y) && noQuickCheck-warn = (if x then y else return ()) ==> Control.Monad.when x y where _ = isAtom y && noQuickCheck-warn = (if x then return () else y) ==> Control.Monad.unless x $ _noParen_ y where _ = not (isAtom y) && noQuickCheck-warn = (if x then return () else y) ==> Control.Monad.unless x y where _ = isAtom y && noQuickCheck-warn = sequence (map f x) ==> mapM f x where _ = noQuickCheck-warn = sequence_ (map f x) ==> mapM_ f x where _ = noQuickCheck-hint = flip mapM ==> Control.Monad.forM where _ = noQuickCheck-hint = flip mapM_ ==> Control.Monad.forM_ where _ = noQuickCheck-hint = flip forM ==> mapM where _ = noQuickCheck-hint = flip forM_ ==> mapM_ where _ = noQuickCheck-warn = when (not x) ==> unless x where _ = noQuickCheck-warn = x >>= id ==> Control.Monad.join x where _ = noQuickCheck-warn = id =<< x ==> Control.Monad.join x where _ = noQuickCheck-hint = a >> return () ==> Control.Monad.void a-    where _ = (isAtom a || isApp a) && noQuickCheck-warn = fmap (const ()) ==> Control.Monad.void where _ = noQuickCheck-warn = const () <$> x ==> Control.Monad.void x where _ = noQuickCheck-warn = flip (>=>) ==> (<=<) where _ = noQuickCheck-warn = flip (<=<) ==> (>=>) where _ = noQuickCheck-warn = flip (>>=) ==> (=<<) where _ = noQuickCheck-warn = flip (=<<) ==> (>>=) where _ = noQuickCheck-hint = (\x -> f x >>= g) ==> f Control.Monad.>=> g where _ = noQuickCheck-hint = (\x -> f =<< g x) ==> f Control.Monad.<=< g where _ = noQuickCheck-warn = a >> forever a ==> forever a where _ = noQuickCheck-hint = liftM2 id ==> ap where _ = noQuickCheck-warn = mapM (uncurry f) (zip l m) ==> zipWithM f l m where _ = noQuickCheck-warn = mapM_ (void . f) ==> mapM_ f-warn = mapM_ (void f) ==> mapM_ f-warn = forM_ x (void . f) ==> forM_ x f-warn = forM_ x (void f) ==> forM_ x f-warn = void (mapM f x) ==> mapM_ f x-warn = void (forM x f) ==> forM_ x f---- STATE MONAD--warn = fst (runState x y) ==> evalState x y where _ = noQuickCheck-warn = snd (runState x y) ==> execState x y where _ = noQuickCheck---- MONAD LIST--warn = fmap unzip (mapM f x) ==> Control.Monad.mapAndUnzipM f x where _ = noQuickCheck-warn = sequence (zipWith f x y) ==> Control.Monad.zipWithM f x y where _ = noQuickCheck-warn = sequence_ (zipWith f x y) ==> Control.Monad.zipWithM_ f x y where _ = noQuickCheck-warn = sequence (replicate n x) ==> Control.Monad.replicateM n x where _ = noQuickCheck-warn = sequence_ (replicate n x) ==> Control.Monad.replicateM_ n x where _ = noQuickCheck-warn = mapM f (replicate n x) ==> Control.Monad.replicateM n (f x) where _ = noQuickCheck-warn = mapM_ f (replicate n x) ==> Control.Monad.replicateM_ n (f x) where _ = noQuickCheck-warn = mapM f (map g x) ==> mapM (f . g) x where _ = noQuickCheck-warn = mapM_ f (map g x) ==> mapM_ (f . g) x where _ = noQuickCheck-warn = mapM id ==> sequence where _ = noQuickCheck-warn = mapM_ id ==> sequence_ where _ = noQuickCheck---- APPLICATIVE / TRAVERSABLE--warn = flip traverse ==> for where _ = noQuickCheck-warn = flip for ==> traverse where _ = noQuickCheck-warn = flip traverse_ ==> for_ where _ = noQuickCheck-warn = flip for_ ==> traverse_ where _ = noQuickCheck-warn = foldr (*>) (pure ()) ==> sequenceA_ where _ = noQuickCheck-warn = foldr (<|>) empty ==> asum where _ = noQuickCheck-warn = liftA2 (flip ($)) ==> (<**>) where _ = noQuickCheck-warn = Just <$> a <|> pure Nothing ==> optional a where _ = noQuickCheck----- LIST COMP--hint "Use list comprehension" = (if b then [x] else []) ==> [x | b]-hint "Redundant list comprehension" = [x | x <- y] ==> y where _ = isVar x---- SEQ--warn "Redundant seq" = x `seq` x ==> x-warn "Redundant seq" = join seq ==> id-warn "Redundant $!" = id $! x ==> x-warn "Redundant seq" = x `seq` y ==> y where _ = isWHNF x-warn "Redundant $!" = f $! x ==> f x where _ = isWHNF x-warn "Redundant evaluate" = evaluate x ==> return x where _ = isWHNF x---- TUPLE--warn = fst (unzip x) ==> map fst x-warn = snd (unzip x) ==> map snd x---- MAYBE--warn = maybe x id ==> Data.Maybe.fromMaybe x-warn = maybe False (const True) ==> Data.Maybe.isJust-warn = maybe True (const False) ==> Data.Maybe.isNothing-warn = not (isNothing x) ==> isJust x-warn = not (isJust x) ==> isNothing x-warn = maybe [] (:[]) ==> maybeToList-warn = catMaybes (map f x) ==> mapMaybe f x-hint = (case x of Nothing -> y; Just a -> a)  ==> fromMaybe y x-warn = (if isNothing x then y else f (fromJust x)) ==> maybe y f x-warn = (if isJust x then f (fromJust x) else y) ==> maybe y f x-warn = maybe Nothing (Just . f) ==> fmap f-hint = map fromJust . filter isJust  ==>  Data.Maybe.catMaybes-warn = x == Nothing  ==>  isNothing x-warn = Nothing == x  ==>  isNothing x-warn = x /= Nothing  ==>  Data.Maybe.isJust x-warn = Nothing /= x  ==>  Data.Maybe.isJust x-warn = concatMap (maybeToList . f) ==> Data.Maybe.mapMaybe f-warn = concatMap maybeToList ==> catMaybes-warn = maybe n Just x ==> x Control.Applicative.<|> n-hint = (case x of Just a -> a; Nothing -> y)  ==> fromMaybe y x-warn = (if isNothing x then y else fromJust x) ==> fromMaybe y x-warn = (if isJust x then fromJust x else y) ==> fromMaybe y x-warn = isJust x && (fromJust x == y) ==> x == Just y-warn = mapMaybe f (map g x) ==> mapMaybe (f . g) x-warn = fromMaybe a (fmap f x) ==> maybe a f x-warn = mapMaybe id ==> catMaybes-hint = [x | Just x <- a] ==> Data.Maybe.catMaybes a-hint = (case m of Nothing -> Nothing; Just x -> x) ==> Control.Monad.join m-hint = maybe Nothing id ==> join-hint "Too strict maybe" = maybe (f x) (f . g) ==> f . maybe x g where note = IncreasesLaziness---- EITHER--warn = [a | Left a <- a] ==> lefts a-warn = [a | Right a <- a] ==> rights a-warn = either Left (Right . f) ==> fmap f---- INFIX--hint "Use infix" = elem x y ==> x `elem` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = notElem x y ==> x `notElem` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = isInfixOf x y ==> x `isInfixOf` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = isSuffixOf x y ==> x `isSuffixOf` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = isPrefixOf x y ==> x `isPrefixOf` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = union x y ==> x `union` y where _ = not (isInfixApp original) && not (isParen result)-hint "Use infix" = intersect x y ==> x `intersect` y where _ = not (isInfixApp original) && not (isParen result)---- MATHS--warn "Redundant fromIntegral" = fromIntegral x ==> x where _ = isLitInt x-warn "Redundant fromInteger" = fromInteger x ==> x where _ = isLitInt x-hint = x + negate y ==> x - y-hint = 0 - x ==> negate x-warn "Redundant negate" = negate (negate x) ==> x-hint = log y / log x ==> logBase x y-hint = sin x / cos x ==> tan x-hint = n `rem` 2 == 0 ==> even n-hint = n `rem` 2 /= 0 ==> odd n-hint = not (even x) ==> odd x-hint = not (odd x) ==> even x-hint = x ** 0.5 ==> sqrt x-hint "Use 1" = x ^ 0 ==> 1-hint = round (x - 0.5) ==> floor x---- CONCURRENT--hint = mapM_ (writeChan a) ==> writeList2Chan a---- EXCEPTION--hint = flip Control.Exception.catch ==> handle-hint = flip handle ==> Control.Exception.catch-hint = flip (catchJust p) ==> handleJust p-hint = flip (handleJust p) ==> catchJust p-hint = Control.Exception.bracket b (const a) (const t) ==> Control.Exception.bracket_ b a t-hint = Control.Exception.bracket (openFile x y) hClose ==> withFile x y-hint = Control.Exception.bracket (openBinaryFile x y) hClose ==> withBinaryFile x y-hint = throw (ErrorCall a) ==> error a-warn = toException NonTermination ==> nonTermination-warn = toException NestedAtomically ==> nestedAtomically---- STOREABLE/PTR--hint = castPtr nullPtr ==> nullPtr-hint = castPtr (castPtr x) ==> castPtr x-hint = plusPtr (castPtr x) ==> plusPtr x-hint = minusPtr (castPtr x) ==> minusPtr x-hint = minusPtr x (castPtr y) ==> minusPtr x y-hint = peekByteOff (castPtr x) ==> peekByteOff x-hint = pokeByteOff (castPtr x) ==> pokeByteOff x---- WEAK POINTERS--warn = mkWeak a a b ==> mkWeakPtr a b-warn = mkWeak a (a, b) c ==> mkWeakPair a b c---- FOLDABLE--warn "Use Foldable.forM_" = (case m of Nothing -> return (); Just x -> f x) ==> Data.Foldable.forM_ m f-    where _ = noQuickCheck-warn "Use Foldable.forM_" = when (isJust m) (f (fromJust m)) ==> Data.Foldable.forM_ m f-    where _ = noQuickCheck---- EVALUATE---- TODO: These should be moved in to HSE\Evaluate.hs and applied---       through a special evaluate hint mechanism-warn "Evaluate" = True && x ==> x-warn "Evaluate" = False && x ==> False-warn "Evaluate" = True || x ==> True-warn "Evaluate" = False || x ==> x-warn "Evaluate" = not True ==> False-warn "Evaluate" = not False ==> True-warn "Evaluate" = Nothing >>= k ==> Nothing-warn "Evaluate" = k =<< Nothing ==> Nothing-warn "Evaluate" = either f g (Left x) ==> f x-warn "Evaluate" = either f g (Right y) ==> g y-warn "Evaluate" = fst (x,y) ==> x-warn "Evaluate" = snd (x,y) ==> y-warn "Evaluate" = f (fst p) (snd p) ==> uncurry f p-warn "Evaluate" = init [x] ==> []-warn "Evaluate" = null [] ==> True-warn "Evaluate" = length [] ==> 0-warn "Evaluate" = foldl f z [] ==> z-warn "Evaluate" = foldr f z [] ==> z-warn "Evaluate" = foldr1 f [x] ==> x-warn "Evaluate" = scanr f z [] ==> [z]-warn "Evaluate" = scanr1 f [] ==> []-warn "Evaluate" = scanr1 f [x] ==> [x]-warn "Evaluate" = take n [] ==> [] where note = IncreasesLaziness-warn "Evaluate" = drop n [] ==> [] where note = IncreasesLaziness-warn "Evaluate" = takeWhile p [] ==> []-warn "Evaluate" = dropWhile p [] ==> []-warn "Evaluate" = span p [] ==> ([],[])-warn "Evaluate" = lines "" ==> []-warn "Evaluate" = unwords [] ==> ""-warn "Evaluate" = x - 0 ==> x-warn "Evaluate" = x * 1 ==> x-warn "Evaluate" = x / 1 ==> x-warn "Evaluate" = concat [a] ==> a-warn "Evaluate" = concat [] ==> []-warn "Evaluate" = zip [] [] ==> []-warn "Evaluate" = const x y ==> x---- FOLDABLE + TUPLES--warn "Using foldr on tuple"   = foldr   f z (x,b) ==> f b z-warn "Using foldr' on tuple"  = foldr'  f z (x,b) ==> f b z-warn "Using foldl on tuple"   = foldl   f z (x,b) ==> f z b-warn "Using foldl' on tuple"  = foldl'  f z (x,b) ==> f z b-warn "Using foldMap on tuple" = foldMap f   (x,b) ==> f b-warn "Using foldr1 on tuple"  = foldr1  f   (x,b) ==> b-warn "Using foldl1 on tuple"  = foldl1  f   (x,b) ==> b-warn "Using elem on tuple"    = elem    e   (x,b) ==> e == b-warn "Using fold on tuple"    = fold        (x,b) ==> b-warn "Using toList on tuple"  = toList      (x,b) ==> b-warn "Using maximum on tuple" = maximum     (x,b) ==> b-warn "Using minimum on tuple" = minimum     (x,b) ==> b-warn "Using sum on tuple"     = sum         (x,b) ==> b-warn "Using product on tuple" = product     (x,b) ==> b-warn "Using concat on tuple"  = concat      (x,b) ==> b-warn "Using and on tuple"     = and         (x,b) ==> b-warn "Using or on tuple"      = or          (x,b) ==> b-warn "Using any on tuple"     = any     f   (x,b) ==> f b-warn "Using all on tuple"     = all     f   (x,b) ==> f b--warn "Using foldr on tuple"   = foldr   f z (x,y,b) ==> f b z-warn "Using foldr' on tuple"  = foldr'  f z (x,y,b) ==> f b z-warn "Using foldl on tuple"   = foldl   f z (x,y,b) ==> f z b-warn "Using foldl' on tuple"  = foldl'  f z (x,y,b) ==> f z b-warn "Using foldMap on tuple" = foldMap f   (x,y,b)   ==> f b-warn "Using foldr1 on tuple"  = foldr1  f   (x,y,b)   ==> b-warn "Using foldl1 on tuple"  = foldl1  f   (x,y,b)   ==> b-warn "Using elem on tuple"    = elem    e   (x,y,b)   ==> e == b-warn "Using fold on tuple"    = fold        (x,y,b)   ==> b-warn "Using toList on tuple"  = toList      (x,y,b)   ==> b-warn "Using maximum on tuple" = maximum     (x,y,b)   ==> b-warn "Using minimum on tuple" = minimum     (x,y,b)   ==> b-warn "Using sum on tuple"     = sum         (x,y,b)   ==> b-warn "Using product on tuple" = product     (x,y,b)   ==> b-warn "Using concat on tuple"  = concat      (x,y,b)   ==> b-warn "Using and on tuple"     = and         (x,y,b)   ==> b-warn "Using or on tuple"      = or          (x,y,b)   ==> b-warn "Using any on tuple"     = any     f   (x,y,b)   ==> f b-warn "Using all on tuple"     = all     f   (x,y,b)   ==> f b--warn "Using null on tuple"   = null x   ==> False where _ = isTuple x-warn "Using length on tuple" = length x ==> 1     where _ = isTuple x---- COMPLEX--{---- these would be a good idea, but we have not yet proven them and they seem to have side conditions-warn "Use isPrefixOf" = take (length t) s == t ==> t `Data.List.isPrefixOf` s-warn "Use isPrefixOf" = (take i s == t) ==> _eval_ ((i >= length t) && (t `Data.List.isPrefixOf` s))-    where _ = (isList t || isLit t) && isPos i--}--{---- clever hint, but not actually a good idea-hint = (do a <- f; g a) ==> f >>= g-    where _ = (isAtom f || isApp f)--}--test = hints named test are to allow people to put test code within hint files-testPrefix = and any prefix also works---{--<TEST>-yes = concat . map f -- concatMap f-yes = foo . bar . concat . map f . baz . bar -- concatMap f . baz . bar-yes = map f (map g x) -- map (f . g) x-yes = concat.map (\x->if x==e then l' else [x]) -- concatMap (\x->if x==e then l' else [x])-yes = f x where f x = concat . map head -- concatMap head-yes = concat . map f . g -- concatMap f . g-yes = concat $ map f x -- concatMap f x-yes = "test" ++ concatMap (' ':) ["of","this"] -- unwords ("test":["of","this"])-yes = if f a then True else b -- f a || b-yes = not (a == b) -- a /= b-yes = not (a /= b) -- a == b-yes = not . (a ==) -- (a /=)-yes = not . (== a) -- (/= a)-yes = not . (a /=) -- (a ==)-yes = not . (/= a) -- (== a)-yes = if a then 1 else if b then 1 else 2 -- if a || b then 1 else 2-no  = if a then 1 else if b then 3 else 2-yes = a >>= return . bob -- fmap bob a-yes = (x !! 0) + (x !! 2) -- head x-yes = if b < 42 then [a] else [] -- [a | b < 42]-no  = take n (foo xs) == "hello"-yes = head (reverse xs) -- last xs-yes = reverse xs `isPrefixOf` reverse ys -- isSuffixOf xs ys-no = putStrLn $ show (length xs) ++ "Test"-yes = ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable -- toUpper Control.Arrow.*** urlEncode-yes = map (\(a,b) -> a) xs -- fst-yes = map (\(a,_) -> a) xs -- fst-yes = readFile $ args !! 0 -- head args-yes = if Debug `elem` opts then ["--debug"] else [] -- ["--debug" | Debug `elem` opts]-yes = if nullPS s then return False else if headPS s /= '\n' then return False else alter_input tailPS >> return True \-    -- if nullPS s || (headPS s /= '\n') then return False else alter_input tailPS >> return True-yes = if foo then do stuff; moreStuff; lastOfTheStuff else return () \-    -- Control.Monad.when foo $ do stuff ; moreStuff ; lastOfTheStuff-yes = if foo then stuff else return () -- Control.Monad.when foo stuff-yes = foo $ \(a, b) -> (a, y + b) -- Control.Arrow.second ((+) y)-no  = foo $ \(a, b) -> (a, a + b)-yes = map (uncurry (+)) $ zip [1 .. 5] [6 .. 10] -- zipWith (+) [1 .. 5] [6 .. 10]-no = do iter <- textBufferGetTextIter tb ; textBufferSelectRange tb iter iter-no = flip f x $ \y -> y*y+y-no = \x -> f x (g x)-no = foo (\ v -> f v . g)-yes = concat . intersperse " " -- unwords-yes = Prelude.concat $ intersperse " " xs -- unwords xs-yes = concat $ Data.List.intersperse " " xs -- unwords xs-yes = if a then True else False -- a-yes = if x then true else False -- x && true-yes = elem x y -- x `elem` y-yes = foo (elem x y) -- x `elem` y-no  = x `elem` y-no  = elem 1 [] : []-test a = foo (\x -> True) -- const True-test a = foo (\_ -> True) -- const True-test a = foo (\x -> x) -- id-h a = flip f x (y z) -- f (y z) x-h a = flip f x $ y z-yes x = case x of {True -> a ; False -> b} -- if x then a else b-yes x = case x of {False -> a ; _ -> b} -- if x then b else a-no = const . ok . toResponse $ "saved"-yes = case x z of Nothing -> y z; Just pat -> pat -- fromMaybe (y z) (x z)-yes = if p then s else return () -- Control.Monad.when p s-warn = a $$$$ b $$$$ c ==> a . b $$$$$ c-yes = when (not . null $ asdf) -- unless (null asdf)-yes = id 1 -- 1-yes = case concat (map f x) of [] -> [] -- concatMap f x-yes = [v | v <- xs] -- xs-no  = [Left x | Left x <- xs]-when p s = if p then s else return ()-no = x ^^ 18.5-instance Arrow (->) where first f = f *** id-yes = fromInteger 12 -- 12-import Prelude hiding (catch); no = catch-import Control.Exception as E; no = E.catch-main = do f; putStrLn $ show x -- print x-main = map (writer,) $ map arcObj $ filter (rdfPredEq (Res dctreferences)) ts -- map ((writer,) . arcObj) (filter (rdfPredEq (Res dctreferences)) ts)-h x y = return $! (x, y) -- return (x, y)-h x y = return $! x-getInt = do { x <- readIO "0"; return $! (x :: Int) }-foo = evaluate [12] -- return [12]-test = \ a -> f a >>= \ b -> return (a, b)-fooer input = catMaybes . map Just $ input -- mapMaybe Just-yes = mapMaybe id -- catMaybes-main = print $ map (\_->5) [2,3,5] -- const 5-main = head $ drop n x-main = head $ drop (-3) x -- x-main = head $ drop 2 x -- x !! 2-main = drop 0 x -- x-main = take 0 x -- []-main = take (-5) x -- []-main = take (-y) x-main = take 4 x-main = let (first, rest) = (takeWhile p l, dropWhile p l) in rest -- span p l-main = map $ \ d -> ([| $d |], [| $d |])-pairs (x:xs) = map (\y -> (x,y)) xs ++ pairs xs-{-# ANN foo "HLint: ignore" #-};foo = map f (map g x) -- @Ignore ???-yes = fmap lines $ abc 123 -- lines Control.Applicative.<$> abc 123-no = fmap lines $ abc $ def 123-test = foo . not . not -- id-test = map (not . not) xs -- id-used = not . not . any (`notElem` special) . fst . derives -- any (`notElem` special) . fst . derives-test = foo . id . map -- map-test = food id xs-yes = baz baz >> return () -- Control.Monad.void (baz baz)-no = foo >>= bar >>= something >>= elsee >> return ()-no = f (#) x-data Pair = P {a :: !Int}; foo = return $! P{a=undefined}-data Pair = P {a :: !Int}; foo = return $! P undefined-foo = return $! Just undefined -- return (Just undefined)-foo = return $! (a,b) -- return (a,b)-foo = return $! 1-foo = return $! "test"-bar = [x | (x,_) <- pts]-return' x = x `seq` return x-foo = last (sortBy (compare `on` fst) xs) -- maximumBy (compare `on` fst) xs-g = \ f -> parseFile f >>= (\ cu -> return (f, cu))-foo = bar $ \(x,y) -> x x y-foo = (\x -> f x >>= g) -- f Control.Monad.>=> g-foo = (\f -> h f >>= g) -- h Control.Monad.>=> g-foo = (\f -> h f >>= f)-foo = bar $ \x -> [x,y]-foo = bar $ \x -> [z,y] -- const [z,y]-f condition tChar tBool = if condition then _monoField tChar else _monoField tBool-foo = maybe Bar{..} id -- Data.Maybe.fromMaybe Bar{..}-foo = (\a -> Foo {..}) 1-foo = zipWith SymInfo [0 ..] (repeat ty) -- map (\ x -> SymInfo x ty) [0 ..]-f rec = rec-mean x = fst $ foldl (\(m, n) x' -> (m+(x'-m)/(n+1),n+1)) (0,0) x-{-# LANGUAGE TypeApplications #-} \-foo = id @Int-foo = id 12 -- 12--import Prelude \-yes = flip mapM -- Control.Monad.forM-import Control.Monad \-yes = flip mapM -- forM-import Control.Monad(forM) \-yes = flip mapM -- forM-import Control.Monad(forM_) \-yes = flip mapM -- Control.Monad.forM-import qualified Control.Monad \-yes = flip mapM -- Control.Monad.forM-import qualified Control.Monad as CM \-yes = flip mapM -- CM.forM-import qualified Control.Monad as CM(forM,filterM) \-yes = flip mapM -- CM.forM-import Control.Monad as CM(forM,filterM) \-yes = flip mapM -- forM-import Control.Monad hiding (forM) \-yes = flip mapM -- Control.Monad.forM-import Control.Monad hiding (filterM) \-yes = flip mapM -- forM-import qualified Data.Text.Lazy as DTL \-main = DTL.concat $ map (`DTL.snoc` '-') [DTL.pack "one", DTL.pack "two", DTL.pack "three"]-import Text.Blaze.Html5.Attributes as A \-main = A.id (stringValue id')-import Prelude((==)) \-import qualified Prelude as P \-main = P.length xs == 0 -- P.null xs-</TEST>--}

@@ -1,11 +0,0 @@--module HLint.Dollar where--warn = a $ b $ c ==> a . b $ c--{--<TEST>-yes = concat $ concat $ map f x -- concat . concat $ map f x-</TEST>--}-

@@ -1,11 +0,0 @@--module HLint.Generalise where--import Data.Monoid-import Control.Monad--hint = concatMap ==> (=<<)-hint = liftM ==> fmap-    where _ = noQuickCheck-hint = map ==> fmap-hint = a ++ b ==> a `Data.Monoid.mappend` b

@@ -1,5 +0,0 @@--module HLint.HLint where--import "hint" HLint.Default-import "hint" HLint.Builtin.All

@@ -5,9 +5,6 @@ --        things without them overlapping module HLint.Test where -import "hint" HLint.Builtin.All-- error = Prelude.readFile ==> bad  error = (x :: Int) ==> (x :: Int32)

@@ -0,0 +1,56 @@+# HLint configuration file+# https://github.com/ndmitchell/hlint+##########################++# This file contains a template configuration file, which is typically+# placed as .hlint.yaml in the root of your project+++# Specify additional command line arguments+#+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]+++# Control which extensions/flags/modules/functions can be used+#+# - extensions:+#   - default: false # all extension are banned by default+#   - name: PatternGuards, ViewPatterns # only these listed extensions can be used+#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module+#+# - flags:+#   - {name: -w, within: []} # -w is allowed nowhere+#+# - modules:+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely+#+# - functions:+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules+++# Add custom hints for this project+#+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"+# - error: {lhs: wibbleMany [x], rhs: wibbleOne x}+++# Turn on hints that are off by default+#+# Ban "module X(module X) where", to require a real export list+# - warn: {name: Use explicit module export list}+#+# Replace a $ b $ c with a . b $ c+# - group: {name: dollar, enabled: true}+#+# Generalise map to fmap, ++ to <>+# - group: {name: generalise, enabled: true}+++# Ignore some builtin hints+# - ignore: {name: Use let}+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules+++# Define some custom infix operators+# - fixity: infixr 3 ~^#^~

@@ -0,0 +1,764 @@+# hlint configuration file+# ==================================++# The hlint tool is mainly automatic, but some hints/restrictions can be specified here.++- package:+    name: base+    modules:+    - import Prelude+    - import Control.Arrow+    - import Control.Exception+    - 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.Function+    - import Data.Int+    - import Data.Char+    - import Data.List as Data.List+    - import Data.List as X+    - import Data.Maybe+    - import Data.Monoid+    - import System.IO+    - import Control.Concurrent.Chan+    - import System.Mem.Weak+    - import Control.Exception.Base+    - import System.Exit+    - import Data.Either+    - import Numeric++    - import IO as System.IO+    - import List as Data.List+    - import Maybe as Data.Maybe+    - import Monad as Control.Monad+    - import Char as Data.Char++- group:+    name: default+    enabled: true+    imports:+    - package base+    rules:++    # I/O++    - warn: {lhs: putStrLn (show x), rhs: print x}+    - warn: {lhs: mapM_ putChar, rhs: putStr}+    - warn: {lhs: hGetChar stdin, rhs: getChar}+    - warn: {lhs: hGetLine stdin, rhs: getLine}+    - warn: {lhs: hGetContents stdin, rhs: getContents}+    - warn: {lhs: hPutChar stdout, rhs: putChar}+    - warn: {lhs: hPutStr stdout, rhs: putStr}+    - warn: {lhs: hPutStrLn stdout, rhs: putStrLn}+    - warn: {lhs: hPrint stdout, rhs: print}+    - warn: {lhs: hWaitForInput a 0, rhs: hReady a}+    - warn: {lhs: hPutStrLn a (show b), rhs: hPrint a b}+    - warn: {lhs: hIsEOF stdin, rhs: isEOF}+    - warn: {lhs: withFile f m (\h -> hPutStr h x), rhs: writeFile file x}+    - warn: {lhs: withFile f m (\h -> hPutStrLn h x), rhs: writeFile file (x ++ "\n")}++    # EXIT++    - warn: {lhs: exitWith ExitSuccess, rhs: exitSuccess}++    # ORD++    - warn: {lhs: not (a == b), rhs: a /= b, note: incorrect if either value is NaN}+    - warn: {lhs: not (a /= b), rhs: a == b, note: incorrect if either value is NaN}+    - warn: {lhs: not (a >  b), rhs: a <= b, note: incorrect if either value is NaN}+    - warn: {lhs: not (a >= b), rhs: a <  b, note: incorrect if either value is NaN}+    - warn: {lhs: not (a <  b), rhs: a >= b, note: incorrect if either value is NaN}+    - warn: {lhs: not (a <= b), rhs: a >  b, note: incorrect if either value is NaN}+    - warn: {lhs: compare x y /= GT, rhs: x <= y}+    - warn: {lhs: compare x y == LT, rhs: x < y}+    - warn: {lhs: compare x y /= LT, rhs: x >= y}+    - warn: {lhs: compare x y == GT, rhs: x > y}+    - warn: {lhs: compare x y == EQ, rhs: x == y}+    - warn: {lhs: compare x y /= EQ, rhs: x /= y}+    - warn: {lhs: head (sort x), rhs: minimum x}+    - warn: {lhs: last (sort x), rhs: maximum x}+    - 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 (sort x), rhs: sortBy (flip compare) x, name: Avoid reverse}+    - warn: {lhs: reverse (sortBy f x), rhs: sortBy (flip f) x, name: Avoid reverse, side: isCompare f}+    - 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)}+++    # READ/SHOW++    - warn: {lhs: showsPrec 0 x "", rhs: show x}+    - warn: {lhs: readsPrec 0, rhs: reads}+    - warn: {lhs: showsPrec 0, rhs: shows}+    - hint: {lhs: showIntAtBase 16 intToDigit, rhs: showHex}+    - hint: {lhs: showIntAtBase 8 intToDigit, rhs: showOct}++    # LIST++    - warn: {lhs: concat (map f x), 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}+    - hint: {lhs: concatMap f (map g x), rhs: concatMap (f . g) x, name: Fuse concatMap/map}+    - hint: {lhs: x !! 0, rhs: head x}+    - 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: "cycle [x]", rhs: repeat x}+    - warn: {lhs: head (reverse x), rhs: last x}+    - warn: {lhs: head (drop n x), rhs: x !! n, side: isNat n}+    - warn: {lhs: reverse (tail (reverse x)), rhs: init x, note: IncreasesLaziness}+    - warn: {lhs: reverse (reverse x), rhs: x, note: IncreasesLaziness, name: Avoid reverse}+    - warn: {lhs: isPrefixOf (reverse x) (reverse y), rhs: isSuffixOf x y}+    - warn: {lhs: "foldr (++) []", rhs: concat}+    - warn: {lhs: foldr (++) "", rhs: concat}+    - warn: {lhs: "foldl (++) []", rhs: concat, note: IncreasesLaziness}+    - warn: {lhs: foldl (++) "", rhs: concat, note: IncreasesLaziness}+    - warn: {lhs: foldl f (head x) (tail x), rhs: foldl1 f x}+    - warn: {lhs: foldr f (last x) (init x), rhs: foldr1 f x}+    - warn: {lhs: span (not . p), rhs: break p}+    - warn: {lhs: break (not . p), rhs: span p}+    - warn: {lhs: "(takeWhile p x, dropWhile p x)", rhs: span p x}+    - warn: {lhs: fst (span p x), rhs: takeWhile p x}+    - warn: {lhs: snd (span p x), rhs: dropWhile p x}+    - warn: {lhs: fst (break p x), rhs: takeWhile (not . p) x}+    - warn: {lhs: snd (break p x), rhs: dropWhile (not . p) x}+    - warn: {lhs: concatMap (++ "\n"), rhs: unlines}+    - warn: {lhs: map id, rhs: id}+    - warn: {lhs: concatMap id, rhs: concat}+    - warn: {lhs: or (map p x), rhs: any p x}+    - warn: {lhs: and (map p x), rhs: all p x}+    - warn: {lhs: "zipWith (,)", rhs: zip}+    - warn: {lhs: "zipWith3 (,,)", rhs: zip3}+    - hint: {lhs: length x == 0, rhs: null x, note: IncreasesLaziness}+    - hint: {lhs: "x == []", rhs: null x}+    - hint: {lhs: length x /= 0, rhs: not (null x), note: IncreasesLaziness, name: Use null}+    - hint: {lhs: "\\x -> [x]", rhs: "(:[])", name: "Use :"}+    - warn: {lhs: map (uncurry f) (zip x y), rhs: zipWith f x y}+    - hint: {lhs: map f (zip x y), rhs: zipWith (curry f) x y, side: isVar f}+    - warn: {lhs: not (elem x y), rhs: notElem x y}+    - hint: {lhs: foldr f z (map g x), rhs: foldr (f . g) z x}+    - warn: {lhs: "x ++ concatMap (' ':) y", rhs: "unwords (x:y)"}+    - warn: {lhs: intercalate " ", rhs: unwords}+    - hint: {lhs: concat (intersperse x y), rhs: intercalate x y, side: notEq x " "}+    - hint: {lhs: concat (intersperse " " x), rhs: unwords x}+    - warn: {lhs: null (filter f x), rhs: not (any f x), name: Use any}+    - warn: {lhs: "filter f x == []", rhs: not (any f x), name: Use any}+    - warn: {lhs: "filter f x /= []", rhs: any f x}+    - warn: {lhs: any id, rhs: or}+    - warn: {lhs: all id, rhs: and}+    - warn: {lhs: any ((==) a), rhs: elem a, note: ValidInstance "Eq" a}+    - warn: {lhs: any (== a), rhs: elem a}+    - warn: {lhs: any (a ==), rhs: elem a, note: ValidInstance "Eq" a}+    - warn: {lhs: all ((/=) a), rhs: notElem a, note: ValidInstance "Eq" a}+    - warn: {lhs: all (/= a), rhs: notElem a, note: ValidInstance "Eq" a}+    - warn: {lhs: all (a /=), rhs: notElem a, note: ValidInstance "Eq" a}+    - warn: {lhs: elem True, rhs: or}+    - warn: {lhs: notElem False, rhs: and}+    - warn: {lhs: findIndex ((==) a), rhs: elemIndex a}+    - warn: {lhs: findIndex (a ==), rhs: elemIndex a}+    - warn: {lhs: findIndex (== a), rhs: elemIndex a}+    - warn: {lhs: findIndices ((==) a), rhs: elemIndices a}+    - warn: {lhs: findIndices (a ==), rhs: elemIndices a}+    - warn: {lhs: findIndices (== a), rhs: elemIndices a}+    - warn: {lhs: "lookup b (zip l [0..])", rhs: elemIndex b l}+    - hint: {lhs: "elem x [y]", rhs: x == y, note: ValidInstance "Eq" a}+    - hint: {lhs: "notElem x [y]", rhs: x /= y, note: ValidInstance "Eq" a}+    - hint: {lhs: length x >= 0, rhs: "True", name: Length always non-negative}+    - hint: {lhs: length x > 0, rhs: not (null x), note: IncreasesLaziness, name: Use null}+    - hint: {lhs: length x >= 1, rhs: not (null x), note: IncreasesLaziness, name: Use null}+    - warn: {lhs: take i x, rhs: "[]", side: isNegZero i, name: Take on a non-positive}+    - warn: {lhs: drop i x, rhs: x, side: isNegZero i, name: Drop on a non-positive}+    - warn: {lhs: last (scanl f z x), rhs: foldl f z x}+    - warn: {lhs: head (scanr f z x), rhs: foldr f z x}+    - warn: {lhs: iterate id, rhs: repeat}+    - warn: {lhs: zipWith f (repeat x), rhs: map (f x)}+    - warn: {lhs: zipWith f y (repeat z), rhs: map (\x -> f x z) y}++    # TRAVERSABLES++    - warn: {lhs: sequenceA (map f x), rhs: traverse f x}+    - warn: {lhs: sequenceA (fmap f x), rhs: traverse f x}+    - warn: {lhs: sequence (fmap f x), rhs: traverse f x}+    - warn: {lhs: sequenceA_ (map f x), rhs: traverse_ f x}+    - warn: {lhs: sequenceA_ (fmap f x), rhs: traverse_ f x}++    # BY++    - warn: {lhs: deleteBy (==), rhs: delete}+    - warn: {lhs: groupBy (==), rhs: group}+    - warn: {lhs: insertBy compare, rhs: insert}+    - warn: {lhs: intersectBy (==), rhs: intersect}+    - warn: {lhs: maximumBy compare, rhs: maximum}+    - warn: {lhs: minimumBy compare, rhs: minimum}+    - warn: {lhs: nubBy (==), rhs: nub}+    - warn: {lhs: sortBy compare, rhs: sort}+    - warn: {lhs: unionBy (==), rhs: union}++    # FOLDS++    - warn: {lhs: foldr  (>>) (return ()), rhs: sequence_}+    - warn: {lhs: foldr  (&&) True, rhs: and}+    - warn: {lhs: foldl  (&&) True, rhs: and, note: IncreasesLaziness}+    - warn: {lhs: foldr1 (&&) , rhs: and, note: "RemovesError on []"}+    - warn: {lhs: foldl1 (&&) , rhs: and, note: "RemovesError on []"}+    - warn: {lhs: foldr  (||) False, rhs: or}+    - warn: {lhs: foldl  (||) False, rhs: or, note: IncreasesLaziness}+    - warn: {lhs: foldr1 (||) , rhs: or, note: "RemovesError on []"}+    - warn: {lhs: foldl1 (||) , rhs: or, note: "RemovesError on []"}+    - warn: {lhs: foldl  (+) 0, rhs: sum}+    - warn: {lhs: foldr  (+) 0, rhs: sum}+    - warn: {lhs: foldl1 (+)  , rhs: sum, note: "RemovesError on []"}+    - warn: {lhs: foldr1 (+)  , rhs: sum, note: "RemovesError on []"}+    - warn: {lhs: foldl  (*) 1, rhs: product}+    - warn: {lhs: foldr  (*) 1, rhs: product}+    - warn: {lhs: foldl1 (*)  , rhs: product, note: "RemovesError on []"}+    - warn: {lhs: foldr1 (*)  , rhs: product, note: "RemovesError on []"}+    - warn: {lhs: foldl1 max  , rhs: maximum}+    - warn: {lhs: foldr1 max  , rhs: maximum}+    - warn: {lhs: foldl1 min  , rhs: minimum}+    - warn: {lhs: foldr1 min  , rhs: minimum}+    - warn: {lhs: foldr mplus mzero, rhs: msum}++    # FUNCTION++    - warn: {lhs: \x -> x, rhs: id}+    - warn: {lhs: \x y -> x, rhs: const}+    - warn: {lhs: "\\(x,y) -> y", rhs: snd}+    - warn: {lhs: "\\(x,y) -> x", rhs: fst}+    - hint: {lhs: "\\x y -> f (x,y)", rhs: curry f, name: Use curry}+    - hint: {lhs: "\\(x,y) -> f x y", rhs: uncurry f, note: IncreasesLaziness, name: Use uncurry}+    - warn: {lhs: ($) . f, rhs: f, name: Redundant $}+    - warn: {lhs: (f $), rhs: f, name: Redundant $}+    - hint: {lhs: \x -> y, rhs: const y, side: isAtom y && not (isWildcard y)}+        # isWildcard because some people like to put brackets round them even though they are atomic+    - warn: {lhs: flip f x y, rhs: f y x, side: isApp original, name: Redundant flip}+    - warn: {lhs: id x, rhs: x, side: not (isTypeApp x), name: Evaluate}+    - warn: {lhs: id . x, rhs: x, name: Redundant id}+    - warn: {lhs: x . id, rhs: x, name: Redundant id}++    # CHAR++    - warn: {lhs: a >= 'a' && a <= 'z', rhs: isAsciiLower a}+    - warn: {lhs: a >= 'A' && a <= 'Z', rhs: isAsciiUpper a}+    - warn: {lhs: a >= '0' && a <= '9', rhs: isDigit a}+    - warn: {lhs: a >= '0' && a <= '7', rhs: isOctDigit a}+    - warn: {lhs: isLower a || isUpper a, rhs: isAlpha a}+    - warn: {lhs: isUpper a || isLower a, rhs: isAlpha a}++    # BOOL++    - warn: {lhs: x == True, rhs: x, name: Redundant ==}+    - hint: {lhs: x == False, rhs: not x, name: Redundant ==}+    - warn: {lhs: True == a, rhs: a, name: Redundant ==}+    - hint: {lhs: False == a, rhs: not a, name: Redundant ==}+    - warn: {lhs: a /= True, rhs: not a, name: Redundant /=}+    - hint: {lhs: a /= False, rhs: a, name: Redundant /=}+    - warn: {lhs: True /= a, rhs: not a, name: Redundant /=}+    - hint: {lhs: False /= a, rhs: a, name: Redundant /=}+    - warn: {lhs: if a then x else x, rhs: x, note: IncreasesLaziness, name: Redundant if}+    - warn: {lhs: if a then True else False, rhs: a, name: Redundant if}+    - warn: {lhs: if a then False else True, rhs: not a, name: Redundant if}+    - warn: {lhs: if a then t else (if b then t else f), rhs: if a || b then t else f, name: Redundant if}+    - warn: {lhs: if a then (if b then t else f) else f, rhs: if a && b then t else f, name: Redundant if}+    - warn: {lhs: if x then True else y, rhs: x || y, side: notEq y False, name: Redundant if}+    - warn: {lhs: if x then y else False, rhs: x && y, side: notEq y True, name: Redundant if}+    - hint: {lhs: "case a of {True -> t; False -> f}", rhs: if a then t else f, name: Use if}+    - hint: {lhs: "case a of {False -> f; True -> t}", rhs: if a then t else f, name: Use if}+    - hint: {lhs: "case a of {True -> t; _ -> f}", rhs: if a then t else f, name: Use if}+    - hint: {lhs: "case a of {False -> f; _ -> t}", rhs: if a then t else f, name: Use if}+    - hint: {lhs: "if c then (True, x) else (False, x)", rhs: "(c, x)", note: IncreasesLaziness, name: Redundant if}+    - hint: {lhs: "if c then (False, x) else (True, x)", rhs: "(not c, x)", note: IncreasesLaziness, name: Redundant if}+    - hint: {lhs: "or [x, y]", rhs: x || y}+    - hint: {lhs: "or [x, y, z]", rhs: x || y || z}+    - hint: {lhs: "and [x, y]", rhs: x && y}+    - hint: {lhs: "and [x, y, z]", rhs: x && y && z}+    - warn: {lhs: if x then False else y, rhs: not x && y, side: notEq y True, name: Redundant if}+    - warn: {lhs: if x then y else True, rhs: not x || y, side: notEq y False, name: Redundant if}+    - warn: {lhs: not (not x), rhs: x, name: Redundant not}+    # warn "Too strict if": {lhs: if c then f x else f y, rhs: f (if c then x else y), note: IncreasesLaziness}+    # also breaks types, see #87++    # ARROW++    - warn: {lhs: id *** g, rhs: second g}+    - warn: {lhs: f *** id, rhs: first f}+    - warn: {lhs: zip (map f x) (map g x), rhs: map (f Control.Arrow.&&& g) x}+    - hint: {lhs: "\\(x,y) -> (f x, g y)", rhs: f Control.Arrow.*** g}+    - hint: {lhs: "\\x -> (f x, g x)", rhs: f Control.Arrow.&&& g}+    - hint: {lhs: "\\(x,y) -> (f x,y)", rhs: Control.Arrow.first f}+    - hint: {lhs: "\\(x,y) -> (x,f y)", rhs: Control.Arrow.second f}+    - hint: {lhs: "(f (fst x), g (snd x))", rhs: (f Control.Arrow.*** g) x}+    - hint: {lhs: "(fst x, snd x)", rhs:  x, note: DecreasesLaziness, name: Redundant pair}++    # FUNCTOR++    - 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: fmap id, rhs: id, name: Functor law}+    - warn: {lhs: id <$> x, rhs: x, name: Functor law}+    - hint: {lhs: fmap f $ x, rhs: f Control.Applicative.<$> x, side: isApp x || isAtom x}+    - hint: {lhs: \x -> a <$> b x, rhs: fmap a . b}++    # MONAD++    - warn: {lhs: return a >>= f, rhs: f a, name: "Monad law, left identity"}+    - warn: {lhs: f =<< return a, rhs: f a, name: "Monad law, left identity"}+    - warn: {lhs: m >>= return, rhs: m, name: "Monad law, right identity"}+    - warn: {lhs: return =<< m, rhs: m, name: "Monad law, right identity"}+    - warn: {lhs: liftM, rhs: fmap}+    - warn: {lhs: liftA, rhs: fmap}+    - hint: {lhs: m >>= return . f, rhs: fmap f m}+    - hint: {lhs: return . f =<< m, rhs: fmap f m}+    - warn: {lhs: if x then y else return (), rhs: Control.Monad.when x $ _noParen_ y, side: not (isAtom y)}+    - warn: {lhs: if x then y else return (), rhs: Control.Monad.when x y, side: isAtom y}+    - warn: {lhs: if x then return () else y, rhs: Control.Monad.unless x $ _noParen_ y, side: isAtom y}+    - warn: {lhs: if x then return () else y, rhs: Control.Monad.unless x y, side: isAtom y}+    - warn: {lhs: sequence (map f x), rhs: mapM f x}+    - warn: {lhs: sequence_ (map 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: x >>= id, rhs: Control.Monad.join x}+    - warn: {lhs: id =<< x, rhs: Control.Monad.join x}+    - 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: flip (>=>), rhs: (<=<)}+    - warn: {lhs: flip (<=<), rhs: (>=>)}+    - warn: {lhs: flip (>>=), rhs: (=<<)}+    - warn: {lhs: flip (=<<), rhs: (>>=)}+    - hint: {lhs: \x -> f x >>= g, rhs: f Control.Monad.>=> g}+    - hint: {lhs: \x -> f =<< g x, rhs: f Control.Monad.<=< g}+    - warn: {lhs: a >> forever a, rhs: forever a}+    - hint: {lhs: liftM2 id, rhs: ap}+    - warn: {lhs: mapM (uncurry f) (zip l m), rhs: zipWithM f l m}+    - warn: {lhs: mapM_ (void . f), rhs: mapM_ f}+    - warn: {lhs: mapM_ (void f), rhs: mapM_ f}+    - warn: {lhs: forM_ x (void . f), rhs: forM_ x f}+    - warn: {lhs: forM_ x (void f), rhs: forM_ x f}+    - warn: {lhs: void (mapM f x), rhs: mapM_ f x}+    - warn: {lhs: void (forM x f), rhs: forM_ x f}++    # STATE MONAD++    - warn: {lhs: fst (runState x y), rhs: evalState x y}+    - warn: {lhs: snd (runState x y), rhs: execState x y}++    # MONAD LIST++    - 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}+    - warn: {lhs: sequence (replicate n x), rhs: Control.Monad.replicateM n x}+    - warn: {lhs: sequence_ (replicate n x), rhs: Control.Monad.replicateM_ n x}+    - warn: {lhs: mapM f (replicate n x), rhs: Control.Monad.replicateM n (f x)}+    - warn: {lhs: mapM_ f (replicate n x), rhs: Control.Monad.replicateM_ n (f x)}+    - warn: {lhs: mapM f (map g x), rhs: mapM (f . g) x}+    - warn: {lhs: mapM_ f (map g x), rhs: mapM_ (f . g) x}+    - warn: {lhs: mapM id, rhs: sequence}+    - warn: {lhs: mapM_ id, rhs: sequence_}++    # APPLICATIVE / TRAVERSABLE++    - warn: {lhs: flip traverse, rhs: for}+    - warn: {lhs: flip for, rhs: traverse}+    - warn: {lhs: flip traverse_, rhs: for_}+    - warn: {lhs: flip for_, rhs: traverse_}+    - warn: {lhs: foldr (*>) (pure ()), rhs: sequenceA_}+    - warn: {lhs: foldr (<|>) empty, rhs: asum}+    - warn: {lhs: liftA2 (flip ($)), rhs: (<**>)}+    - warn: {lhs: Just <$> a <|> pure Nothing, rhs: optional a}+++    # LIST COMP++    - hint: {lhs: "if b then [x] else []", rhs: "[x | b]", name: Use list comprehension}+    - hint: {lhs: "[x | x <- y]", rhs: "y", side: isVar x, name: Redundant list comprehension}++    # SEQ++    - warn: {lhs: x `seq` x, rhs: x, name: Redundant seq}+    - warn: {lhs: join seq, rhs: id, name: Redundant seq}+    - warn: {lhs: id $! x, rhs: x, name: Redundant $!}+    - warn: {lhs: x `seq` y, rhs: "y", side: isWHNF x, name: Redundant seq}+    - warn: {lhs: f $! x, rhs: f x, side: isWHNF x, name: Redundant $!}+    - warn: {lhs: evaluate x, rhs: return x, side: isWHNF x, name: Redundant evaluate}++    # TUPLE++    - warn: {lhs: fst (unzip x), rhs: map fst x}+    - warn: {lhs: snd (unzip x), rhs: map snd x}++    # MAYBE++    - warn: {lhs: maybe x id, rhs: Data.Maybe.fromMaybe x}+    - warn: {lhs: maybe False (const True), rhs: Data.Maybe.isJust}+    - warn: {lhs: maybe True (const False), rhs: Data.Maybe.isNothing}+    - warn: {lhs: maybe False (== x), rhs: (== Just x)}+    - warn: {lhs: maybe True (/= x), rhs: (/= Just x)}+    - warn: {lhs: not (isNothing x), rhs: isJust x}+    - warn: {lhs: not (isJust x), rhs: isNothing x}+    - warn: {lhs: "maybe [] (:[])", rhs: maybeToList}+    - warn: {lhs: catMaybes (map f x), rhs: mapMaybe f x}+    - hint: {lhs: case x of Nothing -> y; Just a -> a , rhs: fromMaybe y x}+    - warn: {lhs: if isNothing x then y else f (fromJust x), rhs: maybe y f x}+    - 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 , rhs:  Data.Maybe.catMaybes}+    - warn: {lhs: x == Nothing , rhs:  isNothing x}+    - warn: {lhs: Nothing == x , rhs:  isNothing x}+    - warn: {lhs: x /= Nothing , rhs:  Data.Maybe.isJust x}+    - warn: {lhs: Nothing /= x , rhs:  Data.Maybe.isJust x}+    - warn: {lhs: concatMap (maybeToList . f), rhs: Data.Maybe.mapMaybe f}+    - warn: {lhs: concatMap maybeToList, rhs: catMaybes}+    - warn: {lhs: maybe n Just x, rhs: x Control.Applicative.<|> n}+    - hint: {lhs: case x of Just a -> a; Nothing -> y, rhs: fromMaybe y x}+    - 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: mapMaybe f (map g x), rhs: mapMaybe (f . g) x}+    - warn: {lhs: fromMaybe a (fmap f x), rhs: maybe a f x}+    - warn: {lhs: mapMaybe id, rhs: catMaybes}+    - hint: {lhs: "[x | Just x <- a]", rhs: Data.Maybe.catMaybes a}+    - 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 (f x) (f . g), rhs: f . maybe x g, note: IncreasesLaziness, name: Too strict maybe}++    # EITHER++    - warn: {lhs: "[a | Left a <- a]", rhs: lefts a}+    - warn: {lhs: "[a | Right a <- a]", rhs: rights a}+    - warn: {lhs: either Left (Right . f), rhs: fmap f}++    # INFIX++    - hint: {lhs: elem x y, rhs: x `elem` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: notElem x y, rhs: x `notElem` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: isInfixOf x y, rhs: x `isInfixOf` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: isSuffixOf x y, rhs: x `isSuffixOf` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: isPrefixOf x y, rhs: x `isPrefixOf` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: union x y, rhs: x `union` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}+    - hint: {lhs: intersect x y, rhs: x `intersect` y, side: not (isInfixApp original) && not (isParen result), name: Use infix}++    # MATHS++    - warn: {lhs: fromIntegral x, rhs: x, side: isLitInt x, name: Redundant fromIntegral}+    - warn: {lhs: fromInteger x, rhs: x, side: isLitInt x, name: Redundant fromInteger}+    - hint: {lhs: x + negate y, rhs: x - y}+    - hint: {lhs: 0 - x, rhs: negate x}+    - warn: {lhs: negate (negate x), rhs: x, name: Redundant negate}+    - hint: {lhs: log y / log x, rhs: logBase x y}+    - hint: {lhs: sin x / cos x, rhs: tan x}+    - hint: {lhs: n `rem` 2 == 0, rhs: even n}+    - hint: {lhs: n `rem` 2 /= 0, rhs: odd n}+    - hint: {lhs: not (even x), rhs: odd x}+    - hint: {lhs: not (odd x), rhs: even x}+    - hint: {lhs: x ** 0.5, rhs: sqrt x}+    - hint: {lhs: x ^ 0, rhs: "1", name: Use 1}+    - hint: {lhs: round (x - 0.5), rhs: floor x}++    # CONCURRENT++    - hint: {lhs: mapM_ (writeChan a), rhs: writeList2Chan a}++    # EXCEPTION++    - hint: {lhs: flip Control.Exception.catch, rhs: handle}+    - hint: {lhs: flip handle, rhs: Control.Exception.catch}+    - hint: {lhs: flip (catchJust p), rhs: handleJust p}+    - hint: {lhs: flip (handleJust p), rhs: catchJust p}+    - hint: {lhs: Control.Exception.bracket b (const a) (const t), rhs: Control.Exception.bracket_ b a t}+    - hint: {lhs: Control.Exception.bracket (openFile x y) hClose, rhs: withFile x y}+    - hint: {lhs: Control.Exception.bracket (openBinaryFile x y) hClose, rhs: withBinaryFile x y}+    - hint: {lhs: throw (ErrorCall a), rhs: error a}+    - warn: {lhs: toException NonTermination, rhs: nonTermination}+    - warn: {lhs: toException NestedAtomically, rhs: nestedAtomically}++    # STOREABLE/PTR++    - hint: {lhs: castPtr nullPtr, rhs: nullPtr}+    - hint: {lhs: castPtr (castPtr x), rhs: castPtr x}+    - hint: {lhs: plusPtr (castPtr x), rhs: plusPtr x}+    - hint: {lhs: minusPtr (castPtr x), rhs: minusPtr x}+    - hint: {lhs: minusPtr x (castPtr y), rhs: minusPtr x y}+    - hint: {lhs: peekByteOff (castPtr x), rhs: peekByteOff x}+    - hint: {lhs: pokeByteOff (castPtr x), rhs: pokeByteOff x}++    # WEAK POINTERS++    - warn: {lhs: mkWeak a a b, rhs: mkWeakPtr a b}+    - warn: {lhs: "mkWeak a (a, b) c", rhs: mkWeakPair a b c}++    # FOLDABLE++    - warn: {lhs: case m of Nothing -> return (); Just x -> f x, rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: when (isJust m) (f (fromJust m)), rhs: Data.Foldable.forM_ m f}++    # EVALUATE++    - warn: {lhs: True && x, rhs: x, name: Evaluate}+    - warn: {lhs: False && x, rhs: "False", name: Evaluate}+    - warn: {lhs: True || x, rhs: "True", name: Evaluate}+    - warn: {lhs: False || x, rhs: x, name: Evaluate}+    - warn: {lhs: not True, rhs: "False", name: Evaluate}+    - warn: {lhs: not False, rhs: "True", name: Evaluate}+    - warn: {lhs: Nothing >>= k, rhs: Nothing, name: Evaluate}+    - warn: {lhs: k =<< Nothing, rhs: Nothing, name: Evaluate}+    - warn: {lhs: either f g (Left x), rhs: f x, name: Evaluate}+    - 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: f (fst p) (snd p), rhs: uncurry f p, name: Evaluate}+    - warn: {lhs: "init [x]", rhs: "[]", name: Evaluate}+    - warn: {lhs: "null []", rhs: "True", name: Evaluate}+    - warn: {lhs: "length []", rhs: "0", name: Evaluate}+    - warn: {lhs: "foldl f z []", rhs: z, name: Evaluate}+    - warn: {lhs: "foldr f z []", rhs: z, name: Evaluate}+    - warn: {lhs: "foldr1 f [x]", rhs: x, name: Evaluate}+    - warn: {lhs: "scanr f z []", rhs: "[z]", name: Evaluate}+    - warn: {lhs: "scanr1 f []", rhs: "[]", name: Evaluate}+    - warn: {lhs: "scanr1 f [x]", rhs: "[x]", name: Evaluate}+    - warn: {lhs: "take n []", rhs: "[]", note: IncreasesLaziness, name: Evaluate}+    - warn: {lhs: "drop n []", rhs: "[]", note: IncreasesLaziness, name: Evaluate}+    - warn: {lhs: "takeWhile p []", rhs: "[]", name: Evaluate}+    - warn: {lhs: "dropWhile p []", rhs: "[]", name: Evaluate}+    - warn: {lhs: "span p []", rhs: "([],[])", name: Evaluate}+    - warn: {lhs: lines "", rhs: "[]", name: Evaluate}+    - warn: {lhs: "unwords []", rhs: "\"\"", name: Evaluate}+    - warn: {lhs: x - 0, rhs: x, name: Evaluate}+    - warn: {lhs: x * 1, rhs: x, name: Evaluate}+    - warn: {lhs: x / 1, rhs: x, name: Evaluate}+    - warn: {lhs: "concat [a]", rhs: a, name: Evaluate}+    - warn: {lhs: "concat []", rhs: "[]", name: Evaluate}+    - warn: {lhs: "zip [] []", rhs: "[]", name: Evaluate}+    - warn: {lhs: const x y, rhs: x, name: Evaluate}++    # FOLDABLE + TUPLES++    - warn: {lhs: "foldr   f z (x,b)", rhs: f b z, name: Using foldr on tuple}+    - warn: {lhs: "foldr'  f z (x,b)", rhs: f b z, name: Using foldr' on tuple}+    - warn: {lhs: "foldl   f z (x,b)", rhs: f z b, name: Using foldl on tuple}+    - warn: {lhs: "foldl'  f z (x,b)", rhs: f z b, name: Using foldl' on tuple}+    - warn: {lhs: "foldMap f   (x,b)", rhs: f b, name: Using foldMap on tuple}+    - warn: {lhs: "foldr1  f   (x,b)", rhs: b, name: Using foldr1 on tuple}+    - warn: {lhs: "foldl1  f   (x,b)", rhs: b, name: Using foldl1 on tuple}+    - warn: {lhs: "elem    e   (x,b)", rhs: e == b, name: Using elem on tuple}+    - warn: {lhs: "fold        (x,b)", rhs: b, name: Using fold on tuple}+    - 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: "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: "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}+    - warn: {lhs: "all     f   (x,b)", rhs: f b, name: Using all on tuple}++    - warn: {lhs: "foldr   f z (x,y,b)", rhs: f b z, name: Using foldr on tuple}+    - warn: {lhs: "foldr'  f z (x,y,b)", rhs: f b z, name: Using foldr' on tuple}+    - warn: {lhs: "foldl   f z (x,y,b)", rhs: f z b, name: Using foldl on tuple}+    - warn: {lhs: "foldl'  f z (x,y,b)", rhs: f z b, name: Using foldl' on tuple}+    - warn: {lhs: "foldMap f   (x,y,b)", rhs: f b, name: Using foldMap on tuple}+    - warn: {lhs: "foldr1  f   (x,y,b)", rhs: b, name: Using foldr1 on tuple}+    - warn: {lhs: "foldl1  f   (x,y,b)", rhs: b, name: Using foldl1 on tuple}+    - warn: {lhs: "elem    e   (x,y,b)", rhs: e == b, name: Using elem on tuple}+    - warn: {lhs: "fold        (x,y,b)", rhs: b, name: Using fold on tuple}+    - 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: "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: "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}+    - warn: {lhs: "all     f   (x,y,b)", rhs: f b, name: Using all on tuple}++    - warn: {lhs: null x  , rhs: "False", side: isTuple x, name: Using null on tuple}+    - warn: {lhs: length x, rhs: "1"    , side: isTuple x, name: Using length on tuple}+++- group:+    name: generalise+    enabled: false+    imports:+    - package base+    rules:+    - warn: {lhs: map, rhs: fmap}+    - warn: {lhs: a ++ b, rhs: a <> b}++- group:+    name: dollar+    enabled: false+    imports:+    - package base+    rules:+    - warn: {lhs: a $ b $ c, rhs: a . b $ c}+++# <TEST>+# yes = concat . map f -- concatMap f+# yes = foo . bar . concat . map f . baz . bar -- concatMap f . baz . bar+# yes = map f (map g x) -- map (f . g) x+# yes = concat.map (\x->if x==e then l' else [x]) -- concatMap (\x->if x==e then l' else [x])+# yes = f x where f x = concat . map head -- concatMap head+# yes = concat . map f . g -- concatMap f . g+# yes = concat $ map f x -- concatMap f x+# yes = "test" ++ concatMap (' ':) ["of","this"] -- unwords ("test":["of","this"])+# yes = if f a then True else b -- f a || b+# yes = not (a == b) -- a /= b+# yes = not (a /= b) -- a == b+# yes = not . (a ==) -- (a /=)+# yes = not . (== a) -- (/= a)+# yes = not . (a /=) -- (a ==)+# yes = not . (/= a) -- (== a)+# yes = if a then 1 else if b then 1 else 2 -- if a || b then 1 else 2+# no  = if a then 1 else if b then 3 else 2+# yes = a >>= return . bob -- fmap bob a+# yes = (x !! 0) + (x !! 2) -- head x+# yes = if b < 42 then [a] else [] -- [a | b < 42]+# no  = take n (foo xs) == "hello"+# yes = head (reverse xs) -- last xs+# yes = reverse xs `isPrefixOf` reverse ys -- isSuffixOf xs ys+# no = putStrLn $ show (length xs) ++ "Test"+# yes = ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable -- toUpper Control.Arrow.*** urlEncode+# yes = map (\(a,b) -> a) xs -- fst+# yes = map (\(a,_) -> a) xs -- fst+# yes = readFile $ args !! 0 -- head args+# yes = if Debug `elem` opts then ["--debug"] else [] -- ["--debug" | Debug `elem` opts]+# yes = if nullPS s then return False else if headPS s /= '\n' then return False else alter_input tailPS >> return True \+#     -- if nullPS s || (headPS s /= '\n') then return False else alter_input tailPS >> return True+# yes = if foo then do stuff; moreStuff; lastOfTheStuff else return () \+#     -- Control.Monad.when foo $ do stuff ; moreStuff ; lastOfTheStuff+# yes = if foo then stuff else return () -- Control.Monad.when foo stuff+# yes = foo $ \(a, b) -> (a, y + b) -- Control.Arrow.second ((+) y)+# no  = foo $ \(a, b) -> (a, a + b)+# yes = map (uncurry (+)) $ zip [1 .. 5] [6 .. 10] -- zipWith (+) [1 .. 5] [6 .. 10]+# no = do iter <- textBufferGetTextIter tb ; textBufferSelectRange tb iter iter+# no = flip f x $ \y -> y*y+y+# no = \x -> f x (g x)+# no = foo (\ v -> f v . g)+# yes = concat . intersperse " " -- unwords+# yes = Prelude.concat $ intersperse " " xs -- unwords xs+# yes = concat $ Data.List.intersperse " " xs -- unwords xs+# yes = if a then True else False -- a+# yes = if x then true else False -- x && true+# yes = elem x y -- x `elem` y+# yes = foo (elem x y) -- x `elem` y+# no  = x `elem` y+# no  = elem 1 [] : []+# test a = foo (\x -> True) -- const True+# test a = foo (\_ -> True) -- const True+# test a = foo (\x -> x) -- id+# h a = flip f x (y z) -- f (y z) x+# h a = flip f x $ y z+# yes x = case x of {True -> a ; False -> b} -- if x then a else b+# yes x = case x of {False -> a ; _ -> b} -- if x then b else a+# no = const . ok . toResponse $ "saved"+# yes = case x z of Nothing -> y z; Just pat -> pat -- fromMaybe (y z) (x z)+# yes = if p then s else return () -- Control.Monad.when p s+# warn = a $$$$ b $$$$ c ==> a . b $$$$$ c+# yes = when (not . null $ asdf) -- unless (null asdf)+# yes = id 1 -- 1+# yes = case concat (map f x) of [] -> [] -- concatMap f x+# yes = [v | v <- xs] -- xs+# no  = [Left x | Left x <- xs]+# when p s = if p then s else return ()+# no = x ^^ 18.5+# instance Arrow (->) where first f = f *** id+# yes = fromInteger 12 -- 12+# import Prelude hiding (catch); no = catch+# import Control.Exception as E; no = E.catch+# main = do f; putStrLn $ show x -- print x+# main = map (writer,) $ map arcObj $ filter (rdfPredEq (Res dctreferences)) ts -- map ((writer,) . arcObj) (filter (rdfPredEq (Res dctreferences)) ts)+# h x y = return $! (x, y) -- return (x, y)+# h x y = return $! x+# getInt = do { x <- readIO "0"; return $! (x :: Int) }+# foo = evaluate [12] -- return [12]+# test = \ a -> f a >>= \ b -> return (a, b)+# fooer input = catMaybes . map Just $ input -- mapMaybe Just+# yes = mapMaybe id -- catMaybes+# main = print $ map (\_->5) [2,3,5] -- const 5+# main = head $ drop n x+# main = head $ drop (-3) x -- x+# main = head $ drop 2 x -- x !! 2+# main = drop 0 x -- x+# main = take 0 x -- []+# main = take (-5) x -- []+# main = take (-y) x+# main = take 4 x+# main = let (first, rest) = (takeWhile p l, dropWhile p l) in rest -- span p l+# main = map $ \ d -> ([| $d |], [| $d |])+# pairs (x:xs) = map (\y -> (x,y)) xs ++ pairs xs+# {-# ANN foo "HLint: ignore" #-};foo = map f (map g x) -- @Ignore ???+# yes = fmap lines $ abc 123 -- lines Control.Applicative.<$> abc 123+# no = fmap lines $ abc $ def 123+# test = foo . not . not -- id+# test = map (not . not) xs -- id+# used = not . not . any (`notElem` special) . fst . derives -- any (`notElem` special) . fst . derives+# test = foo . id . map -- map+# test = food id xs+# yes = baz baz >> return () -- Control.Monad.void (baz baz)+# no = foo >>= bar >>= something >>= elsee >> return ()+# no = f (#) x+# data Pair = P {a :: !Int}; foo = return $! P{a=undefined}+# data Pair = P {a :: !Int}; foo = return $! P undefined+# foo = return $! Just undefined -- return (Just undefined)+# foo = return $! (a,b) -- return (a,b)+# foo = return $! 1+# foo = return $! "test"+# bar = [x | (x,_) <- pts]+# return' x = x `seq` return x+# foo = last (sortBy (compare `on` fst) xs) -- maximumBy (compare `on` fst) xs+# g = \ f -> parseFile f >>= (\ cu -> return (f, cu))+# foo = bar $ \(x,y) -> x x y+# foo = (\x -> f x >>= g) -- f Control.Monad.>=> g+# foo = (\f -> h f >>= g) -- h Control.Monad.>=> g+# foo = (\f -> h f >>= f)+# foo = bar $ \x -> [x,y]+# foo = bar $ \x -> [z,y] -- const [z,y]+# f condition tChar tBool = if condition then _monoField tChar else _monoField tBool+# foo = maybe Bar{..} id -- Data.Maybe.fromMaybe Bar{..}+# foo = (\a -> Foo {..}) 1+# foo = zipWith SymInfo [0 ..] (repeat ty) -- map (\ x -> SymInfo x ty) [0 ..]+# f rec = rec+# mean x = fst $ foldl (\(m, n) x' -> (m+(x'-m)/(n+1),n+1)) (0,0) x+# {-# LANGUAGE TypeApplications #-} \+# foo = id @Int+# foo = id 12 -- 12+# +# import Prelude \+# yes = flip mapM -- Control.Monad.forM+# import Control.Monad \+# yes = flip mapM -- forM+# import Control.Monad(forM) \+# yes = flip mapM -- forM+# import Control.Monad(forM_) \+# yes = flip mapM -- Control.Monad.forM+# import qualified Control.Monad \+# yes = flip mapM -- Control.Monad.forM+# import qualified Control.Monad as CM \+# yes = flip mapM -- CM.forM+# import qualified Control.Monad as CM(forM,filterM) \+# yes = flip mapM -- CM.forM+# import Control.Monad as CM(forM,filterM) \+# yes = flip mapM -- forM+# import Control.Monad hiding (forM) \+# yes = flip mapM -- Control.Monad.forM+# import Control.Monad hiding (filterM) \+# yes = flip mapM -- forM+# import qualified Data.Text.Lazy as DTL \+# main = DTL.concat $ map (`DTL.snoc` '-') [DTL.pack "one", DTL.pack "two", DTL.pack "three"]+# import Text.Blaze.Html5.Attributes as A \+# main = A.id (stringValue id')+# import Prelude((==)) \+# import qualified Prelude as P \+# main = P.length xs == 0 -- P.null xs+# </TEST>

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            1.9.41+version:            2.0 license:            BSD3 license-file:       LICENSE category:           Development@@ -15,10 +15,8 @@ bug-reports:        https://github.com/ndmitchell/hlint/issues data-dir:           data data-files:-    Default.hs-    Generalise.hs-    Dollar.hs-    HLint.hs+    hlint.yaml+    default.yaml     Test.hs     report_template.html     hs-lint.el@@ -29,7 +27,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:        GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3  source-repository head     type:     git@@ -49,6 +47,7 @@     default-language:   Haskell2010     build-depends:         base == 4.*, process, filepath, directory, containers,+        unordered-containers, yaml, vector, text, bytestring,         transformers,         cpphs >= 1.20.1,         cmdargs >= 0.10,@@ -66,7 +65,6 @@     hs-source-dirs:     src     exposed-modules:         Language.Haskell.HLint-        Language.Haskell.HLint2         Language.Haskell.HLint3     other-modules:         Paths_hlint@@ -80,8 +78,11 @@         Util         Parallel         Refact+        Config.All+        Config.Compute         Config.Haskell         Config.Type+        Config.Yaml         HSE.All         HSE.Bracket         HSE.FreeVars@@ -94,6 +95,7 @@         Hint.Bracket         Hint.Comment         Hint.Duplicate+        Hint.Export         Hint.Extensions         Hint.Import         Hint.Lambda@@ -105,6 +107,7 @@         Hint.NewType         Hint.Pattern         Hint.Pragma+        Hint.Restrict         Hint.Type         Hint.Unsafe         Hint.Util

@@ -5,6 +5,7 @@ import Data.Monoid import HSE.All import Hint.All+import Hint.Type import Data.Tuple.Extra import Data.Either import Data.List.Extra@@ -12,7 +13,6 @@ import Data.Ord import Config.Type import Config.Haskell-import Idea import Prelude  @@ -40,25 +40,29 @@ --   which is slower and often pointless (by default HLint passes modules singularly, using --   @--cross@ to pass all modules together). applyHints :: [Classify] -> Hint -> [(Module_, [Comment])] -> [Idea]-applyHints cls hints_ ms = concat $+applyHints cs = applyHintsReal $ map SettingClassify cs++applyHintsReal :: [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea]+applyHintsReal settings hints_ ms = concat $     [ map (classify $ cls ++ mapMaybe readPragma (universeBi m)) $-        order "" (hintModule hints nm m) `merge`+        order "" (hintModule hints settings nm m) `merge`         concat [order (fromNamed d) $ decHints d | d <- moduleDecls m] `merge`-        concat [order "" $ hintComment hints c | c <- cs]+        concat [order "" $ hintComment hints settings c | c <- cs]     | (nm,(m,cs)) <- mns-    , let decHints = hintDecl hints nm m -- partially apply+    , let decHints = hintDecl hints settings nm m -- partially apply     , let order n = map (\i -> i{ideaModule=moduleName m, ideaDecl=n}) . sortBy (comparing ideaSpan)     , let merge = mergeBy (comparing ideaSpan)] ++-    [map (classify cls) (hintModules hints $ map (second fst) mns)]+    [map (classify cls) (hintModules hints settings $ map (second fst) mns)]     where+        cls = [x | SettingClassify x <- settings]         mns = map (scopeCreate . fst &&& id) ms         hints = (if length ms <= 1 then noModules else id) hints_-        noModules h = h{hintModules = const []} `mappend` mempty{hintModule = \a b -> hintModules h [(a,b)]}+        noModules h = h{hintModules = \_ _ -> []} `mappend` mempty{hintModule = \s a b -> hintModules h s [(a,b)]}   -- | Given a list of settings (a way to classify) and a list of hints, run them over a list of modules. executeHints :: [Setting] -> [(Module_, [Comment])] -> [Idea]-executeHints s = applyHints [x | SettingClassify x <- s] (allHints s)+executeHints s = applyHintsReal s (allHints s)   -- | Return either an idea (a parse error) or the module. In IO because might call the C pre processor.

@@ -1,8 +1,13 @@ {-# LANGUAGE PatternGuards, RecordWildCards, DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse -O0 #-} -module CmdLine(Cmd(..), cmdCpp, CppFlags(..), getCmd, cmdExtensions, cmdHintFiles, cmdUseColour, exitWithHelp, resolveFile) where+module CmdLine(+    Cmd(..), getCmd,+    CppFlags(..), cmdCpp, cmdExtensions, cmdHintFiles, cmdUseColour,+    exitWithHelp, resolveFile+    ) where +import Control.Monad.Extra import Data.Char import Data.List import System.Console.ANSI(hSupportsANSI)@@ -17,12 +22,13 @@ import Language.Haskell.Exts.Extension import Data.Maybe import System.Environment-import qualified System.Info.Extra as Info+import System.Info.Extra  import Util import Paths_hlint import Data.Version + getCmd :: [String] -> IO Cmd getCmd args = withArgs (map f args) $ automatic =<< cmdArgsRun mode     where f x = if x == "-?" || x == "--help" then "--help=all" else x@@ -66,7 +72,7 @@   instance Default ColorMode where-  def = if Info.isWindows then Never else Auto+  def = if isWindows then Never else Auto   data Cmd@@ -81,11 +87,10 @@         ,cmdShowAll :: Bool              -- ^ display all skipped items         ,cmdExtension :: [String]        -- ^ extensions         ,cmdLanguage :: [String]      -- ^ the extensions (may be prefixed by "No")-        ,cmdUtf8 :: Bool-        ,cmdEncoding :: String         -- ^ the text encoding         ,cmdCross :: Bool                -- ^ work between source files, applies to hints such as duplicate code between modules         ,cmdFindHints :: [FilePath]      -- ^ source files to look for hints in         ,cmdDataDir :: FilePath          -- ^ the data directory+        ,cmdDefault :: Bool              -- ^ Print a default file to stdout         ,cmdPath :: [String]         ,cmdCppDefine :: [String]         ,cmdCppInclude :: [FilePath]@@ -106,8 +111,6 @@         ,cmdPattern :: String         ,cmdExtension :: [String]        -- ^ extensions         ,cmdLanguage :: [String]      -- ^ the extensions (may be prefixed by "No")-        ,cmdUtf8 :: Bool-        ,cmdEncoding :: String         -- ^ the text encoding         ,cmdPath :: [String]         ,cmdCppDefine :: [String]         ,cmdCppInclude :: [FilePath]@@ -143,11 +146,10 @@         ,cmdShowAll = nam "show" &= help "Show all ignored ideas"         ,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)"-        ,cmdUtf8 = nam "utf8" &= help "Use UTF-8 text encoding"-        ,cmdEncoding = nam_ "encoding" &= typ "ENCODING" &= help "Choose the text encoding"         ,cmdCross = nam_ "cross" &= help "Work between modules"         ,cmdFindHints = nam "find" &= typFile &= help "Find hints in a Haskell file"-        ,cmdDataDir = nam "datadir" &= typDir &= help "Override the data directory"+        ,cmdDataDir = nam_ "datadir" &= typDir &= help "Override the data directory"+        ,cmdDefault = nam "default" &= help "Print a default file to stdout"         ,cmdPath = nam "path" &= help "Directory in which to search for files"         ,cmdCppDefine = nam_ "cpp-define" &= typ "NAME[=VALUE]" &= help "CPP #define"         ,cmdCppInclude = nam_ "cpp-include" &= typDir &= help "CPP include path"@@ -174,9 +176,9 @@         ,cmdTempDir = nam_ "tempdir" &= help "Where to put temporary files (not cleaned up)"         } &= explicit &= name "test"         &= details ["HLint gives hints on how to improve Haskell code."-                 ,""-                 ,"To check all Haskell files in 'src' and generate a report type:"-                 ,"  hlint src --report"]+                   ,""+                   ,"To check all Haskell files in 'src' and generate a report type:"+                   ,"  hlint src --report"]     ,CmdHSE         {} &= explicit &= name "hse"     ] &= program "hlint" &= verbosity@@ -185,8 +187,27 @@         nam xs = nam_ xs &= name [head xs]         nam_ xs = def &= explicit &= name xs +-- | Where should we find the configuration files?+--   * If someone passes cmdWithHints, only look at files they explicitly request+--   * If someone passes an explicit hint name, automatically merge in data/hlint.yaml+--   We want more important hints to go last, since they override cmdHintFiles :: Cmd -> IO [FilePath]-cmdHintFiles cmd = mapM (getHintFile $ cmdDataDir cmd) $ cmdGivenHints cmd ++ ["HLint" | null (cmdGivenHints cmd) && null (cmdWithHints cmd)]+cmdHintFiles cmd = do+    let explicit1 = [cmdDataDir cmd </> "hlint.yaml" | null $ cmdWithHints cmd]+    let explicit2 = cmdGivenHints cmd+    bad <- filterM (notM . doesFileExist) $ explicit1 ++ explicit2+    when (bad /= []) $+        fail $ unlines $ "Failed to find requested hint files:" : map ("  "++) bad+    if cmdWithHints cmd /= [] then return $ explicit1 ++ explicit2 else do+        -- we follow the stylish-haskell config file search policy+        -- 1) current directory or its ancestors; 2) home directory+        curdir <- getCurrentDirectory+        home <- getHomeDirectory+        b <- doesFileExist ".hlint.yaml"+        implicit <- findM doesFileExist $ map (</> ".hlint.yaml") $ ancestors curdir ++ [home]+        return $ explicit1 ++ maybeToList implicit ++ explicit2+    where+        ancestors = init . map joinPath . reverse . inits . splitPath  cmdExtensions :: Cmd -> (Language, [Extension]) cmdExtensions = getExtensions . cmdLanguage@@ -224,7 +245,7 @@ getFile path _ (Just tmpfile) "-" =   getContents >>= writeFile tmpfile >> return [tmpfile] getFile path _ Nothing "-" = return ["-"]-getFile [] exts _ file = error $ "Couldn't find file: " ++ file+getFile [] exts _ file = exitMessage $ "Couldn't find file: " ++ file getFile (p:ath) exts t file = do     isDir <- doesDirectoryExist $ p <\> file     if isDir then do@@ -258,20 +279,6 @@ getModule _ _ _ = return Nothing  -getHintFile :: FilePath -> FilePath -> IO FilePath-getHintFile _ "-" = return "-"-getHintFile dataDir x = do-        let poss = nub $ concat [x : [x <.> "hs" | takeExtension x /= ".hs"] | x <- [x,dataDir </> x]]-        f poss poss-    where-        f o [] = error $ unlines $ [-            "Couldn't find file: " ++ x,-            "Tried with:"] ++ map ("  "++) o-        f o (x:xs) = do-            b <- doesFileExist x-            if b then return x else f o xs-- getExtensions :: [String] -> (Language, [Extension]) getExtensions args = (lang, foldl f (if null langs then defaultExtensions else []) exts)     where@@ -282,7 +289,7 @@         f a "Haskell98" = []         f a ('N':'o':x) | Just x <- readExtension x = delete x a         f a x | Just x <- readExtension x = x : delete x a-        f a x = error $ "Unknown extension: " ++ x+        f a x = exitMessageImpure $ "Unknown extension: " ++ x   readExtension :: String -> Maybe Extension

@@ -0,0 +1,17 @@++module Config.All(readFilesConfig) where++import Config.Type+import Config.Haskell+import Config.Yaml+import Data.List.Extra+import System.FilePath+++readFilesConfig :: [(FilePath, Maybe String)] -> IO [Setting]+readFilesConfig files = do+        yaml <- mapM (uncurry readFileConfigYaml) yaml+        haskell <- mapM (uncurry readFileConfigHaskell) haskell+        return $ concat haskell ++ settingsFromConfigYaml yaml+    where+        (yaml, haskell) = partition (\(x,_) -> lower (takeExtension x) `elem` [".yml",".yaml"]) files

@@ -0,0 +1,62 @@+{-# LANGUAGE RecordWildCards #-}++-- | Given a file, guess settings from it by looking at the hints.+module Config.Compute(computeSettings) where++import HSE.All+import Config.Type+import Config.Haskell+import Data.Monoid+import Prelude+++-- | Given a source file, guess some hints that might apply.+--   Returns the text of the hints (if you want to save it down) along with the settings to be used.+computeSettings :: ParseFlags -> FilePath -> IO (String, [Setting])+computeSettings flags file = do+    x <- parseModuleEx flags file Nothing+    case x of+        Left (ParseError sl msg _) ->+            return ("# Parse error " ++ showSrcLoc sl ++ ": " ++ msg, [])+        Right (m, _) -> do+            let xs = concatMap (findSetting $ UnQual an) (moduleDecls m)+                r = concatMap (readSetting mempty) xs+                s = unlines $ ["# hints found in " ++ file] ++ concatMap renderSetting r ++ ["# no hints found" | null xs]+            return (s,r)++renderSetting :: Setting -> [String]+renderSetting (SettingMatchExp HintRule{..}) =+    ["- warn: {lhs: " ++ show (prettyPrint hintRuleLHS) ++ ", rhs: " ++ show (prettyPrint hintRuleRHS) ++ "}"]+renderSetting (Infix x) = ["- infix: " ++ show (prettyPrint (toInfixDecl x))]+renderSetting _ = []++findSetting :: (Name S -> QName S) -> Decl_ -> [Decl_]+findSetting qual (InstDecl _ _ _ (Just xs)) = concatMap (findSetting qual) [x | InsDecl _ x <- xs]+findSetting qual (PatBind _ (PVar _ name) (UnGuardedRhs _ bod) Nothing) = findExp (qual name) [] bod+findSetting qual (FunBind _ [InfixMatch _ p1 name ps rhs bind]) = findSetting qual $ FunBind an [Match an name (p1:ps) rhs bind]+findSetting qual (FunBind _ [Match _ name ps (UnGuardedRhs _ bod) Nothing]) = findExp (qual name) [] $ Lambda an ps bod+findSetting _ x@InfixDecl{} = [x]+findSetting _ _ = []+++-- given a result function name, a list of variables, a body expression, give some hints+findExp :: QName S -> [String] -> Exp_ -> [Decl_]+findExp name vs (Lambda _ ps bod) | length ps2 == length ps = findExp name (vs++ps2) bod+                                  | otherwise = []+    where ps2 = [x | PVar_ x <- map view ps]+findExp name vs Var{} = []+findExp name vs (InfixApp _ x dot y) | isDot dot = findExp name (vs++["_hlint"]) $ App an x $ Paren an $ App an y (toNamed "_hlint")++findExp name vs bod = [PatBind an (toNamed "warn") (UnGuardedRhs an $ InfixApp an lhs (toNamed "==>") rhs) Nothing]+    where+        lhs = g $ transform f bod+        rhs = apps $ Var an name : map snd rep++        rep = zip vs $ map (toNamed . return) ['a'..]+        f xx | Var_ x <- view xx, Just y <- lookup x rep = y+        f (InfixApp _ x dol y) | isDol dol = App an x (paren y)+        f x = x++        g o@(InfixApp _ _ _ x) | isAnyApp x || isAtom x = o+        g o@App{} = o+        g o = paren o

@@ -1,86 +1,40 @@ {-# LANGUAGE PatternGuards, ViewPatterns #-}  module Config.Haskell(-    findSettings, readSettings,-    readSettings2, readPragma, findSettings2, addInfix+    readPragma,+    readSetting,+    readFileConfigHaskell     ) where -import Data.Monoid import HSE.All-import Control.Monad.Extra import Data.Char-import Data.Either import Data.List.Extra-import System.FilePath import Config.Type import Util import Prelude  -getSeverity :: String -> Maybe Severity-getSeverity "ignore" = Just Ignore-getSeverity "warn" = Just Warning-getSeverity "warning" = Just Warning-getSeverity "suggest" = Just Suggestion-getSeverity "suggestion" = Just Suggestion-getSeverity "error" = Just Error-getSeverity "hint" = Just Suggestion-getSeverity _ = Nothing-- addInfix = parseFlagsAddFixities $ infix_ (-1) ["==>"]   --------------------------------------------------------------------- -- READ A SETTINGS FILE --- Given a list of hint files to start from--- Return the list of settings commands-readSettings2 :: FilePath -> [FilePath] -> [String] -> IO [Setting]-readSettings2 dataDir files hints = do-    (builtin,mods) <- fmap partitionEithers $ concatMapM (readHints dataDir) $ map Right files ++ map Left hints-    return $ map Builtin builtin ++ concatMap moduleSettings_ mods+readFileConfigHaskell :: FilePath -> Maybe String -> IO [Setting]+readFileConfigHaskell file contents = do+    let flags = addInfix defaultParseFlags+    res <- parseModuleEx flags file contents+    case res of+        Left (ParseError sl msg err) ->+            error $ "Config parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err+        Right (m, _) -> return $ readSettings m -moduleSettings_ :: Module_ -> [Setting]-moduleSettings_ m = concatMap (readSetting $ scopeCreate m) $ concatMap getEquations $-                       [AnnPragma l x | AnnModulePragma l x <- modulePragmas m] ++ moduleDecls m  -- | Given a module containing HLint settings information return the 'Classify' rules and the 'HintRule' expressions. --   Any fixity declarations will be discarded, but any other unrecognised elements will result in an exception.-readSettings :: Module_ -> ([Classify], [HintRule])-readSettings m = ([x | SettingClassify x <- xs], [x | SettingMatchExp x <- xs])-    where xs = moduleSettings_ m---readHints :: FilePath -> Either String FilePath -> IO [Either String Module_]-readHints datadir x = do-    (builtin,ms) <- case x of-        Left src -> findSettings datadir "CommandLine" (Just src)-        Right file -> findSettings datadir file Nothing-    return $ map Left builtin ++ map Right ms----- | Given the data directory (where the @hlint@ data files reside, see 'getHLintDataDir'),---   and a filename to read, and optionally that file's contents, produce a pair containing:------ 1. Builtin hints to use, e.g. @"List"@, which should be resolved using 'builtinHints'.------ 1. A list of modules containing hints, suitable for processing with 'readSettings'.------   Any parse failures will result in an exception.-findSettings :: FilePath -> FilePath -> Maybe String -> IO ([String], [Module_])-findSettings dataDir file contents = do-    let flags = addInfix defaultParseFlags-    res <- parseModuleEx flags file contents-    case res of-        Left (ParseError sl msg err) -> exitMessage $ "Parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err-        Right (m, _) -> do-            ys <- sequence [f $ fromNamed $ importModule i | i <- moduleImports m, importPkg i `elem` [Just "hint", Just "hlint"]]-            return $ concatUnzip $ ([],[m]) : ys-    where-        f x | Just x <- "HLint.Builtin." `stripPrefix` x = return ([x],[])-            | Just x <- "HLint." `stripPrefix` x = findSettings dataDir (dataDir </> x <.> "hs") Nothing-            | otherwise = findSettings dataDir (x <.> "hs") Nothing+readSettings :: Module_ -> [Setting]+readSettings m = concatMap (readSetting $ scopeCreate m) $ concatMap getEquations $+                       [AnnPragma l x | AnnModulePragma l x <- modulePragmas m] ++ moduleDecls m   readSetting :: Scope -> Decl_ -> [Setting]@@ -102,7 +56,8 @@ readSetting s x = errorOn x "bad hint"  --- return Nothing if it is not an HLint pragma, otherwise all the settings+-- | 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 :: Annotation S -> Maybe Classify readPragma o = case o of     Ann _ name x -> f (fromNamed name) x@@ -164,56 +119,7 @@   errorOn :: (Annotated ast, Pretty (ast S)) => ast S -> String -> b-errorOn val msg = exitMessage $+errorOn val msg = exitMessageImpure $     showSrcLoc (getPointLoc $ ann val) ++     ": Error while reading hint file, " ++ msg ++ "\n" ++     prettyPrint val--------------------------------------------------------------------------- FIND SETTINGS IN A SOURCE FILE---- find definitions in a source file-findSettings2 :: ParseFlags -> FilePath -> IO (String, [Setting])-findSettings2 flags file = do-    x <- parseModuleEx flags file Nothing-    case x of-        Left (ParseError sl msg _) ->-            return ("-- Parse error " ++ showSrcLoc sl ++ ": " ++ msg, [])-        Right (m, _) -> do-            let xs = concatMap (findSetting $ UnQual an) (moduleDecls m)-                s = unlines $ ["-- hints found in " ++ file] ++ map prettyPrint xs ++ ["-- no hints found" | null xs]-                r = concatMap (readSetting mempty) xs-            return (s,r)---findSetting :: (Name S -> QName S) -> Decl_ -> [Decl_]-findSetting qual (InstDecl _ _ _ (Just xs)) = concatMap (findSetting qual) [x | InsDecl _ x <- xs]-findSetting qual (PatBind _ (PVar _ name) (UnGuardedRhs _ bod) Nothing) = findExp (qual name) [] bod-findSetting qual (FunBind _ [InfixMatch _ p1 name ps rhs bind]) = findSetting qual $ FunBind an [Match an name (p1:ps) rhs bind]-findSetting qual (FunBind _ [Match _ name ps (UnGuardedRhs _ bod) Nothing]) = findExp (qual name) [] $ Lambda an ps bod-findSetting _ x@InfixDecl{} = [x]-findSetting _ _ = []----- given a result function name, a list of variables, a body expression, give some hints-findExp :: QName S -> [String] -> Exp_ -> [Decl_]-findExp name vs (Lambda _ ps bod) | length ps2 == length ps = findExp name (vs++ps2) bod-                                  | otherwise = []-    where ps2 = [x | PVar_ x <- map view ps]-findExp name vs Var{} = []-findExp name vs (InfixApp _ x dot y) | isDot dot = findExp name (vs++["_hlint"]) $ App an x $ Paren an $ App an y (toNamed "_hlint")--findExp name vs bod = [PatBind an (toNamed "warn") (UnGuardedRhs an $ InfixApp an lhs (toNamed "==>") rhs) Nothing]-    where-        lhs = g $ transform f bod-        rhs = apps $ Var an name : map snd rep--        rep = zip vs $ map (toNamed . return) ['a'..]-        f xx | Var_ x <- view xx, Just y <- lookup x rep = y-        f (InfixApp _ x dol y) | isDol dol = App an x (paren y)-        f x = x--        g o@(InfixApp _ _ _ x) | isAnyApp x || isAtom x = o-        g o@App{} = o-        g o = paren o

@@ -1,7 +1,8 @@  module Config.Type(     Severity(..), Classify(..), HintRule(..), Note(..), Setting(..),-    defaultHintName, isUnifyVar, showNotes,+    Restrict(..), RestrictType(..),+    defaultHintName, isUnifyVar, showNotes, getSeverity, getRestrictType     ) where  import HSE.All@@ -10,6 +11,23 @@ import Prelude  +getSeverity :: String -> Maybe Severity+getSeverity "ignore" = Just Ignore+getSeverity "warn" = Just Warning+getSeverity "warning" = Just Warning+getSeverity "suggest" = Just Suggestion+getSeverity "suggestion" = Just Suggestion+getSeverity "error" = Just Error+getSeverity "hint" = Just Suggestion+getSeverity _ = Nothing++getRestrictType :: String -> Maybe RestrictType+getRestrictType "modules" = Just RestrictModule+getRestrictType "extensions" = Just RestrictExtension+getRestrictType "flags" = Just RestrictFlag+getRestrictType "functions" = Just RestrictFunction+getRestrictType _ = Nothing+ defaultHintName :: String defaultHintName = "Use alternative" @@ -76,10 +94,21 @@     }     deriving Show +data RestrictType = RestrictModule | RestrictExtension | RestrictFlag | RestrictFunction deriving (Show,Eq,Ord)++data Restrict = Restrict+    {restrictType :: RestrictType+    ,restrictDefault :: Bool+    ,restrictName :: [String]+    ,restrictAs :: [String] -- for RestrictModule only, what you can import it as+    ,restrictWithin :: [(String, String)]+    } deriving Show+ data Setting     = SettingClassify Classify     | SettingMatchExp HintRule+    | SettingRestrict Restrict+    | SettingArgument String     | Builtin String -- use a builtin hint set     | Infix Fixity       deriving Show-

@@ -0,0 +1,289 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns, RecordWildCards, GeneralizedNewtypeDeriving, TupleSections #-}++module Config.Yaml(+    ConfigYaml,+    readFileConfigYaml,+    settingsFromConfigYaml+    ) where++import Config.Type+import Data.Yaml+import Data.Either+import Data.Maybe+import Data.List.Extra+import Data.Tuple.Extra+import Control.Monad.Extra+import Control.Exception.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 HSE.All hiding (Rule, String)+import Data.Functor+import Data.Monoid+import Prelude+++-- | Read a config file in YAML format. Takes a filename, and optionally the contents.+--   Fails if the YAML doesn't parse or isn't valid HLint YAML+readFileConfigYaml :: FilePath -> Maybe String -> IO ConfigYaml+readFileConfigYaml file contents = do+    val <- case contents of+        Nothing -> decodeFileEither file+        Just src -> return $ decodeEither' $ BS.pack src+    case val of+        Left e -> fail $ "Failed to read YAML configuration file " ++ file ++ "\n  " ++ displayException e+        Right v -> return v+++---------------------------------------------------------------------+-- YAML DATA TYPE++newtype ConfigYaml = ConfigYaml [ConfigItem] deriving (Monoid,Show)++data ConfigItem+    = ConfigPackage Package+    | ConfigGroup Group+    | ConfigSetting [Setting]+      deriving Show++data Package = Package+    {packageName :: String+    ,packageModules :: [ImportDecl S]+    } deriving Show++data Group = Group+    {groupName :: String+    ,groupEnabled :: Bool+    ,groupImports :: [Either String (ImportDecl S)] -- Left for package imports+    ,groupRules :: [Either HintRule Classify] -- HintRule has scope set to mempty+    } deriving Show+++---------------------------------------------------------------------+-- YAML PARSING LIBRARY++data Val = Val +    Value -- the actual value I'm focused on+    [(String, Value)] -- the path of values I followed (for error messages)++newVal :: Value -> Val+newVal x = Val x [("root", x)]++getVal :: Val -> Value+getVal (Val x _) = x++addVal :: String -> Value -> Val -> Val+addVal key v (Val focus path) = Val v $ (key,v) : path++-- | Failed when parsing some value, give an informative error message.+parseFail :: Val -> String -> Parser a+parseFail (Val focus path) msg = fail $+    "Error when decoding YAML, " ++ msg ++ "\n" +++    "Along path: " ++ unwords steps ++ "\n" +++    "When at: " ++ fst (word1 $ show focus) ++ "\n" +++    -- aim to show a smallish but relevant context+    dotDot (fromMaybe (encode focus) $ listToMaybe $ dropWhile (\x -> BS.length x > 250) $ map encode contexts)+    where+        (steps, contexts) = unzip $ reverse path+        dotDot x = let (a,b) = BS.splitAt 250 x in BS.unpack a ++ (if BS.null b then "" else "...")++parseArray :: Val -> Parser [Val]+parseArray v@(getVal -> Array xs) = concatMapM parseArray $ zipWith (\i x -> addVal (show i) x v) [0..] $ V.toList xs+parseArray v = return [v]++parseObject :: Val -> Parser (Map.HashMap T.Text Value)+parseObject (getVal -> Object x) = return x+parseObject v = parseFail v "Expected an Object"++parseObject1 :: Val -> Parser (String, Val)+parseObject1 v = do+    mp <- parseObject v+    case Map.keys mp of+        [T.unpack -> s] -> (s,) <$> parseField s v+        _ -> parseFail v $ "Expected exactly one key but got " ++ show (Map.size mp)++parseString :: Val -> Parser String+parseString (getVal -> String x) = return $ T.unpack x+parseString v = parseFail v "Expected a String"++parseArrayString :: Val -> Parser [String]+parseArrayString = parseArray >=> mapM parseString++parseBool :: Val -> Parser Bool+parseBool (getVal -> Bool b) = return b+parseBool v = parseFail v "Expected a Bool"++parseField :: String -> Val -> Parser Val+parseField s v = do+    x <- parseFieldOpt s v+    case x of+        Nothing -> parseFail v $ "Expected a field named " ++ s+        Just v -> return v++parseFieldOpt :: String -> Val -> Parser (Maybe Val)+parseFieldOpt s v = do+    mp <- parseObject v+    case Map.lookup (T.pack s) mp of+        Nothing -> return Nothing+        Just x -> return $ Just $ addVal s x v++allowFields :: Val -> [String] -> Parser ()+allowFields v allow = do+    mp <- parseObject v+    let bad = map T.unpack (Map.keys mp) \\ allow+    when (bad /= []) $+        parseFail v $ "Not allowed keys: " ++ unwords bad++parseHSE :: (String -> ParseResult v) -> Val -> Parser v+parseHSE parser v = do+    x <- parseString v+    case parser x of+        ParseOk x -> return x+        ParseFailed loc s -> parseFail v $ "Failed to parse " ++ s ++ ", when parsing:\n  " ++ x+++---------------------------------------------------------------------+-- YAML TO DATA TYPE++instance FromJSON ConfigYaml where+    parseJSON Null = return mempty+    parseJSON x = parseConfigYaml $ newVal x++parseConfigYaml :: Val -> Parser ConfigYaml+parseConfigYaml v = do+    vs <- parseArray v+    fmap ConfigYaml $ forM vs $ \o@v -> do+        (s, v) <- parseObject1 v+        case s of+            "package" -> ConfigPackage <$> parsePackage v+            "group" -> ConfigGroup <$> parseGroup v+            "arguments" -> ConfigSetting . map SettingArgument <$> parseArrayString v+            "fixity" -> ConfigSetting <$> parseFixity v+            _ | isJust $ getSeverity s -> ConfigGroup . ruleToGroup <$> parseRule o+            _ | Just r <- getRestrictType s -> ConfigSetting . map SettingRestrict <$> (parseArray v >>= mapM (parseRestrict r))+            _ -> parseFail v "Expecting an object with a 'package' or 'group' key, a hint or a restriction"++parsePackage :: Val -> Parser Package+parsePackage v = do+    packageName <- parseField "name" v >>= parseString+    packageModules <- parseField "modules" v >>= parseArray >>= mapM (parseHSE parseImportDecl)+    allowFields v ["name","modules"]+    return Package{..}++parseFixity :: Val -> Parser [Setting]+parseFixity v = parseArray v >>= concatMapM (parseHSE parseDecl >=> f)+    where+        f x@InfixDecl{} = return $ map Infix $ getFixity x+        f _ = parseFail v "Expected fixity declaration"++parseGroup :: Val -> Parser Group+parseGroup v = do+    groupName <- parseField "name" v >>= parseString+    groupEnabled <- parseFieldOpt "enabled" v >>= maybe (return True) parseBool+    groupImports <- parseFieldOpt "imports" v >>= maybe (return []) (parseArray >=> mapM parseImport)+    groupRules <- parseFieldOpt "rules" v >>= maybe (return []) parseArray >>= concatMapM parseRule+    allowFields v ["name","enabled","imports","rules"]+    return Group{..}+    where+        parseImport v = do+            x <- parseString v+            case word1 x of+                ("package", x) -> return $ Left x+                _ -> Right <$> parseHSE parseImportDecl v++ruleToGroup :: [Either HintRule Classify] -> Group+ruleToGroup = Group "" True []++parseRule :: Val -> Parser [Either HintRule Classify]+parseRule v = do+    (severity, v) <- parseSeverityKey v+    isRule <- isJust <$> parseFieldOpt "lhs" v+    if isRule then do+        hintRuleLHS <- parseField "lhs" v >>= parseHSE parseExp+        hintRuleRHS <- parseField "rhs" v >>= parseHSE parseExp+        hintRuleNotes <- parseFieldOpt "note" v >>= maybe (return []) (fmap (map asNote) . parseArrayString)+        hintRuleName <- parseFieldOpt "name" v >>= maybe (return $ guessName hintRuleLHS hintRuleRHS) parseString+        hintRuleSide <- parseFieldOpt "side" v >>= maybe (return Nothing) (fmap Just . parseHSE parseExp)+        allowFields v ["lhs","rhs","note","name","side"]+        let hintRuleScope = mempty+        return [Left HintRule{hintRuleSeverity=severity, ..}]+     else do+        names <- parseFieldOpt "name" v >>= maybe (return []) parseArrayString+        within <- parseFieldOpt "within" v >>= maybe (return [("","")]) (parseArray >=> concatMapM parseWithin)+        return [Right $ Classify severity n a b | (a,b) <- within, n <- ["" | null names] ++ names]++parseRestrict :: RestrictType -> Val -> Parser Restrict+parseRestrict restrictType v = do+    def <- parseFieldOpt "default" v+    case def of+        Just def -> do+            b <- parseBool def+            allowFields v ["default"]+            return $ Restrict restrictType b [] [] []+        Nothing -> do+            restrictName <- parseFieldOpt "name" v >>= maybe (return []) parseArrayString+            restrictWithin <- parseFieldOpt "within" v >>= maybe (return [("","")]) (parseArray >=> concatMapM parseWithin)+            restrictAs <- parseFieldOpt "as" v >>= maybe (return []) parseArrayString+            allowFields v $ ["as" | restrictType == RestrictModule] ++ ["name","within"]+            return Restrict{restrictDefault=True,..}++parseWithin :: Val -> Parser [(String, String)] -- (module, decl)+parseWithin v = do+    x <- parseHSE parseExp v+    case x of+        Var _ (UnQual _ name) -> return [("",fromNamed name)]+        Var _ (Qual _ (ModuleName _ mod) name) -> return [(mod, fromNamed name)]+        Con _ (UnQual _ name) -> return [(fromNamed name,""),("",fromNamed name)]+        Con _ (Qual _ (ModuleName _ mod) name) -> return [(mod ++ "." ++ fromNamed name,""),(mod,fromNamed name)]+        _ -> parseFail v "Bad classification rule"++parseSeverityKey :: Val -> Parser (Severity, Val)+parseSeverityKey v = do+    (s, v) <- parseObject1 v+    case getSeverity s of+        Just sev -> return (sev, v)+        _ -> parseFail v $ "Key should be a severity (e.g. warn/error/suggest) but got " ++ s+++guessName :: Exp_ -> Exp_ -> String+guessName lhs rhs+    | n:_ <- rs \\ ls = "Use " ++ n+    | n:_ <- ls \\ rs = "Redundant " ++ n+    | otherwise = defaultHintName+    where+        (ls, rs) = both f (lhs, rhs)+        f = filter (not . isUnifyVar) . map (\x -> fromNamed (x :: Name S)) . childrenS+++asNote :: String -> Note+asNote "IncreasesLaziness" = IncreasesLaziness+asNote "DecreasesLaziness" = DecreasesLaziness+asNote (word1 -> ("RemovesError",x)) = RemovesError x+asNote (word1 -> ("ValidInstance",x)) = uncurry ValidInstance $ word1 x+asNote x = Note x+++---------------------------------------------------------------------+-- SETTINGS++settingsFromConfigYaml :: [ConfigYaml] -> [Setting]+settingsFromConfigYaml (mconcat -> ConfigYaml configs) = settings ++ concatMap f groups+    where+        packages = [x | ConfigPackage x <- configs]+        groups = [x | ConfigGroup x <- configs]+        settings = concat [x | ConfigSetting x <- configs]+        packageMap = Map.fromListWith (++) [(packageName, packageModules) | Package{..} <- packages]+        groupMap = Map.fromListWith (\new old -> new) [(groupName, groupEnabled) | Group{..} <- groups]++        f Group{..}+            | Map.lookup groupName groupMap == Just False = []+            | otherwise = map (either (\r -> SettingMatchExp r{hintRuleScope=scope}) SettingClassify) groupRules+            where scope = asScope packageMap groupImports++asScope :: Map.HashMap String [ImportDecl S] -> [Either String (ImportDecl S)] -> Scope+asScope packages xs = scopeCreate $ Module an Nothing [] (concatMap f xs) []+    where+        f (Right x) = [x]+        f (Left x) | Just pkg <- Map.lookup x packages = pkg+                   | otherwise = error $ "asScope failed to do lookup, " ++ x

@@ -1,7 +1,9 @@  module Grep(runGrep) where -import Language.Haskell.HLint2+import Hint.All+import Apply+import Config.Type import HSE.All import Control.Monad import Data.List

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, ViewPatterns #-}+{-# LANGUAGE RecordWildCards, TupleSections #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}  module HLint(hlint) where@@ -15,22 +15,23 @@ import Data.Tuple.Extra import Prelude -import Data.Version+import Data.Version.Extra import System.Process.Extra import Data.Maybe import System.Directory-import Text.ParserCombinators.ReadP+import System.FilePath  import CmdLine+import Config.All import Config.Type-import Config.Haskell+import Config.Compute import Report import Idea import Apply import Test.All+import Hint.All import Grep import Test.Proof-import Util import Parallel import HSE.All @@ -51,7 +52,7 @@ hlint args = do     cmd <- getCmd args     case cmd of-        CmdMain{} -> do xs <- hlintMain cmd; return $ if cmdNoExitCode cmd then [] else xs+        CmdMain{} -> do xs <- hlintMain args cmd; return $ if cmdNoExitCode cmd then [] else xs         CmdGrep{} -> hlintGrep cmd >> return []         CmdHSE{}  -> hlintHSE  cmd >> return []         CmdTest{} -> hlintTest cmd >> return []@@ -62,6 +63,8 @@     forM_ cmdFiles $ \x -> do         putStrLn $ "Parse result of " ++ x ++ ":"         let (lang,exts) = cmdExtensions c+        -- We deliberately don't use HSE.All here to avoid any bugs in HLint+        -- polluting our bug reports (which is the main use of HSE)         res <- parseFileWithMode defaultParseMode{baseLanguage=lang, extensions=exts} x         case res of             x@ParseFailed{} -> print x@@ -75,18 +78,18 @@ hlintTest cmd@CmdTest{..} =     if not $ null cmdProof then do         files <- cmdHintFiles cmd-        s <- readSettings2 cmdDataDir files []+        s <- readFilesConfig $ map (,Nothing) files         let reps = if cmdReports == ["report.html"] then ["report.txt"] else cmdReports         mapM_ (proof reps s) cmdProof      else do         failed <- test cmd (\args -> do errs <- hlint args; unless (null errs) $ exitWith $ ExitFailure 1) cmdDataDir cmdGivenHints         when (failed > 0) exitFailure +cmdParseFlags :: Cmd -> ParseFlags+cmdParseFlags cmd = parseFlagsSetLanguage (cmdExtensions cmd) $ defaultParseFlags{cppFlags=cmdCpp cmd}+ hlintGrep :: Cmd -> IO ()-hlintGrep cmd@CmdGrep{..} = do-    encoding <- if cmdUtf8 then return utf8 else readEncoding cmdEncoding-    let flags = parseFlagsSetLanguage (cmdExtensions cmd) $-                defaultParseFlags{cppFlags=cmdCpp cmd, encoding=encoding}+hlintGrep cmd@CmdGrep{..} =     if null cmdFiles then         exitWithHelp      else do@@ -94,63 +97,67 @@         if null files then             error "No files found"          else-            runGrep cmdPattern flags files+            runGrep cmdPattern (cmdParseFlags cmd) files -hlintMain :: Cmd -> IO [Idea]-hlintMain cmd@CmdMain{..} = do-    encoding <- if cmdUtf8 then return utf8 else readEncoding cmdEncoding-    let flags = parseFlagsSetLanguage (cmdExtensions cmd) $-                defaultParseFlags{cppFlags=cmdCpp cmd, encoding=encoding}-    if null cmdFiles && not (null cmdFindHints) then do+hlintMain :: [String] -> Cmd -> IO [Idea]+hlintMain args cmd@CmdMain{..}+    | cmdDefault = do+        putStr =<< readFile (cmdDataDir </> "default.yaml")+        return []+    | null cmdFiles && not (null cmdFindHints) = do         hints <- concatMapM (resolveFile cmd Nothing) cmdFindHints-        mapM_ (putStrLn . fst <=< findSettings2 flags) hints >> return []-     else if null cmdFiles then+        mapM_ (putStrLn . fst <=< computeSettings (cmdParseFlags cmd)) hints >> return []+    | null cmdFiles =         exitWithHelp-     else if cmdRefactor then-         withTempFile (\t ->  runHlintMain cmd (Just t) flags)-     else runHlintMain cmd Nothing flags+    | cmdRefactor =+        withTempFile $ runHlintMain args cmd . Just+    | otherwise =+        runHlintMain args cmd Nothing -runHlintMain :: Cmd -> Maybe FilePath -> ParseFlags -> IO [Idea]-runHlintMain cmd@CmdMain{..} fp flags = do+runHlintMain :: [String] -> Cmd -> Maybe FilePath -> IO [Idea]+runHlintMain args cmd@CmdMain{..} fp = do   files <- concatMapM (resolveFile cmd fp) cmdFiles   if null files       then error "No files found"-      else runHints cmd{cmdFiles=files} flags+      else runHints args cmd{cmdFiles=files} -{-# ANN readAllSettings "HLint: ignore Use let" #-}-readAllSettings :: Cmd -> ParseFlags -> IO [Setting]-readAllSettings cmd@CmdMain{..} flags = do+readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting])+readAllSettings args1 cmd@CmdMain{..} = do     files <- cmdHintFiles cmd-    settings1 <- readSettings2 cmdDataDir files cmdWithHints-    settings2 <- concatMapM (fmap snd . findSettings2 flags) cmdFindHints+    settings1 <- readFilesConfig $ map (,Nothing) files ++ [("CommandLine.hs",Just x) | x <- cmdWithHints]+    let args2 = [x | SettingArgument x <- settings1]+    cmd@CmdMain{..} <- if null args2 then return cmd else getCmd $ args1 ++ args2+    settings2 <- concatMapM (fmap snd . computeSettings (cmdParseFlags cmd)) cmdFindHints     settings3 <- return [SettingClassify $ Classify Ignore x "" "" | x <- cmdIgnore]-    return $ settings1 ++ settings2 ++ settings3+    return (cmd, settings1 ++ settings2 ++ settings3)  -runHints :: Cmd -> ParseFlags -> IO [Idea]-runHints cmd@CmdMain{..} flags = do+runHints :: [String] -> Cmd -> IO [Idea]+runHints args cmd@CmdMain{..} = do+    (cmd@CmdMain{..}, settings) <- readAllSettings args cmd     j <- if cmdThreads == 0 then getNumProcessors else return cmdThreads     withNumCapabilities j $ do         let outStrLn = whenNormal . putStrLn-        settings <- readAllSettings cmd flags-        ideas <- getIdeas cmd settings flags-        let (showideas,hideideas) = partition (\i -> cmdShowAll || ideaSeverity i /= Ignore) ideas+        ideas <- getIdeas cmd settings+        ideas <- return $ if cmdShowAll then ideas else  filter (\i -> ideaSeverity i /= Ignore) ideas         if cmdJson then-            putStrLn $ showIdeasJson showideas+            putStrLn $ showIdeasJson ideas          else if cmdSerialise then do             hSetBuffering stdout NoBuffering-            print $ map (show &&& ideaRefactoring) showideas+            print $ map (show &&& ideaRefactoring) ideas          else if cmdRefactor then-            handleRefactoring showideas cmdFiles cmd+            handleRefactoring ideas cmdFiles cmd          else do             usecolour <- cmdUseColour cmd             showItem <- if usecolour then showANSI else return show-            mapM_ (outStrLn . showItem) showideas-            handleReporting showideas hideideas cmd-        return showideas+            mapM_ (outStrLn . showItem) ideas+            handleReporting ideas cmd+        return ideas -getIdeas :: Cmd -> [Setting] -> ParseFlags -> IO [Idea]-getIdeas cmd@CmdMain{..} settings flags = do+getIdeas :: Cmd -> [Setting] -> IO [Idea]+getIdeas cmd@CmdMain{..} settings = do+    settings <- return $ settings ++ map (Builtin . fst) builtinHints+    let flags = cmdParseFlags cmd     ideas <- if cmdCross         then applyHintFiles flags settings cmdFiles         else concat <$> parallel cmdThreads [evaluateList =<< applyHintFile flags settings x Nothing | x <- cmdFiles]@@ -159,21 +166,21 @@         else ideas  handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()-handleRefactoring showideas files cmd@CmdMain{..} =+handleRefactoring ideas files cmd@CmdMain{..} =     case cmdFiles of         [file] -> do             -- Ensure that we can find the executable             path <- checkRefactor (if cmdWithRefactor == "" then Nothing else Just cmdWithRefactor)             -- writeFile "hlint.refact"-            let hints =  show $ map (show &&& ideaRefactoring) showideas+            let hints =  show $ map (show &&& ideaRefactoring) ideas             withTempFile $ \f -> do                 writeFile f hints                 exitWith =<< runRefactoring path file f cmdRefactorOptions         _ -> error "Refactor flag can only be used with an individual file"  -handleReporting :: [Idea] -> [Idea] -> Cmd -> IO ()-handleReporting showideas hideideas cmd@CmdMain{..} = do+handleReporting :: [Idea] -> Cmd -> IO ()+handleReporting showideas cmd@CmdMain{..} = do     let outStrLn = whenNormal . putStrLn     if null showideas then         when (cmdReports /= []) $ outStrLn "Skipping writing reports"@@ -181,10 +188,9 @@         forM_ cmdReports $ \x -> do             outStrLn $ "Writing report to " ++ x ++ " ..."             writeReport cmdDataDir x showideas-    unless cmdNoSummary $-        outStrLn $-            (let i = length showideas in if i == 0 then "No hints" else show i ++ " hint" ++ ['s' | i/=1]) ++-            (let i = length hideideas in if i == 0 then "" else " (" ++ show i ++ " ignored)")+    unless cmdNoSummary $ do+        let n = length showideas+        outStrLn $ if n == 0 then "No hints" else show n ++ " hint" ++ ['s' | n/=1]  runRefactoring :: FilePath -> FilePath -> FilePath -> String -> IO ExitCode runRefactoring rpath fin hints opts =  do@@ -201,13 +207,10 @@     mexc <- findExecutable excPath     case mexc of         Just exc ->  do-            vers <- readP_to_S parseVersion . tail <$> readProcess exc ["--version"] ""-            case vers of-                [] -> putStrLn "Unabled to determine version of refactor" >> return exc-                (last -> (version, _)) ->-                    if versionBranch version >= [0,1,0,0]-                        then return exc-                        else error "Your version of refactor is too old, please upgrade to the latest version"+            ver <- readVersion . tail <$> readProcess exc ["--version"] ""+            if versionBranch ver >= [0,1,0,0]+                then return exc+                else error "Your version of refactor is too old, please upgrade to the latest version"         Nothing -> error $ unlines [ "Could not find refactor", "Tried with: " ++ excPath ]  evaluateList :: [a] -> IO [a]

@@ -21,21 +21,20 @@ import Data.Maybe import Language.Preprocessor.Cpphs import qualified Data.Map as Map-import System.IO+import System.IO.Extra import Data.Functor import Prelude   -- | Created with 'defaultParseFlags', used by 'parseModuleEx'. data ParseFlags = ParseFlags-    {encoding :: TextEncoding -- ^ How the file is read in (defaults to 'utf8').-    ,cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').+    {cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').     ,hseFlags :: ParseMode -- ^ How the file is parsed (defaults to all fixities in the @base@ package and most non-conflicting extensions).     }  -- | Default value for 'ParseFlags'. defaultParseFlags :: ParseFlags-defaultParseFlags = ParseFlags utf8 NoCpp+defaultParseFlags = ParseFlags NoCpp     defaultParseMode{fixities=Just baseFixities, ignoreLinePragmas=False, ignoreFunctionArity=True, extensions=defaultExtensions}  parseFlagsNoLocations :: ParseFlags -> ParseFlags@@ -75,7 +74,7 @@ --   The filename @-@ is treated as @stdin@. Requires some flags (often 'defaultParseFlags'), the filename, and optionally the contents of that file. parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError (Module_, [Comment])) parseModuleEx flags file str = do-        str <- maybe (readFileEncoding' (encoding flags) file) return str+        str <- maybe (readFileUTF8' file) return str         str <- return $ fromMaybe str $ stripPrefix "\65279" str -- remove the BOM if it exists, see #130         ppstr <- runCpp (cppFlags flags) file str         case parseFileContentsWithComments (mode flags) ppstr of

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE PatternGuards, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns -fno-warn-incomplete-patterns #-}  module HSE.Bracket(

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}  module HSE.FreeVars(FreeVars, freeVars, vars, varss, pvars) where 

@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns, MultiParamTypeClasses, FlexibleInstances #-}  module HSE.Match(     View(..), Named(..),

@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns #-}  module HSE.Scope(     Scope, scopeCreate, scopeImports,@@ -64,14 +65,14 @@ -- | Given a name in a scope, and a new scope, create a name for the new scope that will refer --   to the same thing. If the resulting name is ambiguous, it picks a plausible candidate. scopeMove :: (Scope, QName S) -> Scope -> QName S-scopeMove (a, x) (Scope b)-    | isSpecial x = x+scopeMove (a, x@(fromQual -> Just name)) (Scope b)     | null imps = head $ real ++ [x]     | any (not . importQualified) imps = unqual x-    | otherwise = Qual an (head $ mapMaybe importAs imps ++ map importModule imps) $ fromQual x+    | otherwise = Qual an (head $ mapMaybe importAs imps ++ map importModule imps) name     where-        real = [Qual an (ModuleName an m) $ fromQual x | m <- possModules a x]+        real = [Qual an (ModuleName an m) name | m <- possModules a x]         imps = [i | r <- real, i <- b, possImport i r]+scopeMove (_, x) _ = x   -- which modules could a name possibly lie in

@@ -1,10 +1,15 @@ -module HSE.Type(module HSE.Type, module Export) where+module HSE.Type(+    S,+    Module_, Decl_, Exp_, Pat_, Type_,+    module HSE,+    module Uniplate+    ) where  -- Almost all from the Annotated module, but the fixity resolution from Annotated -- uses the unannotated Assoc enumeration, so export that instead-import Language.Haskell.Exts as Export hiding (parse, loc, paren)-import Data.Generics.Uniplate.Data as Export+import Language.Haskell.Exts as HSE hiding (parse, loc, paren)+import Data.Generics.Uniplate.Data as Uniplate  type S = SrcSpanInfo type Module_ = Module S@@ -12,668 +17,3 @@ type Exp_ = Exp S type Pat_ = Pat S type Type_ = Type S---{-!-deriving instance UniplateDirect (Pat S) (Pat S)-deriving instance UniplateDirect (Exp S)-deriving instance UniplateDirect (Pat S)-deriving instance UniplateDirect (Pat S) (Exp S)-deriving instance UniplateDirect (Binds S) (Exp S)-deriving instance UniplateDirect (Alt S) (Exp S)-deriving instance UniplateDirect (Stmt S) (Exp S)-deriving instance UniplateDirect (QualStmt S) (Exp S)-deriving instance UniplateDirect [QualStmt S] (Exp S)-deriving instance UniplateDirect (Bracket S) (Exp S)-deriving instance UniplateDirect (Splice S) (Exp S)-deriving instance UniplateDirect (XAttr S) (Exp S)-deriving instance UniplateDirect (Maybe (Exp S)) (Exp S)-deriving instance UniplateDirect (FieldUpdate S) (Exp S)-deriving instance UniplateDirect (PatField S) (Pat S)-deriving instance UniplateDirect (Exp S) (Pat S)-deriving instance UniplateDirect (RPat S) (Pat S)-deriving instance UniplateDirect (PXAttr S) (Pat S)-deriving instance UniplateDirect (Maybe (Pat S)) (Pat S)-deriving instance UniplateDirect (PatField S) (Exp S)-deriving instance UniplateDirect (RPat S) (Exp S)-deriving instance UniplateDirect (PXAttr S) (Exp S)-deriving instance UniplateDirect (Maybe (Pat S)) (Exp S)-deriving instance UniplateDirect (Decl S) (Exp S)-deriving instance UniplateDirect (IPBind S) (Exp S)-deriving instance UniplateDirect (GuardedAlts S) (Exp S)-deriving instance UniplateDirect (Maybe (Binds S)) (Exp S)-deriving instance UniplateDirect (Maybe (Exp S)) (Exp S)-deriving instance UniplateDirect (FieldUpdate S) (Exp S)-deriving instance UniplateDirect (PatField S) (Pat S)-deriving instance UniplateDirect (Exp S) (Pat S)-deriving instance UniplateDirect (RPat S) (Pat S)-deriving instance UniplateDirect (PXAttr S) (Pat S)-deriving instance UniplateDirect (Maybe (Pat S)) (Pat S)-deriving instance UniplateDirect (PatField S) (Exp S)-deriving instance UniplateDirect (RPat S) (Exp S)-deriving instance UniplateDirect (PXAttr S) (Exp S)-deriving instance UniplateDirect (Maybe (Pat S)) (Exp S)-deriving instance UniplateDirect (Decl S) (Exp S)-deriving instance UniplateDirect (IPBind S) (Exp S)-deriving instance UniplateDirect (GuardedAlts S) (Exp S)-deriving instance UniplateDirect (Maybe (Binds S)) (Exp S)-deriving instance UniplateDirect (Binds S) (Pat S)-deriving instance UniplateDirect (Alt S) (Pat S)-deriving instance UniplateDirect (Stmt S) (Pat S)-deriving instance UniplateDirect (Maybe (Exp S)) (Pat S)-deriving instance UniplateDirect (FieldUpdate S) (Pat S)-deriving instance UniplateDirect (QualStmt S) (Pat S)-deriving instance UniplateDirect [QualStmt S] (Pat S)-deriving instance UniplateDirect (Bracket S) (Pat S)-deriving instance UniplateDirect (Splice S) (Pat S)-deriving instance UniplateDirect (XAttr S) (Pat S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Exp S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Exp S)-deriving instance UniplateDirect (Match S) (Exp S)-deriving instance UniplateDirect (Rhs S) (Exp S)-deriving instance UniplateDirect (Rule S) (Exp S)-deriving instance UniplateDirect (GuardedAlt S) (Exp S)-deriving instance UniplateDirect (Decl S) (Pat S)-deriving instance UniplateDirect (IPBind S) (Pat S)-deriving instance UniplateDirect (GuardedAlts S) (Pat S)-deriving instance UniplateDirect (Maybe (Binds S)) (Pat S)-deriving instance UniplateDirect (ClassDecl S) (Exp S)-deriving instance UniplateDirect (InstDecl S) (Exp S)-deriving instance UniplateDirect (GuardedRhs S) (Exp S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Pat S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Pat S)-deriving instance UniplateDirect (Match S) (Pat S)-deriving instance UniplateDirect (Rhs S) (Pat S)-deriving instance UniplateDirect (Rule S) (Pat S)-deriving instance UniplateDirect (GuardedAlt S) (Pat S)-deriving instance UniplateDirect (ClassDecl S) (Pat S)-deriving instance UniplateDirect (InstDecl S) (Pat S)-deriving instance UniplateDirect (GuardedRhs S) (Pat S)-deriving instance UniplateDirect (Maybe (Binds S)) (Decl S)-deriving instance UniplateDirect (Exp S) (Name S)-deriving instance UniplateDirect (Decl S)-deriving instance UniplateDirect (Binds S) (Decl S)-deriving instance UniplateDirect (Name S)-deriving instance UniplateDirect (QName S) (Name S)-deriving instance UniplateDirect (QOp S) (Name S)-deriving instance UniplateDirect (Pat S) (Name S)-deriving instance UniplateDirect (Binds S) (Name S)-deriving instance UniplateDirect (Alt S) (Name S)-deriving instance UniplateDirect (Stmt S) (Name S)-deriving instance UniplateDirect (Maybe (Exp S)) (Name S)-deriving instance UniplateDirect (FieldUpdate S) (Name S)-deriving instance UniplateDirect (QualStmt S) (Name S)-deriving instance UniplateDirect [QualStmt S] (Name S)-deriving instance UniplateDirect (Type S) (Name S)-deriving instance UniplateDirect (Bracket S) (Name S)-deriving instance UniplateDirect (Splice S) (Name S)-deriving instance UniplateDirect (XAttr S) (Name S)-deriving instance UniplateDirect (Decl S) (Name S)-deriving instance UniplateDirect (Exp S) (Decl S)-deriving instance UniplateDirect (GuardedAlts S) (Name S)-deriving instance UniplateDirect (IPBind S) (Decl S)-deriving instance UniplateDirect (IPBind S) (Name S)-deriving instance UniplateDirect (Kind S) (Name S)-deriving instance UniplateDirect (Match S) (Decl S)-deriving instance UniplateDirect (Maybe (Binds S)) (Name S)-deriving instance UniplateDirect (Maybe (Context S)) (Name S)-deriving instance UniplateDirect (Maybe (Pat S)) (Name S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Decl S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Decl S)-deriving instance UniplateDirect (Maybe [TyVarBind S]) (Name S)-deriving instance UniplateDirect (PXAttr S) (Name S)-deriving instance UniplateDirect (Pat S) (Decl S)-deriving instance UniplateDirect (PatField S) (Name S)-deriving instance UniplateDirect (RPat S) (Name S)-deriving instance UniplateDirect (Rhs S) (Decl S)-deriving instance UniplateDirect (Rule S) (Decl S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Name S)-deriving instance UniplateDirect (InstHead S) (Name S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Name S)-deriving instance UniplateDirect (Op S) (Name S)-deriving instance UniplateDirect (Match S) (Name S)-deriving instance UniplateDirect (Maybe (Type S)) (Name S)-deriving instance UniplateDirect (Rhs S) (Name S)-deriving instance UniplateDirect (Rule S) (Name S)-deriving instance UniplateDirect ([Name S], String) (Name S)-deriving instance UniplateDirect (Alt S) (Decl S)-deriving instance UniplateDirect (Stmt S) (Decl S)-deriving instance UniplateDirect (Maybe (Exp S)) (Decl S)-deriving instance UniplateDirect (FieldUpdate S) (Decl S)-deriving instance UniplateDirect (QualStmt S) (Decl S)-deriving instance UniplateDirect [QualStmt S] (Decl S)-deriving instance UniplateDirect (Bracket S) (Decl S)-deriving instance UniplateDirect (Splice S) (Decl S)-deriving instance UniplateDirect (XAttr S) (Decl S)-deriving instance UniplateDirect (GuardedAlt S) (Name S)-deriving instance UniplateDirect (Context S) (Name S)-deriving instance UniplateDirect (ClassDecl S) (Decl S)-deriving instance UniplateDirect (InstDecl S) (Decl S)-deriving instance UniplateDirect (TyVarBind S) (Name S)-deriving instance UniplateDirect (PatField S) (Decl S)-deriving instance UniplateDirect (RPat S) (Decl S)-deriving instance UniplateDirect (PXAttr S) (Decl S)-deriving instance UniplateDirect (Maybe (Pat S)) (Decl S)-deriving instance UniplateDirect (GuardedRhs S) (Decl S)-deriving instance UniplateDirect (DeclHead S) (Name S)-deriving instance UniplateDirect (Maybe (Kind S)) (Name S)-deriving instance UniplateDirect (QualConDecl S) (Name S)-deriving instance UniplateDirect (Maybe (Deriving S)) (Name S)-deriving instance UniplateDirect (GadtDecl S) (Name S)-deriving instance UniplateDirect (FunDep S) (Name S)-deriving instance UniplateDirect (ClassDecl S) (Name S)-deriving instance UniplateDirect (InstDecl S) (Name S)-deriving instance UniplateDirect (GuardedRhs S) (Name S)-deriving instance UniplateDirect (Maybe [RuleVar S]) (Name S)-deriving instance UniplateDirect (GuardedAlts S) (Decl S)-deriving instance UniplateDirect (Asst S) (Name S)-deriving instance UniplateDirect (ConDecl S) (Name S)-deriving instance UniplateDirect (Deriving S) (Name S)-deriving instance UniplateDirect (RuleVar S) (Name S)-deriving instance UniplateDirect (GuardedAlt S) (Decl S)-deriving instance UniplateDirect (BangType S) (Name S)-deriving instance UniplateDirect (FieldDecl S) (Name S)-deriving instance UniplateDirect (Module S) (FunDep S)-deriving instance UniplateDirect (Module S) (IPName S)-deriving instance UniplateDirect (Module S) (Decl S)-deriving instance UniplateDirect (Module S) (Kind S)-deriving instance UniplateDirect (Module S) (Pat S)-deriving instance UniplateDirect (Module S) (CallConv S)-deriving instance UniplateDirect (Module S) (GuardedRhs S)-deriving instance UniplateDirect (Module S) (GuardedAlt S)-deriving instance UniplateDirect (Module S) (PatField S)-deriving instance UniplateDirect (Module S) Boxed-deriving instance UniplateDirect (Module S) (ImportDecl S)-deriving instance UniplateDirect (Module S) (Exp S)-deriving instance UniplateDirect (Module S) (QualStmt S)-deriving instance UniplateDirect (Exp S) (CallConv S)-deriving instance UniplateDirect (GuardedRhs S)-deriving instance UniplateDirect (Decl S) (GuardedRhs S)-deriving instance UniplateDirect (XAttr S) (GuardedRhs S)-deriving instance UniplateDirect (Maybe (Exp S)) (GuardedRhs S)-deriving instance UniplateDirect (Exp S) (GuardedRhs S)-deriving instance UniplateDirect (GuardedAlt S)-deriving instance UniplateDirect (Decl S) (GuardedAlt S)-deriving instance UniplateDirect (XAttr S) (GuardedAlt S)-deriving instance UniplateDirect (Maybe (Exp S)) (GuardedAlt S)-deriving instance UniplateDirect (Exp S) (GuardedAlt S)-deriving instance UniplateDirect (PatField S)-deriving instance UniplateDirect (Decl S) (PatField S)-deriving instance UniplateDirect (XAttr S) (PatField S)-deriving instance UniplateDirect (Maybe (Exp S)) (PatField S)-deriving instance UniplateDirect (Exp S) (PatField S)-deriving instance UniplateDirect Boxed-deriving instance UniplateDirect (Maybe (ModuleHead S)) Boxed-deriving instance UniplateDirect (Decl S) Boxed-deriving instance UniplateDirect (XAttr S) Boxed-deriving instance UniplateDirect (Maybe (Exp S)) Boxed-deriving instance UniplateDirect (Exp S) Boxed-deriving instance UniplateDirect (ImportDecl S)-deriving instance UniplateDirect (QualStmt S)-deriving instance UniplateDirect (Decl S) (QualStmt S)-deriving instance UniplateDirect (XAttr S) (QualStmt S)-deriving instance UniplateDirect (Maybe (Exp S)) (QualStmt S)-deriving instance UniplateDirect (Exp S) (QualStmt S)-deriving instance UniplateDirect (Maybe (Type S)) Boxed-deriving instance UniplateDirect (Rhs S) Boxed-deriving instance UniplateDirect (Maybe (Binds S)) Boxed-deriving instance UniplateDirect (Rule S) Boxed-deriving instance UniplateDirect (QName S) Boxed-deriving instance UniplateDirect (QOp S) Boxed-deriving instance UniplateDirect (Binds S) Boxed-deriving instance UniplateDirect (Alt S) Boxed-deriving instance UniplateDirect (Stmt S) Boxed-deriving instance UniplateDirect (FieldUpdate S) Boxed-deriving instance UniplateDirect (QualStmt S) Boxed-deriving instance UniplateDirect [QualStmt S] Boxed-deriving instance UniplateDirect (Bracket S) Boxed-deriving instance UniplateDirect (Splice S) Boxed-deriving instance UniplateDirect (Stmt S) (QualStmt S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (QualStmt S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (QualStmt S)-deriving instance UniplateDirect (Match S) (QualStmt S)-deriving instance UniplateDirect (Pat S) (QualStmt S)-deriving instance UniplateDirect (Rhs S) (QualStmt S)-deriving instance UniplateDirect (Maybe (Binds S)) (QualStmt S)-deriving instance UniplateDirect (Rule S) (QualStmt S)-deriving instance UniplateDirect (Binds S) (QualStmt S)-deriving instance UniplateDirect (Alt S) (QualStmt S)-deriving instance UniplateDirect (FieldUpdate S) (QualStmt S)-deriving instance UniplateDirect [QualStmt S] (QualStmt S)-deriving instance UniplateDirect (Bracket S) (QualStmt S)-deriving instance UniplateDirect (Splice S) (QualStmt S)-deriving instance UniplateDirect (FunDep S)-deriving instance UniplateDirect (Decl S) (FunDep S)-deriving instance UniplateDirect (XAttr S) (FunDep S)-deriving instance UniplateDirect (Maybe (Exp S)) (FunDep S)-deriving instance UniplateDirect (Exp S) (FunDep S)-deriving instance UniplateDirect (IPName S)-deriving instance UniplateDirect (Decl S) (IPName S)-deriving instance UniplateDirect (XAttr S) (IPName S)-deriving instance UniplateDirect (Maybe (Exp S)) (IPName S)-deriving instance UniplateDirect (Exp S) (IPName S)-deriving instance UniplateDirect (Kind S)-deriving instance UniplateDirect (Decl S) (Kind S)-deriving instance UniplateDirect (XAttr S) (Kind S)-deriving instance UniplateDirect (Maybe (Exp S)) (Kind S)-deriving instance UniplateDirect (Exp S) (Kind S)-deriving instance UniplateDirect (CallConv S)-deriving instance UniplateDirect (Decl S) (CallConv S)-deriving instance UniplateDirect (XAttr S) (CallConv S)-deriving instance UniplateDirect (Maybe (Exp S)) (CallConv S)-deriving instance UniplateDirect (CallConv S)-deriving instance UniplateDirect (Pat S) (CallConv S)-deriving instance UniplateDirect (Binds S) (CallConv S)-deriving instance UniplateDirect (Alt S) (CallConv S)-deriving instance UniplateDirect (Stmt S) (CallConv S)-deriving instance UniplateDirect (FieldUpdate S) (CallConv S)-deriving instance UniplateDirect (QualStmt S) (CallConv S)-deriving instance UniplateDirect [QualStmt S] (CallConv S)-deriving instance UniplateDirect (Bracket S) (CallConv S)-deriving instance UniplateDirect (Splice S) (CallConv S)-deriving instance UniplateDirect (Stmt S) (GuardedRhs S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (GuardedRhs S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (GuardedRhs S)-deriving instance UniplateDirect (Match S) (GuardedRhs S)-deriving instance UniplateDirect (Pat S) (GuardedRhs S)-deriving instance UniplateDirect (Rhs S) (GuardedRhs S)-deriving instance UniplateDirect (Maybe (Binds S)) (GuardedRhs S)-deriving instance UniplateDirect (Rule S) (GuardedRhs S)-deriving instance UniplateDirect (Binds S) (GuardedRhs S)-deriving instance UniplateDirect (Alt S) (GuardedRhs S)-deriving instance UniplateDirect (FieldUpdate S) (GuardedRhs S)-deriving instance UniplateDirect (QualStmt S) (GuardedRhs S)-deriving instance UniplateDirect [QualStmt S] (GuardedRhs S)-deriving instance UniplateDirect (Bracket S) (GuardedRhs S)-deriving instance UniplateDirect (Splice S) (GuardedRhs S)-deriving instance UniplateDirect (Stmt S) (GuardedAlt S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (GuardedAlt S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (GuardedAlt S)-deriving instance UniplateDirect (Match S) (GuardedAlt S)-deriving instance UniplateDirect (Pat S) (GuardedAlt S)-deriving instance UniplateDirect (Rhs S) (GuardedAlt S)-deriving instance UniplateDirect (Maybe (Binds S)) (GuardedAlt S)-deriving instance UniplateDirect (Rule S) (GuardedAlt S)-deriving instance UniplateDirect (Binds S) (GuardedAlt S)-deriving instance UniplateDirect (Alt S) (GuardedAlt S)-deriving instance UniplateDirect (FieldUpdate S) (GuardedAlt S)-deriving instance UniplateDirect (QualStmt S) (GuardedAlt S)-deriving instance UniplateDirect [QualStmt S] (GuardedAlt S)-deriving instance UniplateDirect (Bracket S) (GuardedAlt S)-deriving instance UniplateDirect (Splice S) (GuardedAlt S)-deriving instance UniplateDirect (Pat S) (PatField S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (PatField S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (PatField S)-deriving instance UniplateDirect (Match S) (PatField S)-deriving instance UniplateDirect (Rhs S) (PatField S)-deriving instance UniplateDirect (Maybe (Binds S)) (PatField S)-deriving instance UniplateDirect (Rule S) (PatField S)-deriving instance UniplateDirect (Binds S) (PatField S)-deriving instance UniplateDirect (Alt S) (PatField S)-deriving instance UniplateDirect (Stmt S) (PatField S)-deriving instance UniplateDirect (FieldUpdate S) (PatField S)-deriving instance UniplateDirect (QualStmt S) (PatField S)-deriving instance UniplateDirect [QualStmt S] (PatField S)-deriving instance UniplateDirect (Bracket S) (PatField S)-deriving instance UniplateDirect (Splice S) (PatField S)-deriving instance UniplateDirect (ModuleHead S) Boxed-deriving instance UniplateDirect (Type S) Boxed-deriving instance UniplateDirect (Maybe (Context S)) Boxed-deriving instance UniplateDirect (QualConDecl S) Boxed-deriving instance UniplateDirect (Maybe (Deriving S)) Boxed-deriving instance UniplateDirect (GadtDecl S) Boxed-deriving instance UniplateDirect (Maybe [ClassDecl S]) Boxed-deriving instance UniplateDirect (InstHead S) Boxed-deriving instance UniplateDirect (Maybe [InstDecl S]) Boxed-deriving instance UniplateDirect (Match S) Boxed-deriving instance UniplateDirect (Pat S) Boxed-deriving instance UniplateDirect (GuardedRhs S) Boxed-deriving instance UniplateDirect (Maybe [RuleVar S]) Boxed-deriving instance UniplateDirect (SpecialCon S) Boxed-deriving instance UniplateDirect (IPBind S) Boxed-deriving instance UniplateDirect (GuardedAlts S) Boxed-deriving instance UniplateDirect (ClassDecl S) (QualStmt S)-deriving instance UniplateDirect (InstDecl S) (QualStmt S)-deriving instance UniplateDirect (PatField S) (QualStmt S)-deriving instance UniplateDirect (RPat S) (QualStmt S)-deriving instance UniplateDirect (PXAttr S) (QualStmt S)-deriving instance UniplateDirect (Maybe (Pat S)) (QualStmt S)-deriving instance UniplateDirect (GuardedRhs S) (QualStmt S)-deriving instance UniplateDirect (IPBind S) (QualStmt S)-deriving instance UniplateDirect (GuardedAlts S) (QualStmt S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (FunDep S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (FunDep S)-deriving instance UniplateDirect (Match S) (FunDep S)-deriving instance UniplateDirect (Pat S) (FunDep S)-deriving instance UniplateDirect (Rhs S) (FunDep S)-deriving instance UniplateDirect (Maybe (Binds S)) (FunDep S)-deriving instance UniplateDirect (Rule S) (FunDep S)-deriving instance UniplateDirect (Binds S) (FunDep S)-deriving instance UniplateDirect (Alt S) (FunDep S)-deriving instance UniplateDirect (Stmt S) (FunDep S)-deriving instance UniplateDirect (FieldUpdate S) (FunDep S)-deriving instance UniplateDirect (QualStmt S) (FunDep S)-deriving instance UniplateDirect [QualStmt S] (FunDep S)-deriving instance UniplateDirect (Bracket S) (FunDep S)-deriving instance UniplateDirect (Splice S) (FunDep S)-deriving instance UniplateDirect (Type S) (IPName S)-deriving instance UniplateDirect (Maybe (Context S)) (IPName S)-deriving instance UniplateDirect (QualConDecl S) (IPName S)-deriving instance UniplateDirect (Maybe (Deriving S)) (IPName S)-deriving instance UniplateDirect (GadtDecl S) (IPName S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (IPName S)-deriving instance UniplateDirect (InstHead S) (IPName S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (IPName S)-deriving instance UniplateDirect (Match S) (IPName S)-deriving instance UniplateDirect (Pat S) (IPName S)-deriving instance UniplateDirect (Maybe (Type S)) (IPName S)-deriving instance UniplateDirect (Rhs S) (IPName S)-deriving instance UniplateDirect (Maybe (Binds S)) (IPName S)-deriving instance UniplateDirect (Rule S) (IPName S)-deriving instance UniplateDirect (Binds S) (IPName S)-deriving instance UniplateDirect (Alt S) (IPName S)-deriving instance UniplateDirect (Stmt S) (IPName S)-deriving instance UniplateDirect (FieldUpdate S) (IPName S)-deriving instance UniplateDirect (QualStmt S) (IPName S)-deriving instance UniplateDirect [QualStmt S] (IPName S)-deriving instance UniplateDirect (Bracket S) (IPName S)-deriving instance UniplateDirect (Splice S) (IPName S)-deriving instance UniplateDirect (DeclHead S) (Kind S)-deriving instance UniplateDirect (Type S) (Kind S)-deriving instance UniplateDirect (Maybe (Kind S)) (Kind S)-deriving instance UniplateDirect (Maybe (Context S)) (Kind S)-deriving instance UniplateDirect (QualConDecl S) (Kind S)-deriving instance UniplateDirect (Maybe (Deriving S)) (Kind S)-deriving instance UniplateDirect (GadtDecl S) (Kind S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Kind S)-deriving instance UniplateDirect (InstHead S) (Kind S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Kind S)-deriving instance UniplateDirect (Match S) (Kind S)-deriving instance UniplateDirect (Pat S) (Kind S)-deriving instance UniplateDirect (Maybe (Type S)) (Kind S)-deriving instance UniplateDirect (Rhs S) (Kind S)-deriving instance UniplateDirect (Maybe (Binds S)) (Kind S)-deriving instance UniplateDirect (Rule S) (Kind S)-deriving instance UniplateDirect (Binds S) (Kind S)-deriving instance UniplateDirect (Alt S) (Kind S)-deriving instance UniplateDirect (Stmt S) (Kind S)-deriving instance UniplateDirect (FieldUpdate S) (Kind S)-deriving instance UniplateDirect (QualStmt S) (Kind S)-deriving instance UniplateDirect [QualStmt S] (Kind S)-deriving instance UniplateDirect (Bracket S) (Kind S)-deriving instance UniplateDirect (Splice S) (Kind S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (CallConv S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (CallConv S)-deriving instance UniplateDirect (Match S) (CallConv S)-deriving instance UniplateDirect (Rhs S) (CallConv S)-deriving instance UniplateDirect (Maybe (Binds S)) (CallConv S)-deriving instance UniplateDirect (Rule S) (CallConv S)-deriving instance UniplateDirect (PatField S) (CallConv S)-deriving instance UniplateDirect (RPat S) (CallConv S)-deriving instance UniplateDirect (PXAttr S) (CallConv S)-deriving instance UniplateDirect (Maybe (Pat S)) (CallConv S)-deriving instance UniplateDirect (IPBind S) (CallConv S)-deriving instance UniplateDirect (GuardedAlts S) (CallConv S)-deriving instance UniplateDirect (ClassDecl S) (GuardedRhs S)-deriving instance UniplateDirect (InstDecl S) (GuardedRhs S)-deriving instance UniplateDirect (PatField S) (GuardedRhs S)-deriving instance UniplateDirect (RPat S) (GuardedRhs S)-deriving instance UniplateDirect (PXAttr S) (GuardedRhs S)-deriving instance UniplateDirect (Maybe (Pat S)) (GuardedRhs S)-deriving instance UniplateDirect (IPBind S) (GuardedRhs S)-deriving instance UniplateDirect (GuardedAlts S) (GuardedRhs S)-deriving instance UniplateDirect (ClassDecl S) (GuardedAlt S)-deriving instance UniplateDirect (InstDecl S) (GuardedAlt S)-deriving instance UniplateDirect (PatField S) (GuardedAlt S)-deriving instance UniplateDirect (RPat S) (GuardedAlt S)-deriving instance UniplateDirect (PXAttr S) (GuardedAlt S)-deriving instance UniplateDirect (Maybe (Pat S)) (GuardedAlt S)-deriving instance UniplateDirect (GuardedRhs S) (GuardedAlt S)-deriving instance UniplateDirect (IPBind S) (GuardedAlt S)-deriving instance UniplateDirect (GuardedAlts S) (GuardedAlt S)-deriving instance UniplateDirect (RPat S) (PatField S)-deriving instance UniplateDirect (PXAttr S) (PatField S)-deriving instance UniplateDirect (Maybe (Pat S)) (PatField S)-deriving instance UniplateDirect (ClassDecl S) (PatField S)-deriving instance UniplateDirect (InstDecl S) (PatField S)-deriving instance UniplateDirect (GuardedRhs S) (PatField S)-deriving instance UniplateDirect (IPBind S) (PatField S)-deriving instance UniplateDirect (GuardedAlts S) (PatField S)-deriving instance UniplateDirect (Maybe (ExportSpecList S)) Boxed-deriving instance UniplateDirect (Context S) Boxed-deriving instance UniplateDirect (ConDecl S) Boxed-deriving instance UniplateDirect (Deriving S) Boxed-deriving instance UniplateDirect (ClassDecl S) Boxed-deriving instance UniplateDirect (InstDecl S) Boxed-deriving instance UniplateDirect (PatField S) Boxed-deriving instance UniplateDirect (RPat S) Boxed-deriving instance UniplateDirect (PXAttr S) Boxed-deriving instance UniplateDirect (Maybe (Pat S)) Boxed-deriving instance UniplateDirect (RuleVar S) Boxed-deriving instance UniplateDirect (GuardedAlt S) Boxed-deriving instance UniplateDirect (GuardedAlt S) (QualStmt S)-deriving instance UniplateDirect (ClassDecl S) (FunDep S)-deriving instance UniplateDirect (InstDecl S) (FunDep S)-deriving instance UniplateDirect (PatField S) (FunDep S)-deriving instance UniplateDirect (RPat S) (FunDep S)-deriving instance UniplateDirect (PXAttr S) (FunDep S)-deriving instance UniplateDirect (Maybe (Pat S)) (FunDep S)-deriving instance UniplateDirect (GuardedRhs S) (FunDep S)-deriving instance UniplateDirect (IPBind S) (FunDep S)-deriving instance UniplateDirect (GuardedAlts S) (FunDep S)-deriving instance UniplateDirect (Context S) (IPName S)-deriving instance UniplateDirect (ConDecl S) (IPName S)-deriving instance UniplateDirect (Deriving S) (IPName S)-deriving instance UniplateDirect (ClassDecl S) (IPName S)-deriving instance UniplateDirect (InstDecl S) (IPName S)-deriving instance UniplateDirect (PatField S) (IPName S)-deriving instance UniplateDirect (RPat S) (IPName S)-deriving instance UniplateDirect (PXAttr S) (IPName S)-deriving instance UniplateDirect (Maybe (Pat S)) (IPName S)-deriving instance UniplateDirect (GuardedRhs S) (IPName S)-deriving instance UniplateDirect (Maybe [RuleVar S]) (IPName S)-deriving instance UniplateDirect (IPBind S) (IPName S)-deriving instance UniplateDirect (GuardedAlts S) (IPName S)-deriving instance UniplateDirect (TyVarBind S) (Kind S)-deriving instance UniplateDirect (Maybe [TyVarBind S]) (Kind S)-deriving instance UniplateDirect (Context S) (Kind S)-deriving instance UniplateDirect (ConDecl S) (Kind S)-deriving instance UniplateDirect (Deriving S) (Kind S)-deriving instance UniplateDirect (ClassDecl S) (Kind S)-deriving instance UniplateDirect (InstDecl S) (Kind S)-deriving instance UniplateDirect (PatField S) (Kind S)-deriving instance UniplateDirect (RPat S) (Kind S)-deriving instance UniplateDirect (PXAttr S) (Kind S)-deriving instance UniplateDirect (Maybe (Pat S)) (Kind S)-deriving instance UniplateDirect (GuardedRhs S) (Kind S)-deriving instance UniplateDirect (Maybe [RuleVar S]) (Kind S)-deriving instance UniplateDirect (IPBind S) (Kind S)-deriving instance UniplateDirect (GuardedAlts S) (Kind S)-deriving instance UniplateDirect (ClassDecl S) (CallConv S)-deriving instance UniplateDirect (InstDecl S) (CallConv S)-deriving instance UniplateDirect (GuardedRhs S) (CallConv S)-deriving instance UniplateDirect (GuardedAlt S) (CallConv S)-deriving instance UniplateDirect (GuardedAlt S) (GuardedRhs S)-deriving instance UniplateDirect (GuardedAlt S) (PatField S)-deriving instance UniplateDirect (ExportSpecList S) Boxed-deriving instance UniplateDirect (Asst S) Boxed-deriving instance UniplateDirect (BangType S) Boxed-deriving instance UniplateDirect (FieldDecl S) Boxed-deriving instance UniplateDirect (GuardedAlt S) (FunDep S)-deriving instance UniplateDirect (Asst S) (IPName S)-deriving instance UniplateDirect (BangType S) (IPName S)-deriving instance UniplateDirect (FieldDecl S) (IPName S)-deriving instance UniplateDirect (RuleVar S) (IPName S)-deriving instance UniplateDirect (GuardedAlt S) (IPName S)-deriving instance UniplateDirect (Asst S) (Kind S)-deriving instance UniplateDirect (BangType S) (Kind S)-deriving instance UniplateDirect (FieldDecl S) (Kind S)-deriving instance UniplateDirect (RuleVar S) (Kind S)-deriving instance UniplateDirect (GuardedAlt S) (Kind S)-deriving instance UniplateDirect (ExportSpec S) Boxed-deriving instance UniplateDirect (Module S) (Splice S)-deriving instance UniplateDirect (Module S) (Bracket S)-deriving instance UniplateDirect (Splice S)-deriving instance UniplateDirect (Decl S) (Splice S)-deriving instance UniplateDirect (XAttr S) (Splice S)-deriving instance UniplateDirect (Maybe (Exp S)) (Splice S)-deriving instance UniplateDirect (Exp S) (Splice S)-deriving instance UniplateDirect (Bracket S)-deriving instance UniplateDirect (Decl S) (Bracket S)-deriving instance UniplateDirect (XAttr S) (Bracket S)-deriving instance UniplateDirect (Maybe (Exp S)) (Bracket S)-deriving instance UniplateDirect (Exp S) (Bracket S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Splice S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Splice S)-deriving instance UniplateDirect (Match S) (Splice S)-deriving instance UniplateDirect (Pat S) (Splice S)-deriving instance UniplateDirect (Rhs S) (Splice S)-deriving instance UniplateDirect (Maybe (Binds S)) (Splice S)-deriving instance UniplateDirect (Rule S) (Splice S)-deriving instance UniplateDirect (Binds S) (Splice S)-deriving instance UniplateDirect (Alt S) (Splice S)-deriving instance UniplateDirect (Stmt S) (Splice S)-deriving instance UniplateDirect (FieldUpdate S) (Splice S)-deriving instance UniplateDirect (QualStmt S) (Splice S)-deriving instance UniplateDirect [QualStmt S] (Splice S)-deriving instance UniplateDirect (Bracket S) (Splice S)-deriving instance UniplateDirect (Pat S) (Bracket S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Bracket S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Bracket S)-deriving instance UniplateDirect (Match S) (Bracket S)-deriving instance UniplateDirect (Rhs S) (Bracket S)-deriving instance UniplateDirect (Maybe (Binds S)) (Bracket S)-deriving instance UniplateDirect (Rule S) (Bracket S)-deriving instance UniplateDirect (Binds S) (Bracket S)-deriving instance UniplateDirect (Alt S) (Bracket S)-deriving instance UniplateDirect (Stmt S) (Bracket S)-deriving instance UniplateDirect (FieldUpdate S) (Bracket S)-deriving instance UniplateDirect (QualStmt S) (Bracket S)-deriving instance UniplateDirect [QualStmt S] (Bracket S)-deriving instance UniplateDirect (Splice S) (Bracket S)-deriving instance UniplateDirect (ClassDecl S) (Splice S)-deriving instance UniplateDirect (InstDecl S) (Splice S)-deriving instance UniplateDirect (PatField S) (Splice S)-deriving instance UniplateDirect (RPat S) (Splice S)-deriving instance UniplateDirect (PXAttr S) (Splice S)-deriving instance UniplateDirect (Maybe (Pat S)) (Splice S)-deriving instance UniplateDirect (GuardedRhs S) (Splice S)-deriving instance UniplateDirect (IPBind S) (Splice S)-deriving instance UniplateDirect (GuardedAlts S) (Splice S)-deriving instance UniplateDirect (PatField S) (Bracket S)-deriving instance UniplateDirect (RPat S) (Bracket S)-deriving instance UniplateDirect (PXAttr S) (Bracket S)-deriving instance UniplateDirect (Maybe (Pat S)) (Bracket S)-deriving instance UniplateDirect (ClassDecl S) (Bracket S)-deriving instance UniplateDirect (InstDecl S) (Bracket S)-deriving instance UniplateDirect (GuardedRhs S) (Bracket S)-deriving instance UniplateDirect (IPBind S) (Bracket S)-deriving instance UniplateDirect (GuardedAlts S) (Bracket S)-deriving instance UniplateDirect (GuardedAlt S) (Splice S)-deriving instance UniplateDirect (GuardedAlt S) (Bracket S)-deriving instance UniplateDirect (Exp S) (Exp S)-deriving instance UniplateDirect [Pat S] (Pat S)-deriving instance UniplateDirect (Module S) (Name S)-deriving instance UniplateDirect (Maybe (ModuleHead S)) (Name S)-deriving instance UniplateDirect (OptionPragma S) (Name S)-deriving instance UniplateDirect (ImportDecl S) (Name S)-deriving instance UniplateDirect (ModuleHead S) (Name S)-deriving instance UniplateDirect (Maybe (ImportSpecList S)) (Name S)-deriving instance UniplateDirect (Maybe (ExportSpecList S)) (Name S)-deriving instance UniplateDirect (ImportSpecList S) (Name S)-deriving instance UniplateDirect (ExportSpecList S) (Name S)-deriving instance UniplateDirect (ImportSpec S) (Name S)-deriving instance UniplateDirect (ExportSpec S) (Name S)-deriving instance UniplateDirect (CName S) (Name S)-deriving instance UniplateDirect [Stmt S] (Exp S)-deriving instance UniplateDirect (Decl S) (Type S)-deriving instance UniplateDirect (Type S)-deriving instance UniplateDirect (Maybe (Context S)) (Type S)-deriving instance UniplateDirect (QualConDecl S) (Type S)-deriving instance UniplateDirect (Maybe (Deriving S)) (Type S)-deriving instance UniplateDirect (GadtDecl S) (Type S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (Type S)-deriving instance UniplateDirect (InstHead S) (Type S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (Type S)-deriving instance UniplateDirect (Exp S) (Type S)-deriving instance UniplateDirect (Match S) (Type S)-deriving instance UniplateDirect (Pat S) (Type S)-deriving instance UniplateDirect (Maybe (Type S)) (Type S)-deriving instance UniplateDirect (Rhs S) (Type S)-deriving instance UniplateDirect (Maybe (Binds S)) (Type S)-deriving instance UniplateDirect (Rule S) (Type S)-deriving instance UniplateDirect (Context S) (Type S)-deriving instance UniplateDirect (ConDecl S) (Type S)-deriving instance UniplateDirect (Deriving S) (Type S)-deriving instance UniplateDirect (ClassDecl S) (Type S)-deriving instance UniplateDirect (InstDecl S) (Type S)-deriving instance UniplateDirect (Binds S) (Type S)-deriving instance UniplateDirect (Alt S) (Type S)-deriving instance UniplateDirect (Stmt S) (Type S)-deriving instance UniplateDirect (Maybe (Exp S)) (Type S)-deriving instance UniplateDirect (FieldUpdate S) (Type S)-deriving instance UniplateDirect (QualStmt S) (Type S)-deriving instance UniplateDirect [QualStmt S] (Type S)-deriving instance UniplateDirect (Bracket S) (Type S)-deriving instance UniplateDirect (Splice S) (Type S)-deriving instance UniplateDirect (XAttr S) (Type S)-deriving instance UniplateDirect (PatField S) (Type S)-deriving instance UniplateDirect (RPat S) (Type S)-deriving instance UniplateDirect (PXAttr S) (Type S)-deriving instance UniplateDirect (Maybe (Pat S)) (Type S)-deriving instance UniplateDirect (GuardedRhs S) (Type S)-deriving instance UniplateDirect (Maybe [RuleVar S]) (Type S)-deriving instance UniplateDirect (Asst S) (Type S)-deriving instance UniplateDirect (BangType S) (Type S)-deriving instance UniplateDirect (FieldDecl S) (Type S)-deriving instance UniplateDirect (IPBind S) (Type S)-deriving instance UniplateDirect (GuardedAlts S) (Type S)-deriving instance UniplateDirect (RuleVar S) (Type S)-deriving instance UniplateDirect (GuardedAlt S) (Type S)-deriving instance UniplateDirect (Exp S) (QName S)-deriving instance UniplateDirect (QName S)-deriving instance UniplateDirect (QOp S) (QName S)-deriving instance UniplateDirect (Pat S) (QName S)-deriving instance UniplateDirect (Binds S) (QName S)-deriving instance UniplateDirect (Alt S) (QName S)-deriving instance UniplateDirect (Stmt S) (QName S)-deriving instance UniplateDirect (Maybe (Exp S)) (QName S)-deriving instance UniplateDirect (FieldUpdate S) (QName S)-deriving instance UniplateDirect (QualStmt S) (QName S)-deriving instance UniplateDirect [QualStmt S] (QName S)-deriving instance UniplateDirect (Type S) (QName S)-deriving instance UniplateDirect (Bracket S) (QName S)-deriving instance UniplateDirect (Splice S) (QName S)-deriving instance UniplateDirect (XAttr S) (QName S)-deriving instance UniplateDirect (PatField S) (QName S)-deriving instance UniplateDirect (RPat S) (QName S)-deriving instance UniplateDirect (PXAttr S) (QName S)-deriving instance UniplateDirect (Maybe (Pat S)) (QName S)-deriving instance UniplateDirect (Decl S) (QName S)-deriving instance UniplateDirect (IPBind S) (QName S)-deriving instance UniplateDirect (GuardedAlts S) (QName S)-deriving instance UniplateDirect (Maybe (Binds S)) (QName S)-deriving instance UniplateDirect (Maybe (Context S)) (QName S)-deriving instance UniplateDirect (QualConDecl S) (QName S)-deriving instance UniplateDirect (Maybe (Deriving S)) (QName S)-deriving instance UniplateDirect (GadtDecl S) (QName S)-deriving instance UniplateDirect (Maybe [ClassDecl S]) (QName S)-deriving instance UniplateDirect (InstHead S) (QName S)-deriving instance UniplateDirect (Maybe [InstDecl S]) (QName S)-deriving instance UniplateDirect (Match S) (QName S)-deriving instance UniplateDirect (Maybe (Type S)) (QName S)-deriving instance UniplateDirect (Rhs S) (QName S)-deriving instance UniplateDirect (Rule S) (QName S)-deriving instance UniplateDirect (GuardedAlt S) (QName S)-deriving instance UniplateDirect (Context S) (QName S)-deriving instance UniplateDirect (ConDecl S) (QName S)-deriving instance UniplateDirect (Deriving S) (QName S)-deriving instance UniplateDirect (ClassDecl S) (QName S)-deriving instance UniplateDirect (InstDecl S) (QName S)-deriving instance UniplateDirect (GuardedRhs S) (QName S)-deriving instance UniplateDirect (Maybe [RuleVar S]) (QName S)-deriving instance UniplateDirect (Asst S) (QName S)-deriving instance UniplateDirect (BangType S) (QName S)-deriving instance UniplateDirect (FieldDecl S) (QName S)-deriving instance UniplateDirect (RuleVar S) (QName S)-!-}

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, ViewPatterns #-}  module HSE.Util(module HSE.Util) where @@ -7,12 +7,16 @@ import Data.Maybe import System.FilePath import HSE.Type+import Data.Functor import Prelude   --------------------------------------------------------------------- -- ACCESSOR/TESTER +ellipses :: QName S+ellipses = UnQual an $ Ident an "..." -- Must be an Ident, not a Symbol+ opExp :: QOp S -> Exp_ opExp (QVarOp s op) = Var s op opExp (QConOp s op) = Con s op@@ -109,6 +113,8 @@ isClsDefSig ClsDefSig{} = True; isClsDefSig _ = False isTyBang TyBang{} = True; isTyBang _ = False isLCase LCase{} = True; isLCase _ = False+isTupleSection TupleSection{} = True; isTupleSection _ = False+isString String{} = True; isString _ = False  isSection LeftSection{} = True isSection RightSection{} = True@@ -123,10 +129,10 @@ unqual (Qual an _ x) = UnQual an x unqual x = x -fromQual :: QName S -> Name S-fromQual (Qual _ _ x) = x-fromQual (UnQual _ x) = x-fromQual x = error $ "HSE.Util.fromQual, not a name: " ++ prettyPrint x+fromQual :: QName a -> Maybe (Name a)+fromQual (Qual _ _ x) = Just x+fromQual (UnQual _ x) = Just x+fromQual _ = Nothing  isSpecial :: QName S -> Bool isSpecial Special{} = True; isSpecial _ = False@@ -176,7 +182,13 @@ --------------------------------------------------------------------- -- HSE FUNCTIONS +isKindHash :: Type_ -> Bool+isKindHash (TyParen _ x) = isKindHash x+isKindHash (TyApp _ x _) = isKindHash x+isKindHash (TyCon _ (fromQual -> Just (Ident _ s))) = "#" `isSuffixOf`  s+isKindHash _ = False + getEquations :: Decl s -> [Decl s] getEquations (FunBind s xs) = map (FunBind s . (:[])) xs getEquations x@PatBind{} = [toFunBind x]@@ -302,6 +314,9 @@ nub_ :: (Annotated f, Eq (f ())) => [f S] -> [f S] nub_ = nubBy (=~=) +delete_ :: (Annotated f, Eq (f ())) => f S -> [f S] -> [f S]+delete_ = deleteBy (=~=)+ intersect_ :: (Annotated f, Eq (f ())) => [f S] -> [f S] -> [f S] intersect_ = intersectBy (=~=) @@ -325,3 +340,6 @@     where f (VarOp _ x) = x           f (ConOp _ x) = x getFixity _ = []++toInfixDecl :: Fixity -> Decl ()+toInfixDecl (Fixity a b c) = InfixDecl () a (Just b) $ maybeToList $ VarOp () <$> fromQual c

@@ -20,7 +20,9 @@ import Hint.Naming import Hint.Pattern import Hint.Import+import Hint.Export import Hint.Pragma+import Hint.Restrict import Hint.Extensions import Hint.Duplicate import Hint.Comment@@ -31,8 +33,8 @@ --   This list is likely to grow over time. data HintBuiltin =     HintList | HintListRec | HintMonad | HintLambda |-    HintBracket | HintNaming | HintPattern | HintImport |-    HintPragma | HintExtensions | HintUnsafe | HintDuplicate |+    HintBracket | HintNaming | HintPattern | HintImport | HintExport |+    HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |     HintComment | HintNewType     deriving (Show,Eq,Ord,Bounded,Enum) @@ -47,26 +49,28 @@     HintNaming     -> decl namingHint     HintPattern    -> decl patternHint     HintImport     -> modu importHint+    HintExport     -> modu exportHint     HintPragma     -> modu pragmaHint     HintExtensions -> modu extensionsHint     HintUnsafe     -> modu unsafeHint     HintDuplicate  -> mods duplicateHint     HintComment    -> comm commentHint     HintNewType    -> decl newtypeHint+    HintRestrict   -> mempty{hintModule=restrictHint}     where-        decl x = mempty{hintDecl=x}-        modu x = mempty{hintModule=x}-        mods x = mempty{hintModules=x}-        comm x = mempty{hintComment=x}+        decl x = mempty{hintDecl=const x}+        modu x = mempty{hintModule=const x}+        mods x = mempty{hintModules=const x}+        comm x = mempty{hintComment=const x}   -- | A list of builtin hints, currently including entries such as @\"List\"@ and @\"Bracket\"@. builtinHints :: [(String, Hint)]-builtinHints = [(drop 4 $ show h, resolveHints [Left h]) | h <- [minBound .. maxBound]]+builtinHints = [(drop 4 $ show h, builtin h) | h <- [minBound .. maxBound]]  -- | Transform a list of 'HintBuiltin' or 'HintRule' into a 'Hint'. resolveHints :: [Either HintBuiltin HintRule] -> Hint-resolveHints xs = mconcat $ mempty{hintDecl=readMatch rights} : map builtin (nub lefts)+resolveHints xs = mconcat $ mempty{hintDecl=const $ readMatch rights} : map builtin (nub lefts)     where (lefts,rights) = partitionEithers xs  -- | Transform a list of 'HintRule' into a 'Hint'.

@@ -0,0 +1,26 @@+{-+    Suggest using better export declarations++<TEST>+main = 1+module Foo where foo = 1 -- module Foo(module Foo) where+module Foo(foo) where foo = 1+module Foo(module Foo) where foo = 1 -- @Ignore module Foo(...) where+module Foo(module Foo, foo) where foo = 1 -- module Foo(..., foo) where+</TEST>+-}++module Hint.Export(exportHint) where++import Hint.Type+++exportHint :: ModuHint+exportHint _ (Module _ (Just o@(ModuleHead a name warning exports)) _ _ _)+    | Nothing <- exports =+        let o2 = ModuleHead a name warning $ Just $ ExportSpecList a [EModuleContents a name]+        in [(warn "Use module export list" o o2 []){ideaNote = [Note "An explicit list is usually better"]}]+    | Just (ExportSpecList _ xs) <- exports, EModuleContents a name `elem_` xs =+        let o2 = ModuleHead a name warning $ Just $ ExportSpecList a $ EVar a ellipses : delete_ (EModuleContents a name) xs+        in [ignore "Use explicit module export list" o o2 []]+exportHint _ _ = []

@@ -83,6 +83,14 @@ foo = id -- {-# LANGUAGE NumDecimals #-} \ foo = 12.345e2 --+{-# LANGUAGE TupleSections #-} \+main = map (,1,2) xs+{-# LANGUAGE TupleSections #-} \+main = id --+{-# LANGUAGE OverloadedStrings #-} \+main = "test"+{-# LANGUAGE OverloadedStrings #-} \+main = id -- </TEST> -} @@ -169,6 +177,8 @@ used DeriveGeneric = hasDerive ["Generic","Generic1"] used GeneralizedNewtypeDeriving = any (`notElem` noNewtypeDeriving) . fst . derives used LambdaCase = hasS isLCase+used TupleSections = hasS isTupleSection+used OverloadedStrings = hasS isString used Arrows = hasS f     where f Proc{} = True           f LeftArrApp{} = True

@@ -40,7 +40,7 @@ module Hint.Import(importHint) where  import Control.Applicative-import Control.Arrow+import Data.Tuple.Extra import Hint.Type import Refact.Types hiding (ModuleName) import qualified Refact.Types as R

@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns, PatternGuards, FlexibleContexts, TupleSections #-}+{-# LANGUAGE ViewPatterns, PatternGuards, FlexibleContexts #-}  {-     Find and match:

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, ViewPatterns, RelaxedPolyRec, RecordWildCards, FlexibleContexts, ScopedTypeVariables, TupleSections #-}+{-# LANGUAGE PatternGuards, ViewPatterns, RecordWildCards, FlexibleContexts, ScopedTypeVariables #-}  {- The matching does a fairly simple unification between the two terms, treating@@ -43,7 +43,6 @@ import Data.List.Extra import Data.Maybe import Data.Data-import Unsafe.Coerce import Config.Type import Hint.Type import Control.Monad@@ -163,8 +162,8 @@  -- unify a b = c, a[c] = b unify :: Data a => NameMatch -> Bool -> a -> a -> Maybe [(String,Exp_)]-unify nm root x y | Just x <- cast x = unifyExp nm root x (unsafeCoerce y)-                  | Just x <- cast x = unifyPat nm x (unsafeCoerce y)+unify nm root x y | Just (x,y) <- cast (x,y) = unifyExp nm root x y+                  | Just (x,y) <- cast (x,y) = unifyPat nm x y                   | Just (x :: S) <- cast x = Just []                   | otherwise = unifyDef nm x y 

@@ -59,7 +59,7 @@     PatBind a b c _ -> f (PatBind a b) c     x -> x     where-        dots = Var an $ UnQual an $ Ident an "..." -- Must be an Ident, not a Symbol+        dots = Var an ellipses         f cont (UnGuardedRhs _ _) = cont (UnGuardedRhs an dots) Nothing         f cont (GuardedRhss _ _) = cont (GuardedRhss an [GuardedRhs an [Qualifier an dots] dots]) Nothing 

@@ -15,6 +15,8 @@ data Foo = Bar data X = Y {-# UNPACK #-} !Int -- newtype X = Y Int data A = A {b :: !C} -- newtype A = A {b :: C}+data A = A Int#+data A = A () -- newtype A = A () </TEST> -} module Hint.NewType (newtypeHint) where@@ -36,7 +38,7 @@ singleSimpleField (DataDecl x1 dt x2 x3 [QualConDecl y1 Nothing y2 ctor] x4)     | Just (t, ft) <- f ctor = Just (dt, t, \dt t -> DataDecl x1 dt x2 x3 [QualConDecl y1 Nothing y2 $ ft t] x4)     where-        f (ConDecl x1 x2 [t]) = Just (t, \t -> ConDecl x1 x2 [t])+        f (ConDecl x1 x2 [t]) | not $ isKindHash t = Just (t, \t -> ConDecl x1 x2 [t])         f (RecDecl x1 x2 [FieldDecl y1 [y2] t]) = Just (t, \t -> RecDecl x1 x2 [FieldDecl y1 [y2] t])         f _ = Nothing singleSimpleField _ = Nothing

@@ -0,0 +1,99 @@+{-# LANGUAGE RecordWildCards #-}++module Hint.Restrict(restrictHint) where++{-+-- These tests rely on the .hlint.yaml file in the root+<TEST>+foo = unsafePerformIO --+module Util where otherFunc = unsafePerformIO $ print 1 --+module Util where exitMessageImpure = unsafePerformIO $ print 1+foo = unsafePerformOI+</TEST>+-}++import qualified Data.Map as Map+import Config.Type+import Hint.Type+import Data.List+import Data.Maybe+import Data.Monoid+import Control.Applicative+import Prelude+++-- FIXME: The settings should be partially applied, but that's hard to orchestrate right now+restrictHint :: [Setting] -> ModuHint+restrictHint settings scope m =+        checkPragmas modu (modulePragmas m) restrict +++        maybe [] (checkImports modu $ moduleImports m) (Map.lookup RestrictModule restrict) +++        maybe [] (checkFunctions modu $ moduleDecls m) (Map.lookup RestrictFunction restrict)+    where+        modu = moduleName m+        restrict = restrictions settings++---------------------------------------------------------------------+-- UTILITIES++data RestrictItem = RestrictItem+    {riAs :: [String]+    ,riWithin :: [(String, String)]+    }+instance Monoid RestrictItem where+    mempty = RestrictItem [] []+    mappend (RestrictItem x1 x2) (RestrictItem y1 y2) = RestrictItem (x1<>y1) (x2<>y2)++restrictions :: [Setting] -> Map.Map RestrictType (Bool, Map.Map String RestrictItem)+restrictions settings = Map.map f $ Map.fromListWith (++) [(restrictType x, [x]) | SettingRestrict x <- settings]+    where+        f rs = (all restrictDefault rs+               ,Map.fromListWith (<>) [(s, RestrictItem restrictAs restrictWithin) | Restrict{..} <- rs, s <- restrictName])++ideaMayBreak w = w{ideaNote=[Note "may break the code"]}+ideaNoTo w = w{ideaTo=Nothing}++within :: String -> String -> RestrictItem -> Bool+within modu func RestrictItem{..} = any (\(a,b) -> (a == modu || a == "") && (b == func || b == "")) riWithin++---------------------------------------------------------------------+-- CHECKS++checkPragmas :: String -> [ModulePragma S] -> Map.Map RestrictType (Bool, Map.Map String RestrictItem) -> [Idea]+checkPragmas modu xs mps = f RestrictFlag "flags" onFlags ++ f RestrictExtension "extensions" onExtensions+    where+        f tag name sel =+            [ (if null good then ideaNoTo else id) $ ideaMayBreak $ warn ("Avoid restricted " ++ name) o (regen good) []+            | Just mp <- [Map.lookup tag mps]+            , o <- xs, Just (xs, regen) <- [sel o]+            , let (good, bad) = partition (isGood mp) xs, not $ null bad]++        onFlags (OptionsPragma s t x) = Just (words x, OptionsPragma s t . unwords)+        onFlags _ = Nothing++        onExtensions (LanguagePragma s xs) = Just (map fromNamed xs, LanguagePragma (s :: S) . map toNamed)+        onExtensions _ = Nothing++        isGood (def, mp) x = maybe def (within modu "") $ Map.lookup x mp+++checkImports :: String -> [ImportDecl S] -> (Bool, Map.Map String RestrictItem) -> [Idea]+checkImports modu imp (def, mp) =+    [ ideaMayBreak $ if not allowImport+      then ideaNoTo $ warn "Avoid restricted module" i i []+      else warn "Avoid restricted qualification" i i{importAs=ModuleName an <$> listToMaybe riAs} []+    | i@ImportDecl{..} <- imp+    , let ri@RestrictItem{..} = Map.findWithDefault (RestrictItem [] [("","") | def]) (fromModuleName importModule) mp+    , let allowImport = within modu "" ri+    , let allowQual = maybe True (\x -> null riAs || fromModuleName x `elem` riAs) importAs+    , not allowImport || not allowQual+    ]+++checkFunctions :: String -> [Decl_] -> (Bool, Map.Map String RestrictItem) -> [Idea]+checkFunctions modu decls (def, mp) =+    [ ideaMayBreak $ ideaNoTo $ warn "Avoid restricted function" x x []+    | d <- decls+    , let dname = fromNamed d+    , x@Var{} <- universeBi d+    , not $ maybe def (within modu dname) $ Map.lookup (fromNamed x) mp+    ]

@@ -1,6 +1,11 @@-module Hint.Type(module Hint.Type, module Export) where +module Hint.Type(+    DeclHint, ModuHint, CrossHint, Hint(..),+    module Export+    ) where+ import Data.Monoid+import Config.Type import HSE.All  as Export import Idea     as Export import Prelude@@ -13,15 +18,18 @@  -- | Functions to generate hints, combined using the 'Monoid' instance. data Hint = Hint-    {hintModules :: [(Scope, Module_)] -> [Idea] -- ^ Given a list of modules (and their scope information) generate some 'Idea's.-    ,hintModule :: Scope -> Module_ -> [Idea] -- ^ Given a single module and its scope information generate some 'Idea's.-    ,hintDecl :: Scope -> Module_ -> Decl_ -> [Idea]+    {hintModules :: [Setting] -> [(Scope, Module_)] -> [Idea] -- ^ Given a list of modules (and their scope information) generate some 'Idea's.+    ,hintModule :: [Setting] -> Scope -> Module_ -> [Idea] -- ^ Given a single module and its scope information generate some 'Idea's.+    ,hintDecl :: [Setting] -> Scope -> Module_ -> Decl_ -> [Idea]         -- ^ Given a declaration (with a module and scope) generate some 'Idea's.         --   This function will be partially applied with one module/scope, then used on multiple 'Decl' values.-    ,hintComment :: Comment -> [Idea] -- ^ Given a comment generate some 'Idea's.+    ,hintComment :: [Setting] -> Comment -> [Idea] -- ^ Given a comment generate some 'Idea's.     }  instance Monoid Hint where-    mempty = Hint (const []) (\_ _ -> []) (\_ _ _ -> []) (const [])-    mappend (Hint x1 x2 x3 x4) (Hint y1 y2 y3 y4) =-        Hint (\a -> x1 a ++ y1 a) (\a b -> x2 a b ++ y2 a b) (\a b c -> x3 a b c ++ y3 a b c) (\a -> x4 a ++ y4 a)+    mempty = Hint (\_ _ -> []) (\_ _ _ -> []) (\_ _ _ _ -> []) (\_ _ -> [])+    mappend (Hint x1 x2 x3 x4) (Hint y1 y2 y3 y4) = Hint+        (\a b -> x1 a b ++ y1 a b)+        (\a b c -> x2 a b c ++ y2 a b c)+        (\a b c d -> x3 a b c d ++ y3 a b c d)+        (\a b -> x4 a b ++ y4 a b)

@@ -1,6 +1,13 @@ {-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-} -module Idea(module Idea, Note(..), showNotes, Severity(..)) where+module Idea(+    Idea(..),+    rawIdea, idea, suggest, warn, ignore,+    rawIdeaN, suggestN, warnN,+    showIdeasJson, showANSI,+    Note(..), showNotes,+    Severity(..)+    ) where  import Data.List.Extra import Data.Char@@ -81,12 +88,12 @@  idea severity hint from to = rawIdea severity hint (toSrcSpan $ ann from) (f from) (Just $ f to) []     where f = trimStart . prettyPrint+ suggest = idea Suggestion warn = idea Warning-+ignore = idea Ignore -ideaN severity hint from to = rawIdea severity hint (toSrcSpan $ ann from) (f from) (Just $ f to) [] []-    where f = trimStart . prettyPrint+ideaN severity hint from to = idea severity hint from to []  suggestN = ideaN Suggestion warnN = ideaN Warning

@@ -1,87 +0,0 @@---- | /WARNING: This module represents the evolving second version of the HLint API./---   /It will be deleted in favour of "Language.Haskell.HLint3" in the next major version./------   This module provides a way to apply HLint hints. As an example of approximating the @hlint@ experience:------ @--- (flags, classify, hint) <- 'autoSettings'--- Right m <- 'parseModuleEx' flags \"MyFile.hs\" Nothing--- print $ 'applyHints' classify hint [m]--- @-module Language.Haskell.HLint2(-    applyHints,-    -- * Idea data type-    Idea(..), Severity(..), Note(..),-    -- * Settings-    Classify(..),-    getHLintDataDir,-    autoSettings, autoSettings', findSettings, readSettings,-    -- * Hints-    Hint(..), builtinHints,-    HintRule(..), hintRules,-    -- * Scopes-    Scope, scopeCreate, scopeMatch, scopeMove,-    -- * Haskell-src-exts-    parseModuleEx, defaultParseFlags, ParseError(..), ParseFlags(..), CppFlags(..),-    -- * File encodings-    Encoding, defaultEncoding, readEncoding, useEncoding-    ) where--import Config.Type-import Config.Haskell-import Idea-import Apply-import Hint.Type-import Hint.All-import Util-import CmdLine-import Paths_hlint--import Control.Applicative-import Data.Maybe-import Data.Monoid-import Data.Tuple.Extra-import Data.List.Extra-import System.FilePath-import Prelude----- | Get the Cabal configured data directory of HLint-getHLintDataDir :: IO FilePath-getHLintDataDir = getDataDir--resolveBuiltin :: [String] -> [Hint]-resolveBuiltin builtin = map f $ nub $ concat [if x == "All" then map fst builtinHints else [x] | x <- builtin]-    where f x = fromMaybe (error $ "Unknown builtin hints: HLint.Builtin." ++ x) $ lookup x builtinHints----- | The function produces a tuple containg 'ParseFlags' (for 'parseModuleEx'), and 'Classify' and 'Hint' for 'applyHints'.---   It approximates the normal HLint configuration steps, roughly:------ 1. Use 'findSettings' to find and load the HLint settings files.------ 1. Use 'readSettings' to interpret the settings files, producing 'HintRule' values (@LHS ==> RHS@ replacements)---   and 'Classify' values to assign 'Severity' ratings to hints.------ 1. Use 'builtinHints' and 'hintRules' to generate a 'Hint' value.------ 1. Take all fixities from the 'findSettings' modules and put them in the 'ParseFlags'.-autoSettings :: IO (ParseFlags, [Classify], Hint)-autoSettings = getHLintDataDir >>= autoSettings'---- | Like 'autoSettings' but with a custom data directory.-autoSettings' :: FilePath -> IO (ParseFlags, [Classify], Hint)-autoSettings' dataDir = do-    (builtin, matches) <- first resolveBuiltin <$> findSettings dataDir (dataDir </> "HLint.hs") Nothing-    let (classify, rules) = second hintRules $ concatUnzip $ map readSettings matches-    let fixities = getFixity =<< moduleDecls =<< matches-    return (parseFlagsAddFixities fixities defaultParseFlags, classify, mconcat $ rules : builtin)----- | Snippet from the documentation, if this changes, update the documentation-_docs :: IO ()-_docs = do-    (flags, classify, hint) <- autoSettings-    Right m <- parseModuleEx flags "MyFile.hs" Nothing-    print $ applyHints classify hint [m]

@@ -1,4 +1,4 @@-{-# LANGUAGE TupleSections, PatternGuards, RecordWildCards #-}+{-# LANGUAGE PatternGuards, RecordWildCards #-}  -- | /WARNING: This module represents the evolving second version of the HLint API./ --   /It will be renamed to drop the "3" in the next major version./@@ -30,15 +30,13 @@     ) where  import Config.Type-import Config.Haskell as Settings hiding (findSettings)+import Config.All import Idea import Apply import HLint import Hint.Type import Hint.All import CmdLine-import Util-import System.IO import Paths_hlint  import Data.List.Extra@@ -77,9 +75,8 @@         CmdMain{..} -> do             -- FIXME: Two things that could be supported (but aren't) are 'cmdGivenHints' and 'cmdWithHints'.             (fixities, classify, hints) <- findSettings (readSettingsFile $ Just cmdDataDir) Nothing-            encoding <- if cmdUtf8 then return utf8 else readEncoding cmdEncoding             let flags = parseFlagsSetLanguage (cmdExtensions cmd) $ parseFlagsAddFixities fixities $-                        defaultParseFlags{cppFlags = cmdCpp cmd, encoding = encoding}+                        defaultParseFlags{cppFlags = cmdCpp cmd}             let ignore = [Classify Ignore x "" "" | x <- cmdIgnore]             return (flags, classify ++ ignore, resolveHints hints)         _ -> error "Can only invoke autoSettingsArgs with the root process"@@ -104,24 +101,10 @@ findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([Fixity], [Classify], [Either HintBuiltin HintRule]) findSettings load start = do     (file,contents) <- load $ fromMaybe "HLint.HLint" start-    let flags = addInfix defaultParseFlags-    res <- parseModuleEx flags file contents-    case res of-        Left (ParseError sl msg err) ->-            error $ "Settings parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err-        Right (m, _) -> do-            imported <- sequence [f $ fromNamed $ importModule i | i <- moduleImports m, importPkg i `elem` [Just "hint", Just "hlint"]]-            let (classify, rules) = Settings.readSettings m-            let fixities = getFixity =<< moduleDecls m-            return $ concatUnzip3 $ (fixities,classify,map Right rules) : imported-    where-        builtins =  [(drop 4 $ show h, h :: HintBuiltin) | h <- [minBound .. maxBound]]--        f x | x == "HLint.Builtin.All" = return ([], [], map Left [minBound..maxBound])-        f x | Just x <- "HLint.Builtin." `stripPrefix` x = case lookup x builtins of-                Just x -> return ([], [], [Left x])-                Nothing -> error $ "Unknown builtin hints: HLint.Builtin." ++ x-            | otherwise = findSettings load (Just x)+    xs <- readFilesConfig [(file,contents)]+    return ([x | Infix x <- xs]+           ,[x | SettingClassify x <- xs]+           ,[Right x | SettingMatchExp x <- xs] ++ map Left [minBound..maxBound])   -- | Snippet from the documentation, if this changes, update the documentation

@@ -7,11 +7,10 @@ import Data.List import System.Directory import System.FilePath-import Data.Functor import Prelude  import Config.Type-import Config.Haskell+import Config.All import CmdLine import HSE.All import Hint.All@@ -22,20 +21,25 @@ import System.IO.Extra  -{-# ANN test "HLint: ignore Use let" #-} test :: Cmd -> ([String] -> IO ()) -> FilePath -> [FilePath] -> IO Int test CmdTest{..} main dataDir files = withBuffering stdout NoBuffering $ withTests $ do     hasSrc <- doesFileExist "hlint.cabal"     useSrc <- return $ hasSrc && null files     testFiles <- if files /= [] then return files else do         xs <- getDirectoryContents dataDir-        return [dataDir </> x | x <- xs, takeExtension x == ".hs", not $ "HLint" `isPrefixOf` takeBaseName x]-    testFiles <- forM testFiles $ \file -> (,) file <$> readSettings2 dataDir [file] []+        return [dataDir </> x | x <- xs, takeExtension x `elem` [".hs",".yml",".yaml"]+                              , not $ "HLint_" `isPrefixOf` takeBaseName x]+    testFiles <- forM testFiles $ \file -> do+        hints <- readFilesConfig [(file, Nothing)]+        return (file, hints ++ (if takeBaseName file /= "Test" then [] else map (Builtin . fst) builtinHints))     let wrap msg act = putStr (msg ++ " ") >> act >> putStrLn ""      putStrLn "Testing"+    config <- readFilesConfig [(".hlint.yaml",Nothing)]     when useSrc $ wrap "Source annotations" $-        forM_ builtinHints $ \(name,_) -> do progress; testAnnotations [Builtin name] $ "src/Hint" </> name <.> "hs"+        forM_ builtinHints $ \(name,_) -> do+            progress+            testAnnotations (Builtin name : if name == "Restrict" then config else []) $ "src/Hint" </> name <.> "hs"     when useSrc $ wrap "Input/outputs" $ testInputOutput main      wrap "Hint names" $ mapM_ (\x -> do progress; testNames $ snd x) testFiles@@ -53,5 +57,5 @@  testNames :: [Setting] -> IO () testNames  hints = sequence_-    [ failed ["No name for the hint " ++ prettyPrint (hintRuleLHS x)]-    | SettingMatchExp x@HintRule{} <- hints, hintRuleName x == defaultHintName]+    [ failed ["No name for the hint " ++ prettyPrint hintRuleLHS ++ " ==> " ++ prettyPrint hintRuleRHS]+    | SettingMatchExp x@HintRule{..} <- hints, hintRuleName == defaultHintName]

@@ -32,7 +32,6 @@                     Nothing -> null ideas                     Just x -> length ideas == 1 &&                               seq (length (show ideas)) True && -- force, mainly for hpc-                              isJust (ideaTo $ head ideas) && -- detects parse failure                               match x (head ideas)             let bad =                     [failed $@@ -62,7 +61,8 @@ parseTestFile :: FilePath -> IO [Test] parseTestFile file = do     src <- readFile file-    return $ f False $ zip [1..] $ lines src+    -- we remove all leading # symbols since Yaml only lets us do comments that way+    return $ f False $ zip [1..] $ map (\x -> fromMaybe x $ stripPrefix "# " x) $ lines src     where         open = isPrefixOf "<TEST>"         shut = isPrefixOf "</TEST>"

@@ -1,18 +1,15 @@-{-# LANGUAGE ExistentialQuantification, Rank2Types, PatternGuards #-}+{-# LANGUAGE ExistentialQuantification, Rank2Types #-}  module Util(     defaultExtensions,-    Encoding, defaultEncoding, readFileEncoding', readEncoding, useEncoding,     gzip, universeParentBi, descendIndex,-    exitMessage+    exitMessage, exitMessageImpure     ) where  import Control.Monad.Trans.State-import Control.Exception-import Data.Char import Data.List import System.Exit-import System.IO.Extra hiding (readFileEncoding')+import System.IO import System.IO.Unsafe import Unsafe.Coerce import Data.Data@@ -23,73 +20,15 @@ --------------------------------------------------------------------- -- SYSTEM.IO --- | An 'Encoding' represents how characters are stored in a file. Created with---   'defaultEncoding' or 'readEncoding' and used with 'useEncoding'.-type Encoding = TextEncoding---- | The system default encoding.-defaultEncoding :: Encoding-defaultEncoding = utf8---- | Apply an encoding to a 'Handle'.-useEncoding :: Handle -> Encoding -> IO ()-useEncoding = hSetEncoding--readFileEncoding' :: Encoding -> FilePath -> IO String-readFileEncoding' enc "-" = do-    useEncoding stdin enc-    getContents-readFileEncoding' enc file = withFile file ReadMode $ \h -> do-    useEncoding h enc-    s <- hGetContents h-    evaluate $ length s-    return s----- | Create an encoding from a string, or throw an error if the encoding is not known.---   Accepts many encodings including @locale@, @utf-8@ and all those supported by the---   GHC @mkTextEncoding@ function.-readEncoding :: String -> IO Encoding--- GHC's mkTextEncoding function is fairly poor - it doesn't support lots of fun things,--- so we fake them up, and then try mkTextEncoding last-readEncoding "" = return defaultEncoding-readEncoding enc-        | Just e <- lookup (f enc) [(f a, b) | (as,b) <- encs, a <- as] = return e-        | otherwise = do-            res <- try $ mkTextEncoding enc :: IO (Either SomeException TextEncoding)-            case res of-                Right e -> return e-                Left _ -> do-                    let (a,b) = splitAt 2 $ map (head . fst) encs-                    putStr $ unlines-                        ["Error: Unknown text encoding argument, " ++ enc-                        ,"Possible values:"-                        ,"  " ++ unwords a-                        ,"  " ++ unwords b-                        ,"  and anything accepted by System.IO.mkTextEncoding"]-                    exitWith $ ExitFailure 1-    where-        f = map toLower . filter (`notElem` "-_ ")--        encs = let a*b = (words a, b)-               in ["ISO8859-1 8859-1 ISO8859 8859 LATIN LATIN1" * latin1-                  ,"LOCALE" * localeEncoding-                  ,"UTF-8" * utf8-                  ,"UTF-8BOM" * utf8_bom-                  ,"UTF-16" * utf16-                  ,"UTF-16LE" * utf16le-                  ,"UTF-16BE" * utf16be-                  ,"UTF-32" * utf16-                  ,"UTF-32LE" * utf16le-                  ,"UTF-32BE" * utf16be]---exitMessage :: String -> a-exitMessage msg = unsafePerformIO $ do-    putStrLn msg+exitMessage :: String -> IO a+exitMessage msg = do+    hPutStrLn stderr msg     exitWith $ ExitFailure 1 +exitMessageImpure :: String -> a+exitMessageImpure = unsafePerformIO . exitMessage + --------------------------------------------------------------------- -- DATA.GENERICS @@ -98,6 +37,8 @@ gzip :: Data a => (forall b . Data b => b -> b -> c) -> a -> a -> Maybe [c] gzip f x y | toConstr x /= toConstr y = Nothing            | otherwise = Just $ zipWith op (gmapQ Box x) (gmapQ Box y)+         -- unsafeCoerce is safe because gmapQ on the same constr gives the same fields+         -- in the same order     where op (Box x) (Box y) = f x (unsafeCoerce y)