hlint 2.0.12 → 2.0.13

raw patch · 18 files changed

+157/−97 lines, 18 filesdep +semigroupsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES.txt +4/−0
• LICENSE +1/−1
• README.md +66/−42
• hlint.cabal +4/−2
• src/Apply.hs +2/−4
• src/CmdLine.hs +1/−1
• src/Config/Yaml.hs +3/−3
• src/HSE/Scope.hs +3/−7
• src/HSE/Unify.hs +3/−5
• src/Hint/Bracket.hs +10/−3
• src/Hint/Extensions.hs +5/−3
• src/Hint/Monad.hs +17/−0
• src/Hint/Restrict.hs +4/−2
• src/Hint/Type.hs +7/−4
• src/HsColour.hs +4/−3
• src/Idea.hs +3/−3
• src/Language/Haskell/HLint3.hs +3/−2
• src/Test/Annotations.hs +17/−12

@@ -1,5 +1,9 @@ Changelog for HLint +2.0.13, released 2018-01-12+    #376, suggest <$> instead of x <- foo; return $ f x+    #401, suggest removing brackets for (f . g) <$> x+    Add Semigroup instances 2.0.12, released 2017-12-12     Don't suggest Control.Arrow     Upgrade to haskell-src-exts-1.20

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

@@ -7,10 +7,6 @@ * [Customizing the hints](#customizing-the-hints) * [Hacking HLint](#hacking-hlint) -### Acknowledgements--This program has only been made possible by the presence of the [haskell-src-exts](https://github.com/haskell-suite/haskell-src-exts) package, and many improvements have been made by [Niklas Broberg](http://www.nbroberg.se) in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart, Roman Leshchinskiy, Johannes Lippmann, Iustin Pop, Steve Purcell, Mitchell Rosen and others.- ### Bugs and limitations  Bugs can be reported [on the bug tracker](https://github.com/ndmitchell/hlint/issues). There are some issues that I do not intend to fix:@@ -27,28 +23,29 @@  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+```console+$ hlint darcs-2.1.2 -    darcs-2.1.2\src\CommandLine.lhs:94:1: Warning: Use concatMap-    Found:-      concat $ map escapeC s-    Why not:-      concatMap escapeC s+darcs-2.1.2\src\CommandLine.lhs:94:1: Warning: Use concatMap+Found:+    concat $ map escapeC s+Why not:+    concatMap escapeC s -    darcs-2.1.2\src\CommandLine.lhs:103:1: Suggestion: Use fewer brackets-    Found:-      ftable ++ (map (\ (c, x) -> (toUpper c, urlEncode x)) ftable)-    Why not:-      ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable+darcs-2.1.2\src\CommandLine.lhs:103:1: Suggestion: Use fewer brackets+Found:+    ftable ++ (map (\ (c, x) -> (toUpper c, urlEncode x)) ftable)+Why not:+    ftable ++ map (\ (c, x) -> (toUpper c, urlEncode x)) ftable -    darcs-2.1.2\src\Darcs\Patch\Test.lhs:306:1: Warning: Use a more efficient monadic variant-    Found:-      mapM (delete_line (fn2fp f) line) old-    Why not:-      mapM_ (delete_line (fn2fp f) line) old+darcs-2.1.2\src\Darcs\Patch\Test.lhs:306:1: Warning: Use a more efficient monadic variant+Found:+    mapM (delete_line (fn2fp f) line) old+Why not:+    mapM_ (delete_line (fn2fp f) line) old -    ... lots more hints ...+... lots more hints ...+```  Each hint says which file/line the hint relates to, how serious an issue it is, a description of the hint, what it found, and what you might want to replace it with. In the case of the first hint, it has suggested that instead of applying `concat` and `map` separately, it would be better to use the combination function `concatMap`. @@ -56,21 +53,33 @@  **Bug reports:** The suggested replacement should be equivalent - please report all incorrect suggestions not mentioned as known limitations. -### Running with Continuous Integration+### Suggested usage -Before running HLint on your continuous integration (CI) server, you should first ensure there are no existing hints. One way to achieve that is to ignore existing hints by running `hlint . --default > .hlint.yaml` and checking in the resulting `.hlint.yaml`.+HLint usage tends to proceed in three distinct phases: +1. Initially, run `hlint . --report` to generate `report.html` containing a list of all issues HLint has found. Fix those you think are worth fixing and keep repeating.+1. Once you are happy, run `hlint . --default > .hlint.yaml`, which will generate a settings file ignoring all the hints currently outstanding. Over time you may wish to edit the list.+1. For larger projects, add [custom hints or rules](#customizing-the-hints).++Most hints are intended to be a good idea in most circumstances, but not universally - judgement is required. When contributing to someone else's project, HLint can identify pieces of code to look at, but only make changes you consider improvements - not merely to adhere to HLint rules.++### Running with Continuous Integration+ On the CI you should then run `hlint .` (or `hlint src` if you only want to check the `src` directory). To avoid the cost of compilation you may wish to fetch the [latest HLint binary release](https://github.com/ndmitchell/hlint/releases/latest). For certain CI environments there are helper scripts to do that.  **Travis:** Execute the following command: -    curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s .+```sh+curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s .+```  The arguments after `-s` are passed to `hlint`, so modify the final `.` if you want other arguments.  **Appveyor:** Add the following statement to `.appveyor.yml`: -    - ps: Invoke-Command ([Scriptblock]::Create((Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/hlint/master/misc/appveyor.ps1').Content)) -ArgumentList @('.')+```powershell+- ps: Invoke-Command ([Scriptblock]::Create((Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/hlint/master/misc/appveyor.ps1').Content)) -ArgumentList @('.')+```  The arguments inside `@()` are passed to `hlint`, so add new arguments surrounded by `'`, space separated - e.g. `@('.' '--report')`. @@ -118,10 +127,12 @@  Emacs integration has been provided by [Alex Ott](http://xtalk.msk.su/~ott/). The integration is similar to compilation-mode, allowing navigation between errors. The script is at [hs-lint.el](https://raw.githubusercontent.com/ndmitchell/hlint/master/data/hs-lint.el), and a copy is installed locally in the data directory. To use, add the following code to the Emacs init file: -    (require 'hs-lint)-    (defun my-haskell-mode-hook ()-       (local-set-key "\C-cl" 'hs-lint))-    (add-hook 'haskell-mode-hook 'my-haskell-mode-hook)+```guile+(require 'hs-lint)+(defun my-haskell-mode-hook ()+    (local-set-key "\C-cl" 'hs-lint))+(add-hook 'haskell-mode-hook 'my-haskell-mode-hook)+```  ### GHCi Integration @@ -146,7 +157,9 @@  Consider: -    foo xs = concat (map op xs)+```haskell+foo xs = concat (map op xs)+```  This will suggest eta reduction to `concat . map op`, and then after making that change and running HLint again, will suggest use of `concatMap`. Many people wonder why HLint doesn't directly suggest `concatMap op`. There are a number of reasons: @@ -174,8 +187,8 @@ Most hints are perfect substitutions, and these are displayed without any notes. However, some hints change the semantics of your program - typically in irrelevant ways - but HLint shows a warning note. HLint does not warn when assuming typeclass laws (such as `==` being symmetric). Some notes you may see include:  * __Increases laziness__ - for example `foldl (&&) True` suggests `and` including this note. The new code will work on infinite lists, while the old code would not. Increasing laziness is usually a good idea.-* __Decreases laziness__ - for example `(fst a, snd a)` suggests a including this note. On evaluation the new code will raise an error if a is an error, while the old code would produce a pair containing two error values. Only a small number of hints decrease laziness, and anyone relying on the laziness of the original code would be advised to include a comment.-* __Removes error__ - for example `foldr1 (&&)` suggests and including the note `Removes error on []`. The new code will produce `True` on the empty list, while the old code would raise an error. Unless you are relying on the exception thrown by the empty list, this hint is safe - and if you do rely on the exception, you would be advised to add a comment.+* __Decreases laziness__ - for example `(fst a, snd a)` suggests `a` including this note. On evaluation the new code will raise an error if a is an error, while the old code would produce a pair containing two error values. Only a small number of hints decrease laziness, and anyone relying on the laziness of the original code would be advised to include a comment.+* __Removes error__ - for example `foldr1 (&&)` suggests `and` including the note `Removes error on []`. The new code will produce `True` on the empty list, while the old code would raise an error. Unless you are relying on the exception thrown by the empty list, this hint is safe - and if you do rely on the exception, you would be advised to add a comment.  ### What is the difference between error/warning/suggestion? @@ -192,14 +205,15 @@ Short answer: yes, it is!  If the language extension `OverloadedStrings` is enabled, `ghci` may however report error messages such as:-```++```console Ambiguous type variable ‘t0’ arising from an annotation prevents the constraint ‘(Data.Data.Data t0)’ from being solved. ```  In this case, a solution is to add the `:: String` type annotation.  For example: -```+```haskell {-# ANN someFunc ("HLint: ignore Use fmap" :: String) #-} ``` @@ -209,7 +223,9 @@  To customize the hints given by HLint, create a file `.hlint.yaml` in the root of your project. For a suitable default run: -    hlint --default > .hlint.yaml+```console+hlint --default > .hlint.yaml+```  This default configuration contains lots of examples, including: @@ -245,17 +261,21 @@  The hint suggesting `concatMap` can be defined as: -    - warn: {lhs: concat (map f x), rhs: concatMap f x}+```yaml+- 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 `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: {lhs: "null (intersect a b)", rhs: "disjoint a b"}-    - warn: {lhs: "dropWhile isSpace", rhs: "trimStart"}-    - fixity: "infixr 5 !:"+```console+$ hlint --find=src/Utils.hs+-- hints found in src/Util.hs+- 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. @@ -282,3 +302,7 @@ ```  The general syntax is `lhs -- rhs` with `lhs` being the expression you expect to be rewritten as `rhs`. The absence of `rhs` means you expect no hints to fire. In addition `???` lets you assert a warning without a particular suggestion, while `@` tags require a specific severity -- both these features are used less commonly.++### Acknowledgements++This program has only been made possible by the presence of the [haskell-src-exts](https://github.com/haskell-suite/haskell-src-exts) package, and many improvements have been made by [Niklas Broberg](http://www.nbroberg.se) in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart, Roman Leshchinskiy, Johannes Lippmann, Iustin Pop, Steve Purcell, Mitchell Rosen and others.

@@ -1,13 +1,13 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            2.0.12+version:            2.0.13 license:            BSD3 license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2006-2017+copyright:          Neil Mitchell 2006-2018 synopsis:           Source code suggestions description:     HLint gives suggestions on how to improve your source code.@@ -63,6 +63,8 @@         build-depends: hscolour >= 1.21     else         cpp-options: -DGPL_SCARES_ME+    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.18      hs-source-dirs:     src     exposed-modules:

@@ -71,10 +71,8 @@     res <- parseModuleEx (parseFlagsAddFixities [x | Infix x <- s] flags) file src     case res of         Right m -> return $ Right m-        Left (ParseError sl msg ctxt) -> do-            i <- return $ rawIdeaN Error "Parse error" (mkSrcSpan sl sl) ctxt Nothing []-            i <- return $ classify [x | SettingClassify x <- s] i-            return $ Left i+        Left (ParseError sl msg ctxt) ->+            return $ Left $ classify [x | SettingClassify x <- s] $ rawIdeaN Error "Parse error" (mkSrcSpan sl sl) ctxt Nothing []   -- | Find which hints a list of settings implies.

@@ -195,7 +195,7 @@     ,CmdHSE         {} &= explicit &= name "hse"     ] &= program "hlint" &= verbosity-    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2017")+    &=  summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2018")     where         nam xs = nam_ xs &= name [head xs]         nam_ xs = def &= explicit &= name xs

@@ -20,7 +20,7 @@ import qualified Data.HashMap.Strict as Map import HSE.All hiding (Rule, String) import Data.Functor-import Data.Monoid+import Data.Semigroup import Util import Prelude @@ -40,7 +40,7 @@ --------------------------------------------------------------------- -- YAML DATA TYPE -newtype ConfigYaml = ConfigYaml [ConfigItem] deriving (Monoid,Show)+newtype ConfigYaml = ConfigYaml [ConfigItem] deriving (Semigroup,Monoid,Show)  data ConfigItem     = ConfigPackage Package@@ -64,7 +64,7 @@ --------------------------------------------------------------------- -- YAML PARSING LIBRARY -data Val = Val +data Val = Val     Value -- the actual value I'm focused on     [(String, Value)] -- the path of values I followed (for error messages) 

@@ -1,11 +1,11 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving #-}  module HSE.Scope(     Scope, scopeCreate, scopeImports,     scopeMatch, scopeMove     ) where -import Data.Monoid+import Data.Semigroup import HSE.Type import HSE.Util import Data.List@@ -34,11 +34,7 @@ --   Note that the 'mempty' 'Scope' is not equivalent to 'scopeCreate' on an empty module, --   due to the implicit import of 'Prelude'. newtype Scope = Scope [ImportDecl S]-             deriving Show--instance Monoid Scope where-    mempty = Scope []-    mappend (Scope xs) (Scope ys) = Scope $ xs ++ ys+             deriving (Show, Monoid, Semigroup)  -- | Create a 'Scope' value from a module, based on the modules imports. scopeCreate :: Module SrcSpanInfo -> Scope

@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, ViewPatterns, FlexibleContexts, ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module HSE.Unify(     Subst, fromSubst,@@ -10,7 +11,7 @@ import Data.List.Extra import Data.Maybe import Data.Data-import Data.Monoid+import Data.Semigroup import Config.Type import Hint.Type import Control.Monad@@ -25,6 +26,7 @@ -- | A list of substitutions. A key may be duplicated, you need to call 'check' --   to ensure the substitution is valid. newtype Subst a = Subst [(String, a)]+    deriving (Semigroup, Monoid)  -- | Unpack the substitution fromSubst :: Subst a -> [(String, a)]@@ -35,10 +37,6 @@  instance Pretty a => Show (Subst a) where     show (Subst xs) = unlines [a ++ " = " ++ prettyPrint b | (a,b) <- xs]--instance Monoid (Subst a) where-    mempty = Subst []-    mappend (Subst xs) (Subst ys) = Subst $ xs ++ ys   -- check the unification is valid and simplify it

@@ -54,6 +54,10 @@ -- backup fixity resolution main = do a += b . c; return $ a . b +-- <$> bracket tests+yes = (foo . bar x) <$> baz q -- foo . bar x <$> baz q+no = foo . bar x <$> baz q+ -- annotations main = 1; {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} main = 1; {-# ANN module (1 + (2)) #-} -- 2@@ -137,15 +141,18 @@     where         f x = [suggest "Redundant $" x y [r] | InfixApp _ a d b <- [x], opExp d ~= "$"               ,let y = App an a b, not $ needBracket 0 y a, not $ needBracket 1 y b-              ,let r = Replace Expr (toSS x) [("a", toSS a), ("b", toSS b)] "a b"-                ]-+              ,let r = Replace Expr (toSS x) [("a", toSS a), ("b", toSS b)] "a b"]               ++               [suggest "Move brackets to avoid $" x (t y) [r] |(t, e@(Paren _ (InfixApp _ a1 op1 a2))) <- splitInfix x               ,opExp op1 ~= "$", isVar a1 || isApp a1 || isParen a1, not $ isAtom a2               ,not $ a1 ~= "select" -- special case for esqueleto, see #224               , let y = App an a1 (Paren an a2)               , let r = Replace Expr (toSS e) [("a", toSS a1), ("b", toSS a2)] "a (b)" ]+              +++              -- special case of (v1 . v2) <$> v3+              [suggest "Redundant bracket" x y []+              | InfixApp _ (Paren _ o1@(InfixApp _ v1 (isDot -> True) v2)) o2 v3 <- [x], opExp o2 ~= "<$>"+              , let y = InfixApp an o1 o2 v3]   -- return both sides, and a way to put them together again

@@ -123,7 +123,7 @@ import Data.Ratio import Data.Data import Refact.Types-import Data.Monoid+import Data.Semigroup import Prelude  @@ -244,10 +244,12 @@     ,derivesData :: [String]     ,derivesStandalone :: [String]     }+instance Semigroup Derives where+    Derives x1 x2 x3 <> Derives y1 y2 y3 =+        Derives (x1++y1) (x2++y2) (x3++y3) instance Monoid Derives where     mempty = Derives [] [] []-    mappend (Derives x1 x2 x3) (Derives y1 y2 y3) =-        Derives (x1++y1) (x2++y2) (x3++y3)+    mappend = (<>)  -- | What is derived on newtype, and on data type --   'deriving' declarations may be on either, so we approximate as both newtype and data

@@ -20,6 +20,11 @@ no = do bar; a <- foo; return b yes = do x <- bar; x -- do join bar no = do x <- bar; x; x+yes = do x <- bar; return (f x) -- do f <$> bar+yes = do x <- bar; return $ f x -- do f <$> bar+yes = do x <- bar; return $ f (g x) -- do f . g <$> bar+yes = do x <- bar; return (f $ g x) -- do f . g <$> bar+no = do x <- bar; return (f x x) {-# LANGUAGE RecursiveDo #-}; no = mdo hook <- mkTrigger pat (act >> rmHook hook) ; return hook yes = do x <- return y; foo x -- @Suggestion do let x = y; foo x yes = do x <- return $ y + z; foo x -- do let x = y + z; foo x@@ -63,6 +68,7 @@         (view -> App2 op x1 (view -> LamConst1 _)) | op ~= ">>=" -> f x1         Do _ xs -> [warn "Redundant return" x (Do an y) rs | Just (y, rs) <- [monadReturn xs]] ++                    [warn "Use join" x (Do an y) rs | Just (y, rs) <- [monadJoin xs ['a'..'z']]] +++                   [warn "Use fmap" x (Do an y) rs | Just (y, rs) <- [monadFmap xs]] ++                    [warn "Redundant do" x y [Replace Expr (toSS x) [("y", toSS y)] "y"]                         | [Qualifier _ y] <- [xs], not $ doOperator parent y] ++                    [suggest "Use let" x (Do an y) rs | Just (y, rs) <- [monadLet xs]] ++@@ -94,6 +100,17 @@           rs  = concatMap (\(Just (a,b,c)) -> c) res monadCall x | x2:_ <- filter (x ~=) badFuncs = let x3 = x2 ++ "_" in  Just (x3, toNamed x3, [Replace Expr (toSS x) [] x3]) monadCall _ = Nothing++monadFmap :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan])+monadFmap (reverse -> q@(Qualifier _ (let go (App _ f x) = first (f:) $ go (fromParen x)+                                          go (InfixApp _ f (isDol -> True) x) = first (f:) $ go x+                                          go x = ([], x)+                                      in go -> (ret:f:fs, view -> Var_ v))):g@(Generator _ (view -> PVar_ u) x):rest)+    | ret ~= "return", u == v, v `notElem` vars (f:fs)+    = Just (reverse (Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x):rest),+            [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " vs ++ " <$> x"), Delete Stmt (toSS q)])+  where vs = ('f':) . show <$> [0..]+monadFmap _ = Nothing  monadReturn :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan]) monadReturn (reverse -> q@(Qualifier _ (App _ ret (Var _ v))):g@(Generator _ (PVar _ p) x):rest)

@@ -17,7 +17,7 @@ import Hint.Type import Data.List import Data.Maybe-import Data.Monoid+import Data.Semigroup import Control.Applicative import Prelude @@ -39,9 +39,11 @@     {riAs :: [String]     ,riWithin :: [(String, String)]     }+instance Semigroup RestrictItem where+    RestrictItem x1 x2 <> RestrictItem y1 y2 = RestrictItem (x1<>y1) (x2<>y2) instance Monoid RestrictItem where     mempty = RestrictItem [] []-    mappend (RestrictItem x1 x2) (RestrictItem y1 y2) = RestrictItem (x1<>y1) (x2<>y2)+    mappend = (<>)  restrictions :: [Setting] -> Map.Map RestrictType (Bool, Map.Map String RestrictItem) restrictions settings = Map.map f $ Map.fromListWith (++) [(restrictType x, [x]) | SettingRestrict x <- settings]

@@ -4,7 +4,7 @@     module Export     ) where -import Data.Monoid+import Data.Semigroup import Config.Type import HSE.All  as Export import Idea     as Export@@ -26,10 +26,13 @@     ,hintComment :: [Setting] -> Comment -> [Idea] -- ^ Given a comment generate some 'Idea's.     } -instance Monoid Hint where-    mempty = Hint (\_ _ -> []) (\_ _ _ -> []) (\_ _ _ _ -> []) (\_ _ -> [])-    mappend (Hint x1 x2 x3 x4) (Hint y1 y2 y3 y4) = Hint+instance Semigroup Hint where+    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)++instance Monoid Hint where+    mempty = Hint (\_ _ -> []) (\_ _ _ -> []) (\_ _ _ _ -> []) (\_ _ -> [])+    mappend = (<>)

@@ -11,15 +11,16 @@  #else +import Data.Functor+import Prelude+ import Language.Haskell.HsColour.TTY as TTY import Language.Haskell.HsColour.Colourise import Language.Haskell.HsColour.CSS as CSS   hsColourConsole :: IO (String -> String)-hsColourConsole = do-    prefs <- readColourPrefs-    return $ TTY.hscolour prefs+hsColourConsole = TTY.hscolour <$> readColourPrefs  hsColourHTML :: String -> String hsColourHTML = CSS.hscolour False 1

@@ -9,6 +9,7 @@     Severity(..)     ) where +import Data.Functor import Data.List.Extra import Data.Char import Numeric@@ -17,6 +18,7 @@ import HsColour import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R+import Prelude   -- | An idea suggest by a 'Hint'.@@ -71,9 +73,7 @@   showANSI :: IO (Idea -> String)-showANSI = do-    f <- hsColourConsole-    return $ showEx f+showANSI = showEx <$> hsColourConsole  showEx :: (String -> String) -> Idea -> String showEx tt Idea{..} = unlines $

@@ -42,6 +42,8 @@ import Data.List.Extra import Data.Maybe import System.FilePath+import Data.Functor+import Prelude   -- | Get the Cabal configured data directory of HLint.@@ -105,8 +107,7 @@ findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([Fixity], [Classify], [Either HintBuiltin HintRule]) findSettings load start = do     (file,contents) <- load $ fromMaybe "hlint.yaml" start-    xs <- readFilesConfig [(file,contents)]-    return $ splitSettings xs+    splitSettings <$> readFilesConfig [(file,contents)]  -- | Split a list of 'Setting' for separate use in parsing and hint resolution splitSettings :: [Setting] -> ([Fixity], [Classify], [Either HintBuiltin HintRule])

@@ -3,8 +3,10 @@ -- | Check the <TEST> annotations within source and hint files. module Test.Annotations(testAnnotations) where +import Control.Exception.Extra import Data.Tuple.Extra import Data.Char+import Data.Either.Extra import Data.List.Extra import Data.Maybe import Data.Function@@ -14,6 +16,8 @@ import Apply import HSE.All import Test.Util+import Data.Functor+import Prelude   -- Input, Output@@ -27,18 +31,20 @@     mapM_ f tests     where         f (Test loc inp out) = do-            ideas <- applyHintFile defaultParseFlags setting file $ Just inp-            let good = case out of-                    Nothing -> null ideas-                    Just x -> length ideas == 1 &&-                              seq (length (show ideas)) True && -- force, mainly for hpc-                              match x (head ideas)+            ideas <- try_ $ do+                res <- applyHintFile defaultParseFlags setting file $ Just inp+                evaluate $ length $ show res+                return res+            let good = case (out, ideas) of+                    (Nothing, Right []) -> True+                    (Just x, Right [idea]) | match x idea -> True+                    _ -> False             let bad =                     [failed $-                        ["TEST FAILURE (" ++ show (length ideas) ++ " hints generated)"+                        ["TEST FAILURE (" ++ show (either (const 1) length ideas) ++ " hints generated)"                         ,"SRC: " ++ showSrcLoc loc                         ,"INPUT: " ++ inp] ++-                        map ((++) "OUTPUT: " . show) ideas +++                        map ("OUTPUT: " ++) (either (return . show) (map show) ideas) ++                         ["WANTED: " ++ fromMaybe "<failure>" out]                         | not good] ++                     [failed@@ -46,7 +52,7 @@                         ,"SRC: " ++ showSrcLoc loc                         ,"INPUT: " ++ inp                         ,"OUTPUT: " ++ show i]-                        | i@Idea{..} <- ideas, let SrcLoc{..} = getPointLoc ideaSpan, srcFilename == "" || srcLine == 0 || srcColumn == 0]+                        | i@Idea{..} <- fromRight [] ideas, let SrcLoc{..} = getPointLoc ideaSpan, srcFilename == "" || srcLine == 0 || srcColumn == 0]             if null bad then passed else sequence_ bad          match "???" _ = True@@ -59,10 +65,9 @@   parseTestFile :: FilePath -> IO [Test]-parseTestFile file = do-    src <- readFile file+parseTestFile file =     -- 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+    f False . zip [1..] . map (\x -> fromMaybe x $ stripPrefix "# " x) . lines <$> readFile file     where         open = isPrefixOf "<TEST>"         shut = isPrefixOf "</TEST>"