packages feed

hlint 3.1.1 → 3.1.2

raw patch · 30 files changed

+347/−351 lines, 30 filesdep ~ghc-lib-parser-exPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-lib-parser-ex

API changes (from Hackage documentation)

Files

CHANGES.txt view
@@ -1,5 +1,11 @@ Changelog for HLint (* = breaking change) +3.1.2, released 2020-05-24+    #1014, don't error on empty do blocks+    #1008, make redundant do ignored by default+    #1012, add CodeWorld hints around pictures+    #1003, enable refactoring for (v1 . v2) <$> v3+    #1002, warn on unused NumericUnderscores 3.1.1, released 2020-05-13     #993, deal with infix declarations in the module they occur     #993, make createModuleEx use the default HLint fixities
README.md view
@@ -86,6 +86,7 @@ * Lots of editors have HLint plugins (quite a few have more than one HLint plugin). * HLint is part of the multiple editor plugins [ghc-mod](https://hackage.haskell.org/package/ghc-mod) and [Intero](https://github.com/commercialhaskell/intero). * [HLint Source Plugin](https://github.com/ocharles/hlint-source-plugin) makes HLint available as a GHC plugin.+* [Splint](https://github.com/tfausak/splint) is another source plugin that doesn't require reparsing the GHC source if you are on the latest GHC version. * [Code Climate](https://docs.codeclimate.com/v1.0/docs/hlint) is a CI for analysis which integrates HLint. * [Danger](http://allocinit.io/haskell/danger-and-hlint/) can be used to automatically comment on pull requests with HLint suggestions. * [Restyled](https://restyled.io) includes an HLint Restyler to automatically run `hlint --refactor` on files changed in GitHub Pull Requests.
data/hlint.yaml view
@@ -50,6 +50,11 @@     - import Data.Attoparsec.Text     - import Data.Attoparsec.ByteString +- package:+    name: codeworld-api+    modules:+    - import CodeWorld+ - group:     name: default     enabled: true@@ -385,7 +390,7 @@     - 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: fmap f $ x, rhs: f <$> x, side: isApp x || isAtom x}     - hint: {lhs: \x -> a <$> b x, rhs: fmap a . b}     - hint: {lhs: x *> pure y, rhs: x Data.Functor.$> y}     - hint: {lhs: x *> return y, rhs: x Data.Functor.$> y}@@ -948,6 +953,17 @@     - hint: {lhs: maybe (f x) (f . g), rhs: f . maybe x g, note: IncreasesLaziness, name: Too strict maybe}     - hint: {lhs: maybe (f x) f y, rhs: f (Data.Maybe.fromMaybe x y), note: IncreasesLaziness, name: Too strict maybe} +- group:+    name: codeworld+    enabled: false+    imports:+    - package base+    - package codeworld-api+    rules:+    - warn: {lhs: "pictures [ p ]", rhs: p, name: Evaluate}+    - warn: {lhs: "pictures [ p, q ]", rhs: p & q, name: Evaluate}+    - hint: {lhs: foldl1 (&), rhs: pictures}+    - hint: {lhs: foldr (&) blank, rhs: pictures}  - group:     name: teaching@@ -1078,7 +1094,7 @@ # pairs (x:xs) = map (x,) xs ++ pairs xs # {-# ANN foo "HLint: ignore" #-};foo = map f (map g x) -- @Ignore ??? # {-# HLINT ignore foo #-};foo = map f (map g x) -- @Ignore ???-# yes = fmap lines $ abc 123 -- lines Control.Applicative.<$> abc 123+# yes = fmap lines $ abc 123 -- lines <$> abc 123 # no = fmap lines $ abc $ def 123 # test = foo . not . not -- id # test = map (not . not) xs -- id
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            3.1.1+version:            3.1.2 license:            BSD3 license-file:       LICENSE category:           Development@@ -76,7 +76,7 @@       build-depends:           ghc-lib-parser == 8.10.*     build-depends:-        ghc-lib-parser-ex >= 8.10.0.6 && < 8.10.1+        ghc-lib-parser-ex >= 8.10.0.11 && < 8.10.1      if flag(gpl)         build-depends: hscolour >= 1.21@@ -119,7 +119,6 @@         GHC.Util.Module         GHC.Util.SrcLoc         GHC.Util.DynFlags-        GHC.Util.RdrName         GHC.Util.Scope         GHC.Util.Unify
src/Config/Compute.hs view
@@ -13,10 +13,11 @@ import RdrName import Name import Bag+import SrcLoc import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable-import SrcLoc+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Prelude  @@ -58,7 +59,7 @@ findExp :: IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting] findExp name vs (HsLam _ MG{mg_alts=L _ [L _ Match{m_pats, m_grhss=GRHSs{grhssGRHSs=[L _ (GRHS _ [] x)], grhssLocalBinds=L _ (EmptyLocalBinds _)}}]})     = if length m_pats == length ps then findExp name (vs++ps) $ unLoc x else []-    where ps = [occNameString $ occName $ unLoc x | L _ (VarPat _ x) <- m_pats]+    where ps = [rdrNameStr x | L _ (VarPat _ x) <- m_pats] findExp name vs HsLam{} = [] findExp name vs HsVar{} = [] findExp name vs (OpApp _ x dot y) | isDot dot = findExp name (vs++["_hlint"]) $@@ -69,10 +70,10 @@         mempty (extendInstances lhs) (extendInstances $ fromParen rhs) Nothing]     where         lhs = fromParen $ noLoc $ transform f bod-        rhs = apps' $ map noLoc $ HsVar noExtField (noLoc name) : map snd rep+        rhs = apps $ map noLoc $ HsVar noExtField (noLoc name) : map snd rep          rep = zip vs $ map (mkVar . pure) ['a'..]-        f (HsVar _ x) | Just y <- lookup (occNameString $ occName $ unLoc x) rep = y+        f (HsVar _ x) | Just y <- lookup (rdrNameStr x) rep = y         f (OpApp _ x dol y) | isDol dol = HsApp noExtField x $ noLoc $ HsPar noExtField y         f x = x
src/Config/Haskell.hs view
@@ -22,10 +22,10 @@ import GHC.Hs.Lit import FastString import ApiAnnotation-import OccName import Outputable  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  -- | 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.@@ -33,8 +33,8 @@ readPragma (HsAnnotation _ _ provenance expr) = f expr     where         name = case provenance of-            ValueAnnProvenance (L _ x) -> occNameString $ occName x-            TypeAnnProvenance (L _ x) -> occNameString $ occName x+            ValueAnnProvenance (L _ x) -> occNameStr x+            TypeAnnProvenance (L _ x) -> occNameStr x             ModuleAnnProvenance -> ""          f (L _ (HsLit _ (HsString _ (unpackFS -> s)))) | "hlint:" `isPrefixOf` lower s =
src/Config/Yaml.hs view
@@ -37,8 +37,9 @@ import SrcLoc import RdrName import OccName-import GHC.Util (baseDynFlags, Scope,scopeCreate)+import GHC.Util (baseDynFlags, Scope, scopeCreate) import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Data.Char  @@ -300,7 +301,7 @@     where         (ls, rs) = both f (lhs, rhs)         f :: LHsExpr GhcPs -> [String]-        f x = [y | L _ (HsVar _ (L _ x)) <- universe x, let y = occNameString $ rdrNameOcc x, not $ isUnifyVar y, y /= "."]+        f x = [y | L _ (HsVar _ (L _ x)) <- universe x, let y = occNameStr x, not $ isUnifyVar y, y /= "."]   asNote :: String -> Note
src/Fixity.hs view
@@ -13,6 +13,7 @@ import RdrName import SrcLoc import BasicTypes+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Language.Haskell.GhclibParserEx.Fixity  -- Lots of things define a fixity. None define it quite right, so let's have our own type.@@ -27,7 +28,7 @@  fromFixitySig :: FixitySig GhcPs -> [FixityInfo] fromFixitySig (FixitySig _ names (Fixity _ i dir)) =-    [(occNameString $ occName $ unLoc name, f dir, i) | name <- names]+    [(rdrNameStr name, f dir, i) | name <- names]     where         f InfixL = LeftAssociative         f InfixR = RightAssociative
src/GHC/Util.hs view
@@ -11,7 +11,6 @@   , module GHC.Util.SrcLoc   , module GHC.Util.DynFlags   , module GHC.Util.Scope-  , module GHC.Util.RdrName   , module GHC.Util.Unify   , parsePragmasIntoDynFlags   , fileToModule@@ -28,7 +27,6 @@ import GHC.Util.Module import GHC.Util.SrcLoc import GHC.Util.DynFlags-import GHC.Util.RdrName import GHC.Util.Scope import GHC.Util.Unify
src/GHC/Util/HsDecl.hs view
@@ -4,8 +4,8 @@ where  import GHC.Hs-import OccName import SrcLoc+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  -- | @declName x@ returns the \"new name\" that is created (for -- example a function declaration) by @x@.  If @x@ isn't a declaration@@ -14,7 +14,7 @@ -- want to tell users to rename binders that they aren't creating -- right now and therefore usually cannot change. declName :: LHsDecl GhcPs -> Maybe String-declName (L _ x) = occNameString . occName <$> case x of+declName (L _ x) = occNameStr <$> case x of     TyClD _ FamDecl{tcdFam=FamilyDecl{fdLName}} -> Just $ unLoc fdLName     TyClD _ SynDecl{tcdLName} -> Just $ unLoc tcdLName     TyClD _ DataDecl{tcdLName} -> Just $ unLoc tcdLName@@ -31,6 +31,6 @@   bindName :: LHsBind GhcPs -> Maybe String-bindName (L _ FunBind{fun_id}) = Just $ occNameString $ occName $ unLoc fun_id-bindName (L _ VarBind{var_id}) = Just $ occNameString $ occName var_id+bindName (L _ FunBind{fun_id}) = Just $ rdrNameStr fun_id+bindName (L _ VarBind{var_id}) = Just $ occNameStr var_id bindName _ = Nothing
src/GHC/Util/HsExpr.hs view
@@ -3,13 +3,13 @@ {-# LANGUAGE TupleSections #-}  module GHC.Util.HsExpr (-    dotApps', lambda-  , simplifyExp', niceLambda', niceLambdaR'+    dotApps, lambda+  , simplifyExp, niceLambda, niceLambdaR   , Brackets(..)-  , rebracket1', appsBracket', transformAppsM', fromApps', apps', universeApps', universeParentExp'-  , paren'-  , replaceBranches'-  , needBracketOld', transformBracketOld', fromParen1'+  , rebracket1, appsBracket, transformAppsM, fromApps, apps, universeApps, universeParentExp+  , paren+  , replaceBranches+  , needBracketOld, transformBracketOld, fromParen1   , allowLeftSection, allowRightSection ) where @@ -41,62 +41,63 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  -- | 'dotApp a b' makes 'a . b'.-dotApp' :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs-dotApp' x y = noLoc $ OpApp noExtField x (noLoc $ HsVar noExtField (noLoc $ mkVarUnqual (fsLit "."))) y+dotApp :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs+dotApp x y = noLoc $ OpApp noExtField x (noLoc $ HsVar noExtField (noLoc $ mkVarUnqual (fsLit "."))) y -dotApps' :: [LHsExpr GhcPs] -> LHsExpr GhcPs-dotApps' [] = error "GHC.Util.HsExpr.dotApps', does not work on an empty list"-dotApps' [x] = x-dotApps' (x : xs) = dotApp' x (dotApps' xs)+dotApps :: [LHsExpr GhcPs] -> LHsExpr GhcPs+dotApps [] = error "GHC.Util.HsExpr.dotApps', does not work on an empty list"+dotApps [x] = x+dotApps (x : xs) = dotApp x (dotApps xs)  -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@ lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs lambda vs body = noLoc $ HsLam noExtField (MG noExtField (noLoc [noLoc $ Match noExtField LambdaExpr vs (GRHSs noExtField [noLoc $ GRHS noExtField [] body] (noLoc $ EmptyLocalBinds noExtField))]) Generated)  -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic.-paren' :: LHsExpr GhcPs -> LHsExpr GhcPs-paren' x+paren :: LHsExpr GhcPs -> LHsExpr GhcPs+paren x   | isAtom x  = x   | otherwise = addParen x -universeParentExp' :: Data a => a -> [(Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs)]-universeParentExp' xs = concat [(Nothing, x) : f x | x <- childrenBi xs]+universeParentExp :: Data a => a -> [(Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs)]+universeParentExp xs = concat [(Nothing, x) : f x | x <- childrenBi xs]     where f p = concat [(Just (i,p), c) : f c | (i,c) <- zipFrom 0 $ children p]  -apps' :: [LHsExpr GhcPs] -> LHsExpr GhcPs-apps' = foldl1' mkApp where mkApp x y = noLoc (HsApp noExtField x y)+apps :: [LHsExpr GhcPs] -> LHsExpr GhcPs+apps = foldl1' mkApp where mkApp x y = noLoc (HsApp noExtField x y) -fromApps' :: LHsExpr GhcPs  -> [LHsExpr GhcPs]-fromApps' (L _ (HsApp _ x y)) = fromApps' x ++ [y]-fromApps' x = [x]+fromApps :: LHsExpr GhcPs  -> [LHsExpr GhcPs]+fromApps (L _ (HsApp _ x y)) = fromApps x ++ [y]+fromApps x = [x] -childrenApps' :: LHsExpr GhcPs -> [LHsExpr GhcPs]-childrenApps' (L _ (HsApp _ x y)) = childrenApps' x ++ [y]-childrenApps' x = children x+childrenApps :: LHsExpr GhcPs -> [LHsExpr GhcPs]+childrenApps (L _ (HsApp _ x y)) = childrenApps x ++ [y]+childrenApps x = children x -universeApps' :: LHsExpr GhcPs -> [LHsExpr GhcPs]-universeApps' x = x : concatMap universeApps' (childrenApps' x)+universeApps :: LHsExpr GhcPs -> [LHsExpr GhcPs]+universeApps x = x : concatMap universeApps (childrenApps x) -descendAppsM' :: Monad m => (LHsExpr GhcPs  -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)-descendAppsM' f (L l (HsApp _ x y)) = liftA2 (\x y -> L l $ HsApp noExtField x y) (descendAppsM' f x) (f y)-descendAppsM' f x = descendM f x+descendAppsM :: Monad m => (LHsExpr GhcPs  -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)+descendAppsM f (L l (HsApp _ x y)) = liftA2 (\x y -> L l $ HsApp noExtField x y) (descendAppsM f x) (f y)+descendAppsM f x = descendM f x -transformAppsM' :: Monad m => (LHsExpr GhcPs -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)-transformAppsM' f x = f =<< descendAppsM' (transformAppsM' f) x+transformAppsM :: Monad m => (LHsExpr GhcPs -> m (LHsExpr GhcPs)) -> LHsExpr GhcPs -> m (LHsExpr GhcPs)+transformAppsM f x = f =<< descendAppsM (transformAppsM f) x -descendIndex' :: Data a => (Int -> a -> a) -> a -> a-descendIndex' f x = flip evalState 0 $ flip descendM x $ \y -> do+descendIndex :: Data a => (Int -> a -> a) -> a -> a+descendIndex f x = flip evalState 0 $ flip descendM x $ \y -> do     i <- get     modify (+1)     pure $ f i y  --  There are differences in pretty-printing between GHC and HSE. This --  version never removes brackets.-descendBracket' :: (LHsExpr GhcPs -> (Bool, LHsExpr GhcPs)) -> LHsExpr GhcPs -> LHsExpr GhcPs-descendBracket' op x = descendIndex' g x+descendBracket :: (LHsExpr GhcPs -> (Bool, LHsExpr GhcPs)) -> LHsExpr GhcPs -> LHsExpr GhcPs+descendBracket op x = descendIndex g x     where         g i y = if a then f i b else b             where (a, b) = op y@@ -104,40 +105,40 @@         f _ y = y  -- Add brackets as suggested 'needBracket at 1-level of depth.-rebracket1' :: LHsExpr GhcPs -> LHsExpr GhcPs-rebracket1' = descendBracket' (True, )+rebracket1 :: LHsExpr GhcPs -> LHsExpr GhcPs+rebracket1 = descendBracket (True, )  -- A list of application, with any necessary brackets.-appsBracket' :: [LHsExpr GhcPs] -> LHsExpr GhcPs-appsBracket' = foldl1 mkApp-  where mkApp x y = rebracket1' (noLoc $ HsApp noExtField x y)+appsBracket :: [LHsExpr GhcPs] -> LHsExpr GhcPs+appsBracket = foldl1 mkApp+  where mkApp x y = rebracket1 (noLoc $ HsApp noExtField x y)  -simplifyExp' :: LHsExpr GhcPs -> LHsExpr GhcPs+simplifyExp :: LHsExpr GhcPs -> LHsExpr GhcPs -- Replace appliciations 'f $ x' with 'f (x)'.-simplifyExp' (L l (OpApp _ x op y)) | isDol op = L l (HsApp noExtField x (noLoc (HsPar noExtField y)))-simplifyExp' e@(L _ (HsLet _ (L _ (HsValBinds _ (ValBinds _ binds []))) z)) =+simplifyExp (L l (OpApp _ x op y)) | isDol op = L l (HsApp noExtField x (noLoc (HsPar noExtField y)))+simplifyExp e@(L _ (HsLet _ (L _ (HsValBinds _ (ValBinds _ binds []))) z)) =   -- An expression of the form, 'let x = y in z'.   case bagToList binds of     [L _ (FunBind _ _(MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _) [] (GRHSs _[L _ (GRHS _ [] y)] (L _ (EmptyLocalBinds _))))]) _) _ _)]          -- If 'x' is not in the free variables of 'y', beta-reduce to          -- 'z[(y)/x]'.-      | occNameString (rdrNameOcc x) `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->+      | occNameStr x `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->           transform f z-          where f (view -> Var_ x') | occNameString (rdrNameOcc x) == x' = paren' y+          where f (view -> Var_ x') | occNameStr x == x' = paren y                 f x = x     _ -> e-simplifyExp' e = e+simplifyExp e = e  -- Rewrite '($) . b' as 'b'.-niceDotApp' :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs-niceDotApp' (L _ (HsVar _ (L _ r))) b | occNameString (rdrNameOcc r) == "$" = b-niceDotApp' a b = dotApp' a b+niceDotApp :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs+niceDotApp (L _ (HsVar _ (L _ r))) b | occNameStr r == "$" = b+niceDotApp a b = dotApp a b   -- Generate a lambda expression but prettier if possible.-niceLambda' :: [String] -> LHsExpr GhcPs -> LHsExpr GhcPs-niceLambda' ss e = fst (niceLambdaR' ss e)-- We don't support refactorings yet.+niceLambda :: [String] -> LHsExpr GhcPs -> LHsExpr GhcPs+niceLambda ss e = fst (niceLambdaR ss e)-- We don't support refactorings yet.  allowRightSection :: String -> Bool allowRightSection x = x `notElem` ["-","#"]@@ -146,28 +147,28 @@  -- Implementation. Try to produce special forms (e.g. sections, -- compositions) where we can.-niceLambdaR' :: [String]+niceLambdaR :: [String]              -> LHsExpr GhcPs              -> (LHsExpr GhcPs, R.SrcSpan              -> [Refactoring R.SrcSpan]) -- Rewrite @\ -> e@ as @e@ -- These are encountered as recursive calls.-niceLambdaR' xs (SimpleLambda [] x) = niceLambdaR' xs x+niceLambdaR xs (SimpleLambda [] x) = niceLambdaR xs x  -- Rewrite @\xs -> (e)@ as @\xs -> e@.-niceLambdaR' xs (L _ (HsPar _ x)) = niceLambdaR' xs x+niceLambdaR xs (L _ (HsPar _ x)) = niceLambdaR xs x  -- @\vs v -> ($) e v@ ==> @\vs -> e@ -- @\vs v -> e $ v@ ==> @\vs -> e@-niceLambdaR' (unsnoc -> Just (vs, v)) (view -> App2 f e (view -> Var_ v'))+niceLambdaR (unsnoc -> Just (vs, v)) (view -> App2 f e (view -> Var_ v'))   | isDol f   , v == v'   , vars e `disjoint` [v]-  = niceLambdaR' vs e+  = niceLambdaR vs e  -- @\v -> thing + v@ ==> @\v -> (thing +)@  (heuristic: @v@ must be a single -- lexeme, or it all gets too complex)-niceLambdaR' [v] (L _ (OpApp _ e f (view -> Var_ v')))+niceLambdaR [v] (L _ (OpApp _ e f (view -> Var_ v')))   | isLexeme e   , v == v'   , vars e `disjoint` [v]@@ -176,50 +177,50 @@   = (noLoc $ HsPar noExtField $ noLoc $ SectionL noExtField e f, \s -> [Replace Expr s [] (unsafePrettyPrint e)])  -- @\vs v -> f x v@ ==> @\vs -> f x@-niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (HsApp _ f (view -> Var_ v')))+niceLambdaR (unsnoc -> Just (vs, v)) (L _ (HsApp _ f (view -> Var_ v')))   | v == v'   , vars f `disjoint` [v]-  = niceLambdaR' vs f+  = niceLambdaR vs f  -- @\vs v -> (v `f`)@ ==> @\vs -> f@-niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (SectionL _ (view -> Var_ v') f))-  | v == v' = niceLambdaR' vs f+niceLambdaR (unsnoc -> Just (vs, v)) (L _ (SectionL _ (view -> Var_ v') f))+  | v == v' = niceLambdaR vs f  -- Strip one variable pattern from the end of a lambdas match, and place it in our list of factoring variables.-niceLambdaR' xs (SimpleLambda ((view -> PVar_ v):vs) x)-  | v `notElem` xs = niceLambdaR' (xs++[v]) $ lambda vs x+niceLambdaR xs (SimpleLambda ((view -> PVar_ v):vs) x)+  | v `notElem` xs = niceLambdaR (xs++[v]) $ lambda vs x  -- Rewrite @\x -> x + a@ as @(+ a)@ (heuristic: @a@ must be a single -- lexeme, or it all gets too complex).-niceLambdaR' [x] (view -> App2 op@(L _ (HsVar _ (L _ tag))) l r)-  | isLexeme r, view l == Var_ x, x `notElem` vars r, allowRightSection (occNameString $ rdrNameOcc tag) =-      let e = rebracket1' $ addParen (noLoc $ SectionR noExtField op r)+niceLambdaR [x] (view -> App2 op@(L _ (HsVar _ (L _ tag))) l r)+  | isLexeme r, view l == Var_ x, x `notElem` vars r, allowRightSection (occNameStr tag) =+      let e = rebracket1 $ addParen (noLoc $ SectionR noExtField op r)       in (e, \s -> [Replace Expr s [] (unsafePrettyPrint e)]) -- Rewrite (1) @\x -> f (b x)@ as @f . b@, (2) @\x -> f $ b x@ as @f . b@.-niceLambdaR' [x] y+niceLambdaR [x] y   | Just (z, subts) <- factor y, x `notElem` vars z = (z, \s -> [mkRefact subts s])   where     -- Factor the expression with respect to x.     factor :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])     factor y@(L _ (HsApp _ ini lst)) | view lst == Var_ x = Just (ini, [ini])     factor y@(L _ (HsApp _ ini lst)) | Just (z, ss) <- factor lst-      = let r = niceDotApp' ini z+      = let r = niceDotApp ini z         in if astEq r z then Just (r, ss) else Just (r, ini : ss)     factor (L _ (OpApp _ y op (factor -> Just (z, ss))))| isDol op-      = let r = niceDotApp' y z+      = let r = niceDotApp y z         in if astEq r z then Just (r, ss) else Just (r, y : ss)     factor (L _ (HsPar _ y@(L _ HsApp{}))) = factor y     factor _ = Nothing     mkRefact :: [LHsExpr GhcPs] -> R.SrcSpan -> Refactoring R.SrcSpan     mkRefact subts s =       let tempSubts = zipWith (\a b -> ([a], toSS b)) ['a' .. 'z'] subts-          template = dotApps' (map (strToVar . fst) tempSubts)+          template = dotApps (map (strToVar . fst) tempSubts)       in Replace Expr s tempSubts (unsafePrettyPrint template) -- Rewrite @\x y -> x + y@ as @(+)@.-niceLambdaR' [x,y] (L _ (OpApp _ (view -> Var_ x1) op@(L _ HsVar {}) (view -> Var_ y1)))+niceLambdaR [x,y] (L _ (OpApp _ (view -> Var_ x1) op@(L _ HsVar {}) (view -> Var_ y1)))     | x == x1, y == y1, vars op `disjoint` [x, y] = (op, \s -> [Replace Expr s [] (unsafePrettyPrint op)]) -- Rewrite @\x y -> f y x@ as @flip f@.-niceLambdaR' [x, y] (view -> App2 op (view -> Var_ y1) (view -> Var_ x1))+niceLambdaR [x, y] (view -> App2 op (view -> Var_ y1) (view -> Var_ x1))   | x == x1, y == y1, vars op `disjoint` [x, y] =       ( gen op       , \s -> [Replace Expr s [("x", toSS op)] (unsafePrettyPrint $ gen (strToVar "x"))]@@ -229,9 +230,9 @@  -- We're done factoring, but have no variables left, so we shouldn't make a lambda. -- @\ -> e@ ==> @e@-niceLambdaR' [] e = (e, const [])+niceLambdaR [] e = (e, const []) -- Base case. Just a good old fashioned lambda.-niceLambdaR' ss e =+niceLambdaR ss e =   let grhs = noLoc $ GRHS noExtField [] e :: LGRHS GhcPs (LHsExpr GhcPs)       grhss = GRHSs {grhssExt = noExtField, grhssGRHSs=[grhs], grhssLocalBinds=noLoc $ EmptyLocalBinds noExtField}       match = noLoc $ Match {m_ext=noExtField, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)@@ -241,10 +242,10 @@  -- 'case' and 'if' expressions have branches, nothing else does (this -- doesn't consider 'HsMultiIf' perhaps it should?).-replaceBranches' :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)-replaceBranches' (L l (HsIf _ _ a b c)) = ([b, c], \[b, c] -> cL l (HsIf noExtField Nothing a b c))+replaceBranches :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)+replaceBranches (L l (HsIf _ _ a b c)) = ([b, c], \[b, c] -> cL l (HsIf noExtField Nothing a b c)) -replaceBranches' (L s (HsCase _ a (MG _ (L l bs) FromSource))) =+replaceBranches (L s (HsCase _ a (MG _ (L l bs) FromSource))) =   (concatMap f bs, \xs -> cL s (HsCase noExtField a (MG noExtField (cL l (g bs xs)) Generated)))   where     f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]@@ -258,30 +259,30 @@     g [] [] = []     g _ _ = error "GHC.Util.HsExpr.replaceBranches': internal invariant failed, lists are of differing lengths" -replaceBranches' x = ([], \[] -> x)+replaceBranches x = ([], \[] -> x)   -- Like needBracket, but with a special case for 'a . b . b', which was -- removed from haskell-src-exts-util-0.2.2.-needBracketOld' :: Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool-needBracketOld' i parent child+needBracketOld :: Int -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool+needBracketOld i parent child   | isDotApp parent, isDotApp child, i == 2 = False   | otherwise = needBracket i parent child -transformBracketOld' :: (LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)) -> LHsExpr GhcPs -> (LHsExpr GhcPs, LHsExpr GhcPs)-transformBracketOld' op = first snd . g+transformBracketOld :: (LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)) -> LHsExpr GhcPs -> (LHsExpr GhcPs, LHsExpr GhcPs)+transformBracketOld op = first snd . g   where-    g = first f . descendBracketOld' g+    g = first f . descendBracketOld g     f x = maybe (False, x) (True, ) (op x)  -- Descend, and if something changes then add/remove brackets -- appropriately. Returns (suggested replacement, refactor template). -- Whenever a bracket is added to the suggested replacement, a -- corresponding bracket is added to the refactor template.-descendBracketOld' :: (LHsExpr GhcPs -> ((Bool, LHsExpr GhcPs), LHsExpr GhcPs))+descendBracketOld :: (LHsExpr GhcPs -> ((Bool, LHsExpr GhcPs), LHsExpr GhcPs))                    -> LHsExpr GhcPs                    -> (LHsExpr GhcPs, LHsExpr GhcPs)-descendBracketOld' op x = (descendIndex' g1 x, descendIndex' g2 x)+descendBracketOld op x = (descendIndex g1 x, descendIndex g2 x)   where     g i y = if a then (f1 i b z, f2 i b z) else (b, z)       where ((a, b), z) = op y@@ -289,13 +290,13 @@     g1 = (fst .) . g     g2 = (snd .) . g -    f i (L _ (HsPar _ y)) z | not $ needBracketOld' i x y = (y, z)-    f i y z                 | needBracketOld' i x y = (addParen y, addParen z)+    f i (L _ (HsPar _ y)) z | not $ needBracketOld i x y = (y, z)+    f i y z                 | needBracketOld i x y = (addParen y, addParen z)     f _ y z                 = (y, z)      f1 = ((fst .) .) . f     f2 = ((snd .) .) . f -fromParen1' :: LHsExpr GhcPs -> LHsExpr GhcPs-fromParen1' (L _ (HsPar _ x)) = x-fromParen1' x = x+fromParen1 :: LHsExpr GhcPs -> LHsExpr GhcPs+fromParen1 (L _ (HsPar _ x)) = x+fromParen1 x = x
− src/GHC/Util/RdrName.hs 
@@ -1,24 +0,0 @@-module GHC.Util.RdrName (isSpecial', unqual', rdrNameStr',fromQual') where--import SrcLoc-import Name-import RdrName--rdrNameStr' :: Located RdrName -> String-rdrNameStr' = occNameString . rdrNameOcc . unLoc---- Builtin type or data constructors.-isSpecial' :: Located RdrName -> Bool-isSpecial' (L _ (Exact n)) = isDataConName n || isTyConName n-isSpecial' _ = False---- Coerce qualified names to unqualified (by discarding the--- qualifier).-unqual' :: Located RdrName -> Located RdrName-unqual' (L loc (Qual _ n)) = cL loc $ mkRdrUnqual n-unqual' x = x--fromQual' :: Located RdrName -> Maybe OccName-fromQual' (L _ (Qual _ x)) = Just x-fromQual' (L _ (Unqual x)) = Just x-fromQual' _ = Nothing
src/GHC/Util/Scope.hs view
@@ -16,7 +16,7 @@ import OccName  import GHC.Util.Module-import GHC.Util.RdrName+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable  import Data.List.Extra@@ -55,19 +55,19 @@ -- candidate modules where the two names arise is non-empty. scopeMatch :: (Scope, Located RdrName) -> (Scope, Located RdrName) -> Bool scopeMatch (a, x) (b, y)-  | isSpecial' x && isSpecial' y = rdrNameStr' x == rdrNameStr' y-  | isSpecial' x || isSpecial' y = False+  | isSpecial x && isSpecial y = rdrNameStr x == rdrNameStr y+  | isSpecial x || isSpecial y = False   | otherwise =-     rdrNameStr' (unqual' x) == rdrNameStr' (unqual' y) && not (possModules a x `disjoint` possModules b y)+     rdrNameStr (unqual x) == rdrNameStr (unqual y) && not (possModules a x `disjoint` possModules b y)  -- 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, pick a plausible candidate. scopeMove :: (Scope, Located RdrName) -> Scope -> Located RdrName-scopeMove (a, x@(fromQual' -> Just name)) (Scope b) = case imps of+scopeMove (a, x@(fromQual -> Just name)) (Scope b) = case imps of   [] -> headDef x real   imp:_ | all (\x -> ideclQualified x /= NotQualified) imps -> noLoc $ mkRdrQual (unLoc . fromMaybe (ideclName imp) $ firstJust ideclAs imps) name-        | otherwise -> unqual' x+        | otherwise -> unqual x   where     real :: [Located RdrName]     real = [noLoc $ mkRdrQual m name | m <- possModules a x]@@ -86,14 +86,14 @@     res = [unLoc $ ideclName $ unLoc i | i <- is, possImport i x]      f :: Located RdrName -> [ModuleName]-    f n | isSpecial' n = [mkModuleName ""]+    f n | isSpecial n = [mkModuleName ""]     f (L _ (Qual mod _)) = [mod | null res] ++ res     f _ = res  -- Determine if 'x' could possibly lie in the module named by the -- import declaration 'i'. possImport :: LImportDecl GhcPs -> Located RdrName -> Bool-possImport i n | isSpecial' n = False+possImport i n | isSpecial n = False possImport (L _ i) (L _ (Qual mod x)) =   mod `elem` ms && possImport (noLoc i{ideclQualified=NotQualified}) (noLoc $ mkRdrUnqual x)   where ms = map unLoc $ ideclName i : maybeToList (ideclAs i)
src/GHC/Util/SrcLoc.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}  module GHC.Util.SrcLoc (-    stripLocs'+    stripLocs   , SrcSpanD(..)   ) where @@ -14,8 +14,8 @@  -- 'stripLocs x' is 'x' with all contained source locs replaced by -- 'noSrcSpan'.-stripLocs' :: (Data from, HasSrcSpan from) => from -> from-stripLocs' = transformBi (const noSrcSpan)+stripLocs :: (Data from, HasSrcSpan from) => from -> from+stripLocs = transformBi (const noSrcSpan)  -- 'Duplicates.hs' requires 'SrcSpan' be in 'Default'. newtype SrcSpanD = SrcSpanD SrcSpan
src/GHC/Util/Unify.hs view
@@ -2,8 +2,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}  module GHC.Util.Unify(-    Subst', fromSubst',-    validSubst', removeParens, substitute',+    Subst, fromSubst,+    validSubst, removeParens, substitute,     unifyExp     ) where @@ -19,13 +19,12 @@ import SrcLoc import Outputable hiding ((<>)) import RdrName-import OccName  import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import GHC.Util.HsExpr-import GHC.Util.RdrName import GHC.Util.View  isUnifyVar :: String -> Bool@@ -38,70 +37,70 @@  -- 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)]+newtype Subst a = Subst [(String, a)]     deriving (Semigroup, Monoid, Functor)  -- Unpack the substitution.-fromSubst' :: Subst' a -> [(String, a)]-fromSubst' (Subst' xs) = xs+fromSubst :: Subst a -> [(String, a)]+fromSubst (Subst xs) = xs -instance Outputable a => Show (Subst' a) where-    show (Subst' xs) = unlines [a ++ " = " ++ unsafePrettyPrint b | (a,b) <- xs]+instance Outputable a => Show (Subst a) where+    show (Subst xs) = unlines [a ++ " = " ++ unsafePrettyPrint b | (a,b) <- xs]  -- Check the unification is valid and simplify it.-validSubst' :: (a -> a -> Bool) -> Subst' a -> Maybe (Subst' a)-validSubst' eq = fmap Subst' . mapM f . groupSort . fromSubst'+validSubst :: (a -> a -> Bool) -> Subst a -> Maybe (Subst a)+validSubst eq = fmap Subst . mapM f . groupSort . fromSubst     where f (x, y : ys) | all (eq y) ys = Just (x, y)           f _ = Nothing --- Remove unnecessary brackets from a Subst'. The first argument is a list of unification variables+-- Remove unnecessary brackets from a Subst. The first argument is a list of unification variables -- for which brackets should be removed from their substitutions.-removeParens :: [String] -> Subst' (LHsExpr GhcPs) -> Subst' (LHsExpr GhcPs)-removeParens noParens (Subst' xs) = Subst' $+removeParens :: [String] -> Subst (LHsExpr GhcPs) -> Subst (LHsExpr GhcPs)+removeParens noParens (Subst xs) = Subst $   map (\(x, y) -> if x `elem` noParens then (x, fromParen y) else (x, y)) xs  -- Peform a substition. -- Returns (suggested replacement, refactor template), both with brackets added -- as needed. -- Example: (traverse foo (bar baz), traverse f (x))-substitute' :: Subst' (LHsExpr GhcPs) -> LHsExpr GhcPs -> (LHsExpr GhcPs, LHsExpr GhcPs)-substitute' (Subst' bind) = transformBracketOld' exp . transformBi pat . transformBi typ+substitute :: Subst (LHsExpr GhcPs) -> LHsExpr GhcPs -> (LHsExpr GhcPs, LHsExpr GhcPs)+substitute (Subst bind) = transformBracketOld exp . transformBi pat . transformBi typ   where     exp :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)     -- Variables.-    exp (L _ (HsVar _ x)) = lookup (rdrNameStr' x) bind+    exp (L _ (HsVar _ x)) = lookup (rdrNameStr x) bind     -- Operator applications.     exp (L loc (OpApp _ lhs (L _ (HsVar _ x)) rhs))-      | Just y <- lookup (rdrNameStr' x) bind = Just (cL loc (OpApp noExtField lhs y rhs))+      | Just y <- lookup (rdrNameStr x) bind = Just (cL loc (OpApp noExtField lhs y rhs))     -- Left sections.     exp (L loc (SectionL _ exp (L _ (HsVar _ x))))-      | Just y <- lookup (rdrNameStr' x) bind = Just (cL loc (SectionL noExtField exp y))+      | Just y <- lookup (rdrNameStr x) bind = Just (cL loc (SectionL noExtField exp y))     -- Right sections.     exp (L loc (SectionR _ (L _ (HsVar _ x)) exp))-      | Just y <- lookup (rdrNameStr' x) bind = Just (cL loc (SectionR noExtField y exp))+      | Just y <- lookup (rdrNameStr x) bind = Just (cL loc (SectionR noExtField y exp))     exp _ = Nothing      pat :: LPat GhcPs -> LPat GhcPs     -- Pattern variables.     pat (L _ (VarPat _ x))-      | Just y@(L _ HsVar{}) <- lookup (rdrNameStr' x) bind = strToPat $ varToStr y+      | Just y@(L _ HsVar{}) <- lookup (rdrNameStr x) bind = strToPat $ varToStr y     pat x = x :: LPat GhcPs      typ :: LHsType GhcPs -> LHsType GhcPs     -- Type variables.     typ (L _ (HsTyVar _ _ x))-      | Just (L _ (HsAppType _ _ (HsWC _ y))) <- lookup (rdrNameStr' x) bind = y+      | Just (L _ (HsAppType _ _ (HsWC _ y))) <- lookup (rdrNameStr x) bind = y     typ x = x :: LHsType GhcPs   --------------------------------------------------------------------- -- UNIFICATION -type NameMatch' = Located RdrName -> Located RdrName -> Bool+type NameMatch = Located RdrName -> Located RdrName -> Bool  -- | Unification, obeys the property that if @unify a b = s@, then -- @substitute s a = b@.-unify' :: Data a => NameMatch' -> Bool -> a -> a -> Maybe (Subst' (LHsExpr GhcPs))+unify' :: Data a => NameMatch -> Bool -> a -> a -> Maybe (Subst (LHsExpr GhcPs)) 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@@ -109,13 +108,13 @@     | Just (x :: SrcSpan) <- cast x = Just mempty     | otherwise = unifyDef' nm x y -unifyDef' :: Data a => NameMatch' -> a -> a -> Maybe (Subst' (LHsExpr GhcPs))+unifyDef' :: Data a => NameMatch -> a -> a -> Maybe (Subst (LHsExpr GhcPs)) unifyDef' nm x y = fmap mconcat . sequence =<< gzip (unify' nm False) x y -unifyComposed' :: NameMatch'+unifyComposed' :: NameMatch                -> LHsExpr GhcPs                -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs-               -> Maybe (Subst' (LHsExpr GhcPs), Maybe (LHsExpr GhcPs))+               -> Maybe (Subst (LHsExpr GhcPs), Maybe (LHsExpr GhcPs)) unifyComposed' nm x1 y11 dot y12 =   ((, Just y11) <$> unifyExp' nm False x1 y12)     <|> case y12 of@@ -134,13 +133,13 @@ -- Example: --   x = head (drop n x) --   y = foo . bar . baz . head $ drop 2 xs---   result = (Subst' [(n, 2), (x, xs)], Just (foo . bar . baz))-unifyExp :: NameMatch' -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst' (LHsExpr GhcPs), Maybe (LHsExpr GhcPs))+--   result = (Subst [(n, 2), (x, xs)], Just (foo . bar . baz))+unifyExp :: NameMatch -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst (LHsExpr GhcPs), Maybe (LHsExpr GhcPs)) -- Match wildcard operators.-unifyExp nm root (L _ (OpApp _ lhs1 (L _ (HsVar _ (rdrNameStr' -> v))) rhs1))-                 (L _ (OpApp _ lhs2 (L _ (HsVar _ (rdrNameStr' -> op2))) rhs2))+unifyExp nm root (L _ (OpApp _ lhs1 (L _ (HsVar _ (rdrNameStr -> v))) rhs1))+                 (L _ (OpApp _ lhs2 (L _ (HsVar _ (rdrNameStr -> op2))) rhs2))     | isUnifyVar v =-        (, Nothing) . (Subst' [(v, strToVar op2)] <>) <$>+        (, Nothing) . (Subst [(v, strToVar op2)] <>) <$>         liftA2 (<>) (unifyExp' nm False lhs1 lhs2) (unifyExp' nm False rhs1 rhs2)  -- Options: match directly, and expand through '.'@@ -175,24 +174,24 @@ -- 'root = True', this is the outside of the expr. Do not expand out a -- dot at the root, since otherwise you get two matches because of -- 'readRule' (Bug #570).-unifyExp' :: NameMatch' -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst' (LHsExpr GhcPs) )+unifyExp' :: NameMatch -> Bool -> LHsExpr GhcPs -> LHsExpr GhcPs -> Maybe (Subst (LHsExpr GhcPs) ) -- Brackets are not added when expanding '$' in user code, so tolerate -- them in the match even if they aren't in the user code. unifyExp' nm root x y | not root, isPar x, not $ isPar y = unifyExp' nm root (fromParen x) y--- Don't subsitute for type apps, since no one writes rules imaginging+-- Don't subsitute for type apps, since no one writes rules imagining -- they exist.-unifyExp' nm root (L _ (HsVar _ (rdrNameStr' -> v))) y | isUnifyVar v, not $ isTypeApp y = Just $ Subst' [(v, y)]+unifyExp' nm root (L _ (HsVar _ (rdrNameStr -> v))) y | isUnifyVar v, not $ isTypeApp y = Just $ Subst [(v, y)] unifyExp' nm root (L _ (HsVar _ x)) (L _ (HsVar _ y)) | nm x y = Just mempty -unifyExp' nm root x@(L _ (OpApp _ lhs1 (L _ (HsVar _ (rdrNameStr' -> v))) rhs1))+unifyExp' nm root x@(L _ (OpApp _ lhs1 (L _ (HsVar _ (rdrNameStr -> v))) rhs1))                   y@(L _ (OpApp _ lhs2 (L _ (HsVar _ op2)) rhs2)) =   fst <$> unifyExp nm root x y-unifyExp' nm root (L _ (SectionL _ exp1 (L _ (HsVar _ (rdrNameStr' -> v)))))-                  (L _ (SectionL _ exp2 (L _ (HsVar _ (rdrNameStr' -> op2)))))-    | isUnifyVar v = (Subst' [(v, strToVar op2)] <>) <$> unifyExp' nm False exp1 exp2-unifyExp' nm root (L _ (SectionR _ (L _ (HsVar _ (rdrNameStr' -> v))) exp1))-                  (L _ (SectionR _ (L _ (HsVar _ (rdrNameStr' -> op2))) exp2))-    | isUnifyVar v = (Subst' [(v, strToVar op2)] <>) <$> unifyExp' nm False exp1 exp2+unifyExp' nm root (L _ (SectionL _ exp1 (L _ (HsVar _ (rdrNameStr -> v)))))+                  (L _ (SectionL _ exp2 (L _ (HsVar _ (rdrNameStr -> op2)))))+    | isUnifyVar v = (Subst [(v, strToVar op2)] <>) <$> unifyExp' nm False exp1 exp2+unifyExp' nm root (L _ (SectionR _ (L _ (HsVar _ (rdrNameStr -> v))) exp1))+                  (L _ (SectionR _ (L _ (HsVar _ (rdrNameStr -> op2))) exp2))+    | isUnifyVar v = (Subst [(v, strToVar op2)] <>) <$> unifyExp' nm False exp1 exp2  unifyExp' nm root x@(L _ (HsApp _ x1 x2)) y@(L _ (HsApp _ y1 y2)) =   fst <$> unifyExp nm root x y@@ -213,20 +212,20 @@ unifyExp' _ _ _ _ = Nothing  -unifyPat' :: NameMatch' -> LPat GhcPs -> LPat GhcPs -> Maybe (Subst' (LHsExpr GhcPs))+unifyPat' :: NameMatch -> LPat GhcPs -> LPat GhcPs -> Maybe (Subst (LHsExpr GhcPs)) unifyPat' nm (L _ (VarPat _ x)) (L _ (VarPat _ y)) =-  Just $ Subst' [(rdrNameStr' x, strToVar(rdrNameStr' y))]+  Just $ Subst [(rdrNameStr x, strToVar(rdrNameStr y))] unifyPat' nm (L _ (VarPat _ x)) (L _ (WildPat _)) =-  let s = rdrNameStr' x in Just $ Subst' [(s, strToVar("_" ++ s))]-unifyPat' nm (L _ (ConPatIn x _)) (L _ (ConPatIn y _)) | rdrNameStr' x /= rdrNameStr' y =+  let s = rdrNameStr x in Just $ Subst [(s, strToVar("_" ++ s))]+unifyPat' nm (L _ (ConPatIn x _)) (L _ (ConPatIn y _)) | rdrNameStr x /= rdrNameStr y =   Nothing unifyPat' nm x y =   unifyDef' nm x y -unifyType' :: NameMatch' -> LHsType GhcPs -> LHsType GhcPs -> Maybe (Subst' (LHsExpr GhcPs))+unifyType' :: NameMatch -> LHsType GhcPs -> LHsType GhcPs -> Maybe (Subst (LHsExpr GhcPs)) unifyType' nm (L loc (HsTyVar _ _ x)) y =   let wc = HsWC noExtField y :: LHsWcType (NoGhcTc GhcPs)-      unused = noLoc (HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc "__unused__"))) :: LHsExpr GhcPs+      unused = strToVar "__unused__" :: LHsExpr GhcPs       appType = cL loc (HsAppType noExtField unused wc) :: LHsExpr GhcPs- in Just $ Subst' [(rdrNameStr' x, appType)]+ in Just $ Subst [(rdrNameStr x, appType)] unifyType' nm x y = unifyDef' nm x y
src/GHC/Util/View.hs view
@@ -9,10 +9,8 @@  import GHC.Hs import SrcLoc-import RdrName-import OccName import BasicTypes-import GHC.Util.RdrName (rdrNameStr')+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs fromParen (L _ (HsPar _ x)) = fromParen x@@ -37,7 +35,7 @@   view _ = NoLamConst1  instance View (LHsExpr GhcPs) Var_ where-    view (fromParen -> (L _ (HsVar _ (rdrNameStr' -> x)))) = Var_ x+    view (fromParen -> (L _ (HsVar _ (rdrNameStr -> x)))) = Var_ x     view _ = NoVar_  instance View (LHsExpr GhcPs) App2 where@@ -46,14 +44,14 @@   view _ = NoApp2  instance View (Located (Pat GhcPs)) PVar_ where-  view (fromPParen -> L _ (VarPat _ (L _ x))) = PVar_ $ occNameString (rdrNameOcc x)+  view (fromPParen -> L _ (VarPat _ (L _ x))) = PVar_ $ occNameStr x   view _ = NoPVar_  instance View (Located (Pat GhcPs)) PApp_ where   view (fromPParen -> L _ (ConPatIn (L _ x) (PrefixCon args))) =-    PApp_ (occNameString . rdrNameOcc $ x) args+    PApp_ (occNameStr x) args   view (fromPParen -> L _ (ConPatIn (L _ x) (InfixCon lhs rhs))) =-    PApp_ (occNameString . rdrNameOcc $ x) [lhs, rhs]+    PApp_ (occNameStr x) [lhs, rhs]   view _ = NoPApp_  -- A lambda with no guards and no where clauses
src/HSE/All.hs view
@@ -21,7 +21,6 @@ import FastString  import GHC.Hs-import qualified BasicTypes as GHC import SrcLoc import ErrUtils import Outputable@@ -113,14 +112,6 @@ ghcFixitiesFromParseFlags :: ParseFlags -> [(String, Fixity)] ghcFixitiesFromParseFlags = map toFixity . fixities -ghcFixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)]-ghcFixitiesFromModule (L _ (HsModule _ _ _ decls _ _)) = concatMap f decls-  where-    f :: LHsDecl GhcPs -> [(String, Fixity)]-    f (L _ (SigD _ (FixSig _ (FixitySig _ ops (GHC.Fixity _ p dir))))) =-          fixity dir p (map rdrNameStr' ops)-    f _ = []- -- These next two functions get called frorm 'Config/Yaml.hs' for user -- defined hint rules. @@ -153,7 +144,7 @@ -- account for operator fixities (it uses the HLint default fixities). createModuleEx :: ApiAnns -> Located (HsModule GhcPs) -> ModuleEx createModuleEx anns ast =-  ModuleEx (applyFixities (ghcFixitiesFromModule ast ++ map toFixity defaultFixities) ast) anns+  ModuleEx (applyFixities (fixitiesFromModule ast ++ map toFixity defaultFixities) ast) anns  -- | Parse a Haskell module. Applies the C pre processor, and uses -- best-guess fixity resolution if there are ambiguities.  The@@ -183,7 +174,7 @@                             ( Map.fromListWith (++) $ annotations s                             , Map.fromList ((noSrcSpan, comment_q s) : annotations_comments s)                             )-                      let fixes = ghcFixitiesFromModule a ++ ghcFixitiesFromParseFlags flags+                      let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags                       pure $ Right (ModuleEx (applyFixities fixes a) anns)                 PFailed s ->                     handleParseFailure ghcFlags ppstr file str $  bagToList . snd $ getMessages s ghcFlags
src/Hint/All.hs view
@@ -75,7 +75,7 @@ -- | Transform a list of 'HintBuiltin' or 'HintRule' into a 'Hint'. resolveHints :: [Either HintBuiltin HintRule] -> Hint resolveHints xs =-  mconcat $ mempty{hintDecl=const $ readMatch' rights} : map builtin (nubOrd lefts)+  mconcat $ mempty{hintDecl=const $ readMatch rights} : map builtin (nubOrd lefts)   where (lefts,rights) = partitionEithers xs  -- | Transform a list of 'HintRule' into a 'Hint'.
src/Hint/Bracket.hs view
@@ -76,7 +76,7 @@ main = do a += b . c; return $ a . b  -- <$> bracket tests-yes = (foo . bar x) <$> baz q -- foo . bar x <$> baz q @NoRefactor: refactoring for "(v1 . v2) <$> v3" is not implemented+yes = (foo . bar x) <$> baz q -- foo . bar x <$> baz q no = foo . bar x <$> baz q  -- annotations@@ -98,7 +98,7 @@  module Hint.Bracket(bracketHint) where -import Hint.Type(DeclHint,Idea(..),rawIdea,warn,suggest,suggestRemove,Severity(..),toSS)+import Hint.Type(DeclHint,Idea(..),rawIdea,warn,suggest,suggestRemove,Severity(..),toRefactSrcSpan,toSS) import Data.Data import Data.List.Extra import Data.Generics.Uniplate.Operations@@ -245,9 +245,10 @@             , let y = noLoc $ HsApp noExtField a1 (noLoc (HsPar noExtField 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 []-          | L _ (OpApp _ (L _ (HsPar _ o1@(L _ (OpApp _ v1 (isDot -> True) v2)))) o2 v3) <- [x], varToStr o2 == "<$>"-          , let y = noLoc (OpApp noExtField o1 o2 v3) :: LHsExpr GhcPs]+          [ suggest "Redundant bracket" x y [r]+          | L _ (OpApp _ (L locPar (HsPar _ o1@(L locNoPar (OpApp _ v1 (isDot -> True) v2)))) o2 v3) <- [x], varToStr o2 == "<$>"+          , let y = noLoc (OpApp noExtField o1 o2 v3) :: LHsExpr GhcPs+          , let r = Replace Expr (toRefactSrcSpan locPar) [("a", toRefactSrcSpan locNoPar)] "a"]           ++           [ suggest "Redundant section" x y []           | L _ (HsApp _ (L _ (HsPar _ (L _ (SectionL _ a b)))) c) <- [x]
src/Hint/Duplicate.hs view
@@ -69,7 +69,7 @@     | ((m1, d1, SrcSpanD p1), (m2, d2, SrcSpanD p2), xs) <- duplicateOrdered 3 $ map f ys]     where       f (m, d, xs) =-        [((m, d, SrcSpanD (getLoc x)), extendInstances (stripLocs' x)) | x <- xs]+        [((m, d, SrcSpanD (getLoc x)), extendInstances (stripLocs x)) | x <- xs]  --------------------------------------------------------------------- -- DUPLICATE FINDING
src/Hint/Extensions.hs view
@@ -191,6 +191,12 @@ {-# LANGUAGE NamedFieldPuns #-} \ foo = bar{x} {-# LANGUAGE NamedFieldPuns #-} --+{-# LANGUAGE NumericUnderscores #-} \+lessThanPi = (< 3.141_592_653_589_793)+{-# LANGUAGE NumericUnderscores #-} \+oneMillion = 0xf4__240+{-# LANGUAGE NumericUnderscores #-} \+avogadro = 6.022140857e+23 -- {-# LANGUAGE StaticPointers #-} \ static = 42 -- {-# LANGUAGE Trustworthy #-}@@ -224,7 +230,6 @@ import BasicTypes import Class import RdrName-import OccName import ForeignCall  import GHC.Util@@ -234,8 +239,11 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.Types import Language.Haskell.GhclibParserEx.GHC.Hs.Decls+import Language.Haskell.GhclibParserEx.GHC.Hs.Binds+import Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp import Language.Haskell.GhclibParserEx.GHC.Driver.Session import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  extensionsHint :: ModuHint extensionsHint _ x =@@ -341,11 +349,11 @@ used KindSignatures = hasT (un :: HsKind GhcPs) used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch used TemplateHaskell = hasT2' (un :: (HsBracket GhcPs, HsSplice GhcPs)) ||^ hasS f ||^ hasS isSpliceDecl-    where-      f :: HsBracket GhcPs -> Bool-      f VarBr{} = True-      f TypBr{} = True-      f _ = False+  where+    f :: HsBracket GhcPs -> Bool+    f VarBr{} = True+    f TypBr{} = True+    f _ = False used ForeignFunctionInterface = hasT (un :: CCallConv) used PatternGuards = hasS f   where@@ -372,23 +380,23 @@       _ -> False      isOp :: LIdP GhcPs -> Bool-    isOp name = case occNameString (rdrNameOcc (unLoc name)) of+    isOp name = case rdrNameStr name of       (c:_) -> not $ isAlpha c || c == '_'       _ -> False used RecordWildCards = hasS hasFieldsDotDot ||^ hasS hasPFieldsDotDot used RecordPuns = hasS isPFieldPun ||^ hasS isFieldPun ||^ hasS isFieldPunUpdate used UnboxedTuples = hasS isUnboxedTuple ||^ hasS (== Unboxed) ||^ hasS isDeriving-    where-        -- detect if there are deriving declarations or data ... deriving stuff-        -- by looking for the deriving strategy both contain (even if its Nothing)-        -- see https://github.com/ndmitchell/hlint/issues/833 for why we care-        isDeriving :: Maybe (LDerivStrategy GhcPs) -> Bool-        isDeriving _ = True+  where+      -- detect if there are deriving declarations or data ... deriving stuff+      -- by looking for the deriving strategy both contain (even if its Nothing)+      -- see https://github.com/ndmitchell/hlint/issues/833 for why we care+      isDeriving :: Maybe (LDerivStrategy GhcPs) -> Bool+      isDeriving _ = True used PackageImports = hasS f-    where-        f :: ImportDecl GhcPs -> Bool-        f ImportDecl{ideclPkgQual=Just _} = True-        f _ = False+  where+      f :: ImportDecl GhcPs -> Bool+      f ImportDecl{ideclPkgQual=Just _} = True+      f _ = False used QuasiQuotes = hasS isQuasiQuote ||^ hasS isTyQuasiQuote used ViewPatterns = hasS isPViewPat used InstanceSigs = hasS f@@ -404,24 +412,23 @@ used DeriveGeneric = hasDerive ["Generic","Generic1"] used GeneralizedNewtypeDeriving = not . null . derivesNewtype' . derives used MultiWayIf = hasS isMultiIf+used NumericUnderscores = hasS f+  where+    f :: OverLitVal -> Bool+    f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` t+    f (HsFractional (FL (SourceText t) _ _)) = '_' `elem` t+    f _ = False+ used LambdaCase = hasS isLCase used TupleSections = hasS isTupleSection used OverloadedStrings = hasS isString used Arrows = hasS isProc used TransformListComp = hasS isTransStmt used MagicHash = hasS f ||^ hasS isPrimLiteral-    where-      f :: RdrName -> Bool-      f s = "#" `isSuffixOf` (occNameString . rdrNameOcc) s+  where+    f :: RdrName -> Bool+    f s = "#" `isSuffixOf` occNameStr s used PatternSynonyms = hasS isPatSynBind ||^ hasS isPatSynIE-    where-      isPatSynBind :: HsBind GhcPs -> Bool-      isPatSynBind PatSynBind{} = True-      isPatSynBind _ = False--      isPatSynIE :: IEWrappedName RdrName -> Bool-      isPatSynIE IEPattern{} = True-      isPatSynIE _ = False used _= const True  hasDerive :: [String] -> Located (HsModule GhcPs) -> Bool@@ -475,7 +482,7 @@         ih (L _ (HsQualTy _ _ a)) = ih a         ih (L _ (HsParTy _ a)) = ih a         ih (L _ (HsAppTy _ a _)) = ih a-        ih (L _ (HsTyVar _ _ a)) = unsafePrettyPrint $ unqual' a+        ih (L _ (HsTyVar _ _ a)) = unsafePrettyPrint $ unqual a         ih (L _ a) = unsafePrettyPrint a -- I don't anticipate this case is called.     derivedToStr _ = "" -- new ctor
src/Hint/Lambda.hs view
@@ -105,17 +105,17 @@ import Data.Generics.Uniplate.Operations (universe, universeBi, transformBi)  import BasicTypes-import GHC.Util.Brackets (isAtom)-import GHC.Util.FreeVars (free, allVars, freeVars, pvars, vars, varss)-import GHC.Util.HsExpr (allowLeftSection, allowRightSection, niceLambdaR', lambda)-import GHC.Util.RdrName (rdrNameStr')-import GHC.Util.View import GHC.Hs-import Language.Haskell.GhclibParserEx.GHC.Hs.Expr (isTypeApp, isOpApp, isLambda, isQuasiQuote, isVar, isDol, strToVar)-import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import OccName import RdrName import SrcLoc+import Language.Haskell.GhclibParserEx.GHC.Hs.Expr (isTypeApp, isOpApp, isLambda, isQuasiQuote, isVar, isDol, strToVar)+import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader+import GHC.Util.Brackets (isAtom)+import GHC.Util.FreeVars (free, allVars, freeVars, pvars, vars, varss)+import GHC.Util.HsExpr (allowLeftSection, allowRightSection, niceLambdaR, lambda)+import GHC.Util.View  lambdaHint :: DeclHint lambdaHint _ _ x@@ -181,7 +181,7 @@     = [suggestN "Use section" o $ noLoc $ HsPar noExtField $ noLoc $ SectionR noExtField origf y] lambdaExp p o@(L _ HsLam{})     | not $ any isOpApp p-    , (res, refact) <- niceLambdaR' [] o+    , (res, refact) <- niceLambdaR [] o     , not $ isLambda res     , not $ any isQuasiQuote $ universe res     , not $ "runST" `Set.member` Set.map occNameString (freeVars o)@@ -263,7 +263,7 @@ fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs) fromLambda (SimpleLambda ps1 (fromLambda . fromParen -> (ps2,x))) = (transformBi (f $ pvars ps2) ps1 ++ ps2, x)     where f :: [String] -> Pat GhcPs -> Pat GhcPs-          f bad (VarPat _ (rdrNameStr' -> x))+          f bad (VarPat _ (rdrNameStr -> x))               | x `elem` bad = WildPat noExtField           f bad x = x fromLambda x = ([], x)
src/Hint/List.hs view
@@ -53,7 +53,6 @@ import SrcLoc import BasicTypes import RdrName-import OccName import Name import FastString import TysWiredIn@@ -64,6 +63,7 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Types import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  listHint :: DeclHint listHint _ _ = listDecl@@ -109,7 +109,7 @@         o3 = noLoc $ HsDo noExtField ctx (noLoc $ ys ++ [e])         cons = mapMaybe qualCon xs         qualCon :: ExprLStmt GhcPs -> Maybe String-        qualCon (L _ (BodyStmt _ (L _ (HsVar _ (L _ x))) _ _)) = Just (occNameString . rdrNameOcc $ x)+        qualCon (L _ (BodyStmt _ (L _ (HsVar _ (L _ x))) _ _)) = Just (occNameStr x)         qualCon _ = Nothing  listCompCheckMap ::@@ -119,7 +119,7 @@     where       revs = reverse stmts       L _ (LastStmt _ body b s) = head revs -- In a ListComp, this is always last.-      last = noLoc $ LastStmt noExtField (noLoc $ HsApp noExtField (paren' f) (paren' body)) b s+      last = noLoc $ LastStmt noExtField (noLoc $ HsApp noExtField (paren f) (paren body)) b s       o2 =noLoc $ HsDo noExtField ctx (noLoc $ reverse (tail revs) ++ [last]) listCompCheckMap _ _ _ _ _ = [] @@ -240,7 +240,7 @@     f :: LHsExpr GhcPs ->       Maybe (LHsExpr GhcPs, LHsExpr GhcPs -> LHsExpr GhcPs)     f (L _ (ExplicitList _ _ [x]))=-      Just (x, \v -> if isApp x then v else paren' v)+      Just (x, \v -> if isApp x then v else paren v)     f _ = Nothing      gen :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
src/Hint/ListRec.hs view
@@ -49,7 +49,6 @@ import GHC.Hs.Binds import GHC.Hs.Expr import GHC.Hs.Decls-import OccName import BasicTypes  import GHC.Util@@ -57,6 +56,7 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  listRecHint :: DeclHint listRecHint _ _ = concatMap f . universe@@ -104,26 +104,26 @@     | [] <- vs, varToStr nil == "[]", (L _ (OpApp _ lhs c rhs)) <- cons, varToStr c == ":"     , astEq (fromParen rhs) recursive, xs `notElem` vars lhs     = Just $ (,,) "map" Hint.Type.Warning $-      appsBracket' [ strToVar "map", niceLambda' [x] lhs, strToVar xs]+      appsBracket [ strToVar "map", niceLambda [x] lhs, strToVar xs]     -- Suggest 'foldr'?     | [] <- vs, App2 op lhs rhs <- view cons     , xs `notElem` (vars op ++ vars lhs) -- the meaning of xs changes, see #793     , astEq (fromParen rhs) recursive     = Just $ (,,) "foldr" Suggestion $-      appsBracket' [ strToVar "foldr", niceLambda' [x] $ appsBracket' [op,lhs], nil, strToVar xs]+      appsBracket [ strToVar "foldr", niceLambda [x] $ appsBracket [op,lhs], nil, strToVar xs]     -- Suggest 'foldl'?     | [v] <- vs, view nil == Var_ v, (L _ (HsApp _ r lhs)) <- cons     , astEq (fromParen r) recursive     , xs `notElem` vars lhs     = Just $ (,,) "foldl" Suggestion $-      appsBracket' [ strToVar "foldl", niceLambda' [v,x] lhs, strToVar v, strToVar xs]+      appsBracket [ strToVar "foldl", niceLambda [v,x] lhs, strToVar v, strToVar xs]     -- Suggest 'foldM'?     | [v] <- vs, (L _ (HsApp _ ret res)) <- nil, isReturn ret, varToStr res == "()" || view res == Var_ v     , [L _ (BindStmt _ (view -> PVar_ b1) e _ _), L _ (BodyStmt _ (fromParen -> (L _ (HsApp _ r (view -> Var_ b2)))) _ _)] <- asDo cons     , b1 == b2, astEq r recursive, xs `notElem` vars e     , name <- "foldM" ++ ['_' | varToStr res == "()"]     = Just $ (,,) name Suggestion $-      appsBracket' [strToVar name, niceLambda' [v,x] e, strToVar v, strToVar xs]+      appsBracket [strToVar name, niceLambda [v,x] e, strToVar v, strToVar xs]     -- Nope, I got nothing ¯\_(ツ)_/¯.     | otherwise = Nothing @@ -166,7 +166,7 @@   Branch name2 ps2 p2 c2 b2 <- findBranch x2   guard (name1 == name2 && ps1 == ps2 && p1 == p2)   [(BNil, b1), (BCons x xs, b2)] <- pure $ sortOn fst [(c1, b1), (c2, b2)]-  b2 <- transformAppsM' (delCons name1 p1 xs) b2+  b2 <- transformAppsM (delCons name1 p1 xs) b2   (ps, b2) <- pure $ eliminateArgs ps1 b2    let ps12 = let (a, b) = splitAt p1 ps1 in map strToPat (a ++ xs : b) -- Function arguments.@@ -180,20 +180,20 @@   pure (ListCase ps b1 (x, xs, b2), noLoc . ValD noExtField . funBind)  delCons :: String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)-delCons func pos var (fromApps' -> (view -> Var_ x) : xs) | func == x = do+delCons func pos var (fromApps -> (view -> Var_ x) : xs) | func == x = do     (pre, (view -> Var_ v) : post) <- pure $ splitAt pos xs     guard $ v == var-    pure $ apps' $ recursive : pre ++ post+    pure $ apps $ recursive : pre ++ post delCons _ _ _ x = pure x  eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs) eliminateArgs ps cons = (remove ps, transform f cons)   where-    args = [zs | z : zs <- map fromApps' $ universeApps' cons, astEq z recursive]+    args = [zs | z : zs <- map fromApps $ universeApps cons, astEq z recursive]     elim = [all (\xs -> length xs > i && view (xs !! i) == Var_ p) args | (i, p) <- zipFrom 0 ps] ++ repeat False     remove = concat . zipWith (\b x -> [x | not b]) elim -    f (fromApps' -> x : xs) | astEq x recursive = apps' $ x : remove xs+    f (fromApps -> x : xs) | astEq x recursive = apps $ x : remove xs     f x = x  @@ -211,7 +211,7 @@                         }             } <- pure x   (a, b, c) <- findPat ps-  pure $ Branch (occNameString $rdrNameOcc name) a b c $ simplifyExp' body+  pure $ Branch (occNameStr name) a b c $ simplifyExp body  findPat :: [LPat GhcPs] -> Maybe ([String], Int, BList) findPat ps = do
src/Hint/Match.hs view
@@ -37,7 +37,7 @@ not . not . x ==> x -} -module Hint.Match(readMatch') where+module Hint.Match(readMatch) where  import Hint.Type (ModuleEx,Idea,idea,ideaNote,toSS) import Util@@ -62,36 +62,37 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader -readMatch' :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]-readMatch' settings = findIdeas' (concatMap readRule' settings)+readMatch :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]+readMatch settings = findIdeas (concatMap readRule settings) -readRule' :: HintRule -> [HintRule]-readRule' m@HintRule{ hintRuleLHS=(stripLocs' . unextendInstances -> hintRuleLHS)-                    , hintRuleRHS=(stripLocs' . unextendInstances -> hintRuleRHS)-                    , hintRuleSide=((stripLocs' . unextendInstances <$>) -> hintRuleSide)+readRule :: HintRule -> [HintRule]+readRule m@HintRule{ hintRuleLHS=(stripLocs . unextendInstances -> hintRuleLHS)+                    , hintRuleRHS=(stripLocs . unextendInstances -> hintRuleRHS)+                    , hintRuleSide=((stripLocs . unextendInstances <$>) -> hintRuleSide)                     } =    (:) m{ hintRuleLHS=extendInstances hintRuleLHS         , hintRuleRHS=extendInstances hintRuleRHS         , hintRuleSide=extendInstances <$> hintRuleSide } $ do-    (l, v1) <- dotVersion' hintRuleLHS-    (r, v2) <- dotVersion' hintRuleRHS+    (l, v1) <- dotVersion hintRuleLHS+    (r, v2) <- dotVersion hintRuleRHS      guard $ v1 == v2 && not (null l) && (length l > 1 || length r > 1) && Set.notMember v1 (Set.map occNameString (freeVars $ maybeToList hintRuleSide ++ l ++ r))     if not (null r) then-      [ m{ hintRuleLHS=extendInstances (dotApps' l), hintRuleRHS=extendInstances (dotApps' r), hintRuleSide=extendInstances <$> hintRuleSide }-      , m{ hintRuleLHS=extendInstances (dotApps' (l ++ [strToVar v1])), hintRuleRHS=extendInstances (dotApps' (r ++ [strToVar v1])), hintRuleSide=extendInstances <$> hintRuleSide } ]+      [ m{ hintRuleLHS=extendInstances (dotApps l), hintRuleRHS=extendInstances (dotApps r), hintRuleSide=extendInstances <$> hintRuleSide }+      , m{ hintRuleLHS=extendInstances (dotApps (l ++ [strToVar v1])), hintRuleRHS=extendInstances (dotApps (r ++ [strToVar v1])), hintRuleSide=extendInstances <$> hintRuleSide } ]       else if length l > 1 then-            [ m{ hintRuleLHS=extendInstances (dotApps' l), hintRuleRHS=extendInstances (strToVar "id"), hintRuleSide=extendInstances <$> hintRuleSide }-            , m{ hintRuleLHS=extendInstances (dotApps' (l++[strToVar v1])), hintRuleRHS=extendInstances (strToVar v1), hintRuleSide=extendInstances <$> hintRuleSide}]+            [ m{ hintRuleLHS=extendInstances (dotApps l), hintRuleRHS=extendInstances (strToVar "id"), hintRuleSide=extendInstances <$> hintRuleSide }+            , m{ hintRuleLHS=extendInstances (dotApps (l++[strToVar v1])), hintRuleRHS=extendInstances (strToVar v1), hintRuleSide=extendInstances <$> hintRuleSide}]       else []  -- Find a dot version of this rule, return the sequence of app -- prefixes, and the var.-dotVersion' :: LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]-dotVersion' (view -> Var_ v) | isUnifyVar v = [([], v)]-dotVersion' (L _ (HsApp _ ls rs)) = first (ls :) <$> dotVersion' (fromParen rs)-dotVersion' (L l (OpApp _ x op y)) =+dotVersion :: LHsExpr GhcPs -> [([LHsExpr GhcPs], String)]+dotVersion (view -> Var_ v) | isUnifyVar v = [([], v)]+dotVersion (L _ (HsApp _ ls rs)) = first (ls :) <$> dotVersion (fromParen rs)+dotVersion (L l (OpApp _ x op y)) =   -- In a GHC parse tree, raw sections aren't valid application terms.   -- To be suitable as application terms, they must be enclosed in   -- parentheses.@@ -100,27 +101,27 @@   --   x is 'a', op is '==' and y is 'b' and,   let lSec = addParen (cL l (SectionL noExtField x op)) -- (a == )       rSec = addParen (cL l (SectionR noExtField op y)) -- ( == b)-  in (first (lSec :) <$> dotVersion' y) ++ (first (rSec :) <$> dotVersion' x) -- [([(a ==)], b), ([(b == )], a])].-dotVersion' _ = []+  in (first (lSec :) <$> dotVersion y) ++ (first (rSec :) <$> dotVersion x) -- [([(a ==)], b), ([(b == )], a])].+dotVersion _ = []  --------------------------------------------------------------------- -- PERFORM THE MATCHING -findIdeas' :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]-findIdeas' matches s _ decl = timed "Hint" "Match apply" $ forceList+findIdeas :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]+findIdeas matches s _ decl = timed "Hint" "Match apply" $ forceList     [ (idea (hintRuleSeverity m) (hintRuleName m) x y [r]){ideaNote=notes}-    | (name, expr) <- findDecls' decl-    , (parent,x) <- universeParentExp' expr+    | (name, expr) <- findDecls decl+    , (parent,x) <- universeParentExp expr     , m <- matches, Just (y, tpl, notes, subst) <- [matchIdea s name m parent x]     , let r = R.Replace R.Expr (toSS x) subst (unsafePrettyPrint tpl)     ]  -- | A list of root expressions, with their associated names-findDecls' :: LHsDecl GhcPs -> [(String, LHsExpr GhcPs)]-findDecls' x@(L _ (InstD _ (ClsInstD _ ClsInstDecl{cid_binds}))) =+findDecls :: LHsDecl GhcPs -> [(String, LHsExpr GhcPs)]+findDecls x@(L _ (InstD _ (ClsInstD _ ClsInstDecl{cid_binds}))) =     [(fromMaybe "" $ bindName xs, x) | xs <- bagToList cid_binds, x <- childrenBi xs]-findDecls' (L _ RuleD{}) = [] -- Often rules contain things that HLint would rewrite.-findDecls' x = map (fromMaybe "" $ declName x,) $ childrenBi x+findDecls (L _ RuleD{}) = [] -- Often rules contain things that HLint would rewrite.+findDecls x = map (fromMaybe "" $ declName x,) $ childrenBi x  matchIdea :: Scope            -> String@@ -134,18 +135,18 @@       sa  = hintRuleScope       nm a b = scopeMatch (sa, a) (sb, b)   (u, extra) <- unifyExp nm True lhs x-  u <- validSubst' astEq u+  u <- validSubst astEq u    -- Need to check free vars before unqualification, but after subst   -- (with 'e') need to unqualify before substitution (with 'res').-  let rhs' | Just fun <- extra = rebracket1' $ noLoc (HsApp noExtField fun rhs)+  let rhs' | Just fun <- extra = rebracket1 $ noLoc (HsApp noExtField fun rhs)            | otherwise = rhs-      (e, tpl) = substitute' u rhs'+      (e, tpl) = substitute u rhs'       noParens = [varToStr $ fromParen x | L _ (HsApp _ (varToStr -> "_noParen_") x) <- universe tpl]    u <- pure (removeParens noParens u) -  let res = addBracketTy' (addBracket' parent $ performSpecial' $ fst $ substitute' u $ unqualify' sa sb rhs')+  let res = addBracketTy (addBracket parent $ performSpecial $ fst $ substitute u $ unqualify sa sb rhs')   guard $ (freeVars e Set.\\ Set.filter (not . isUnifyVar . occNameString) (freeVars rhs')) `Set.isSubsetOf` freeVars x       -- Check no unexpected new free variables. @@ -155,39 +156,39 @@   -- what free vars they make use of.   guard $ not (any isLambda $ universe lhs) || not (any isQuasiQuote $ universe x) -  guard $ checkSide' (unextendInstances <$> hintRuleSide) $ ("original", x) : ("result", res) : fromSubst' u-  guard $ checkDefine' declName parent res+  guard $ checkSide (unextendInstances <$> hintRuleSide) $ ("original", x) : ("result", res) : fromSubst u+  guard $ checkDefine declName parent res -  (u, tpl) <- pure $ if any ((== noSrcSpan) . getLoc . snd) (fromSubst' u) then (mempty, res) else (u, tpl)-  tpl <- pure $ unqualify' sa sb (performSpecial' tpl)+  (u, tpl) <- pure $ if any ((== noSrcSpan) . getLoc . snd) (fromSubst u) then (mempty, res) else (u, tpl)+  tpl <- pure $ unqualify sa sb (performSpecial tpl) -  pure (res, tpl, hintRuleNotes, [(s, toSS pos) | (s, pos) <- fromSubst' u, getLoc pos /= noSrcSpan])+  pure (res, tpl, hintRuleNotes, [(s, toSS pos) | (s, pos) <- fromSubst u, getLoc pos /= noSrcSpan])  --------------------------------------------------------------------- -- SIDE CONDITIONS -checkSide' :: Maybe (LHsExpr GhcPs) -> [(String, LHsExpr GhcPs)] -> Bool-checkSide' x bind = maybe True bool x+checkSide :: Maybe (LHsExpr GhcPs) -> [(String, LHsExpr GhcPs)] -> Bool+checkSide x bind = maybe True bool x     where       bool :: LHsExpr GhcPs -> Bool       bool (L _ (OpApp _ x op y))         | varToStr op == "&&" = bool x && bool y         | varToStr op == "||" = bool x || bool y-        | varToStr op == "==" = expr (fromParen1' x) `astEq` expr (fromParen1' y)+        | varToStr op == "==" = expr (fromParen1 x) `astEq` expr (fromParen1 y)       bool (L _ (HsApp _ x y)) | varToStr x == "not" = not $ bool y       bool (L _ (HsPar _ x)) = bool x        bool (L _ (HsApp _ cond (sub -> y)))         | 'i' : 's' : typ <- varToStr cond = isType typ y       bool (L _ (HsApp _ (L _ (HsApp _ cond (sub -> x))) (sub -> y)))-          | varToStr cond == "notIn" = and [extendInstances (stripLocs' x) `notElem` map (extendInstances . stripLocs') (universe y) | x <- list x, y <- list y]+          | varToStr cond == "notIn" = and [extendInstances (stripLocs x) `notElem` map (extendInstances . stripLocs) (universe y) | x <- list x, y <- list y]           | varToStr cond == "notEq" = not (x `astEq` y)       bool x | varToStr x == "noTypeCheck" = True       bool x | varToStr x == "noQuickCheck" = True-      bool x = error $ "Hint.Match.checkSide', unknown side condition: " ++ unsafePrettyPrint x+      bool x = error $ "Hint.Match.checkSide, unknown side condition: " ++ unsafePrettyPrint x        expr :: LHsExpr GhcPs -> LHsExpr GhcPs-      expr (L _ (HsApp _ (varToStr -> "subst") x)) = sub $ fromParen1' x+      expr (L _ (HsApp _ (varToStr -> "subst") x)) = sub $ fromParen1 x       expr x = x        isType "Compare" x = True -- Just a hint for proof stuff@@ -227,43 +228,43 @@               f x = x  -- Does the result look very much like the declaration?-checkDefine' :: String -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool-checkDefine' declName Nothing y =+checkDefine :: String -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool+checkDefine declName Nothing y =   let funOrOp expr = case expr of         L _ (HsApp _ fun _) -> funOrOp fun         L _ (OpApp _ _ op _) -> funOrOp op         other -> other-   in declName /= varToStr (transformBi unqual' $ funOrOp y)-checkDefine' _ _ _ = True+   in declName /= varToStr (transformBi unqual $ funOrOp y)+checkDefine _ _ _ = True  --------------------------------------------------------------------- -- TRANSFORMATION  -- If it has '_noParen_', remove the brackets (if exist).-performSpecial' :: LHsExpr GhcPs -> LHsExpr GhcPs-performSpecial' = transform fNoParen+performSpecial :: LHsExpr GhcPs -> LHsExpr GhcPs+performSpecial = transform fNoParen   where     fNoParen :: LHsExpr GhcPs -> LHsExpr GhcPs     fNoParen (L _ (HsApp _ e x)) | varToStr e == "_noParen_" = fromParen x     fNoParen x = x  -- Contract : 'Data.List.foo' => 'foo' if 'Data.List' is loaded.-unqualify' :: Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs-unqualify' from to = transformBi f+unqualify :: Scope -> Scope -> LHsExpr GhcPs -> LHsExpr GhcPs+unqualify from to = transformBi f   where     f :: Located RdrName -> Located RdrName     f x@(L _ (Unqual s)) | isUnifyVar (occNameString s) = x     f x = scopeMove (from, x) to -addBracket' :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs-addBracket' (Just (i, p)) c | needBracketOld' i p c = noLoc $ HsPar noExtField c-addBracket' _ x = x+addBracket :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs+addBracket (Just (i, p)) c | needBracketOld i p c = noLoc $ HsPar noExtField c+addBracket _ x = x  -- Type substitution e.g. 'Foo Int' for 'a' in 'Proxy a' can lead to a -- need to bracket type applications in  This doesn't come up in HSE -- because the pretty printer inserts them.-addBracketTy' :: LHsExpr GhcPs -> LHsExpr GhcPs-addBracketTy'= transformBi f+addBracketTy :: LHsExpr GhcPs -> LHsExpr GhcPs+addBracketTy= transformBi f   where     f :: LHsType GhcPs -> LHsType GhcPs     f (L _ (HsAppTy _ t x@(L _ HsAppTy{}))) =
src/Hint/Monad.hs view
@@ -42,7 +42,7 @@ {-# LANGUAGE BlockArguments #-}; main = print do 17 + 25 {-# LANGUAGE BlockArguments #-}; main = print do 17 -- main = f $ do g a $ sleep 10 ---main = do f a $ sleep 10 --+main = do f a $ sleep 10 -- @Ignore main = do foo x; return 3; bar z -- do foo x; bar z main = void $ forM_ f xs -- forM_ f xs main = void $ forM f xs -- void $ forM_ f xs@@ -60,7 +60,7 @@  module Hint.Monad(monadHint) where -import Hint.Type(DeclHint,Idea(..),ideaNote,warn,warnRemove,toSS,suggest,Note(Note))+import Hint.Type(DeclHint,Idea(..),Severity(..),ideaNote,warn,ideaRemove,toSS,suggest,Note(Note))  import GHC.Hs import SrcLoc@@ -72,6 +72,7 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import GHC.Util  import Data.Generics.Uniplate.Data@@ -112,15 +113,15 @@     (L l (OpApp _ op dol x)) | isTag "void" op, isDol dol -> seenVoid (cL l . OpApp noExtField op dol) x     (L loc (HsDo _ ctx (L loc2 [L loc3 (BodyStmt _ y _ _ )]))) ->       let doOrMDo = case ctx of MDoExpr -> "mdo"; _ -> "do"-       in [ warnRemove ("Redundant " ++ doOrMDo) (doSpan doOrMDo loc) doOrMDo [Replace Expr (toSS x) [("y", toSS y)] "y"]+       in [ ideaRemove Ignore ("Redundant " ++ doOrMDo) (doSpan doOrMDo loc) doOrMDo [Replace Expr (toSS x) [("y", toSS y)] "y"]           | not $ doAsBrackets parentExpr y           , not $ doAsAvoidingIndentation parentDo x           ]     (L loc (HsDo _ DoExpr (L _ xs))) ->       monadSteps (cL loc . HsDo noExtField DoExpr . noLoc) xs ++       [suggest "Use let" from to [r] | (from, to, r) <- monadLet xs] ++-      concat [f x | (L _ (BodyStmt _ x _ _)) <- init xs] ++-      concat [f x | (L _ (BindStmt _ (LL _ WildPat{}) x _ _)) <- init xs]+      concat [f x | (L _ (BodyStmt _ x _ _)) <- dropEnd1 xs] +++      concat [f x | (L _ (BindStmt _ (LL _ WildPat{}) x _ _)) <- dropEnd1 xs]     _ -> []   where     f = monadNoResult (fromMaybe "" decl) id@@ -155,7 +156,7 @@ returnsUnit (L _ (HsPar _ x)) = returnsUnit x returnsUnit (L _ (HsApp _ x _)) = returnsUnit x returnsUnit (L _ (OpApp _ x op _)) | isDol op = returnsUnit x-returnsUnit (L _ (HsVar _ (L _ x))) = occNameString (rdrNameOcc x) `elem` map (++ "_") badFuncs ++ unitFuncs+returnsUnit (L _ (HsVar _ (L _ x))) = occNameStr x `elem` map (++ "_") badFuncs ++ unitFuncs returnsUnit _ = False  -- See through HsPar, and down HsIf/HsCase, return the name to use in@@ -165,13 +166,13 @@ monadNoResult inside wrap (L l (HsApp _ x y)) = monadNoResult inside (\x -> wrap $ cL l (HsApp noExtField x y)) x monadNoResult inside wrap (L l (OpApp _ x tag@(L _ (HsVar _ (L _ op))) y))     | isDol tag = monadNoResult inside (\x -> wrap $ cL l (OpApp noExtField x tag y)) x-    | occNameString (rdrNameOcc op) == ">>=" = monadNoResult inside (wrap . cL l . OpApp noExtField x tag) y+    | occNameStr op == ">>=" = monadNoResult inside (wrap . cL l . OpApp noExtField x tag) y monadNoResult inside wrap x     | x2 : _ <- filter (`isTag` x) badFuncs     , let x3 = x2 ++ "_"      = [warn ("Use " ++ x3) (wrap x) (wrap $ strToVar x3) [Replace Expr (toSS x) [] x3] | inside /= x3]-monadNoResult inside wrap (replaceBranches' -> (bs, rewrap)) =+monadNoResult inside wrap (replaceBranches -> (bs, rewrap)) =     map (\x -> x{ideaNote=nubOrd $ Note "May require adding void to other branches" : ideaNote x}) $ concat         [monadNoResult inside id b | b <- bs] @@ -185,7 +186,7 @@ -- Rewrite 'do a <- $1; return a' as 'do $1'. monadStep wrap o@[ g@(L _ (BindStmt _ (LL _ (VarPat _ (L _ p))) x _ _ ))                   , q@(L _ (BodyStmt _ (fromRet -> Just (ret, L _ (HsVar _ (L _ v)))) _ _))]-  | occNameString (rdrNameOcc p) == occNameString (rdrNameOcc v)+  | occNameStr p == occNameStr v   = [warn ("Redundant " ++ ret) (wrap o) (wrap [noLoc $ BodyStmt noExtField x noSyntaxExpr noSyntaxExpr])       [Replace Stmt (toSS g) [("x", toSS x)] "x", Delete Stmt (toSS q)]] @@ -193,7 +194,7 @@ monadStep wrap o@(g@(L _ (BindStmt _ (view -> PVar_ p) x _ _)):q@(L _ (BodyStmt _ (view -> Var_ v) _ _)):xs)   | p == v && v `notElem` varss xs   = let app = noLoc $ HsApp noExtField (strToVar "join") x-        body = noLoc $ BodyStmt noExtField (rebracket1' app) noSyntaxExpr noSyntaxExpr+        body = noLoc $ BodyStmt noExtField (rebracket1 app) noSyntaxExpr noSyntaxExpr         stmts = body : xs     in [warn "Use join" (wrap o) (wrap stmts) r]   where r = [Replace Stmt (toSS g) [("x", toSS x)] "join x", Delete Stmt (toSS q)]@@ -209,7 +210,7 @@ monadStep   wrap o@[ L _ (BodyStmt _ x _ _)          , L _ (BodyStmt _ (fromRet -> Just (ret, L _ (HsVar _ (L _ unit)))) _ _)]-     | returnsUnit x, occNameString (rdrNameOcc unit) == "()"+     | returnsUnit x, occNameStr unit == "()"   = [warn ("Redundant " ++ ret) (wrap o) (wrap $ take 1 o) []]  -- Rewrite 'do x <- $1; return $ f $ g x' as 'f . g <$> x'@@ -221,7 +222,7 @@       [warn "Use <$>" (wrap o) (wrap [noLoc $ BodyStmt noExtField (noLoc $ OpApp noExtField (foldl' (\acc e -> noLoc $ OpApp noExtField acc (strToVar ".") e) f fs) (strToVar "<$>") x) noSyntaxExpr noSyntaxExpr])       [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)]]   where-    isSimple (fromApps' -> xs) = all isAtom (x : xs)+    isSimple (fromApps -> xs) = all isAtom (x : xs)     vs = ('f':) . show <$> [0..]      notDol :: LHsExpr GhcPs -> Bool@@ -269,6 +270,6 @@  fromRet :: LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs) fromRet (L _ (HsPar _ x)) = fromRet x-fromRet (L _ (OpApp _ x (L _ (HsVar _ (L _ y))) z)) | occNameString (rdrNameOcc y) == "$" = fromRet $ noLoc (HsApp noExtField x z)+fromRet (L _ (OpApp _ x (L _ (HsVar _ (L _ y))) z)) | occNameStr y == "$" = fromRet $ noLoc (HsApp noExtField x z) fromRet (L _ (HsApp _ x y)) | isReturn x = Just (unsafePrettyPrint x, y) fromRet _ = Nothing
src/Hint/Pattern.hs view
@@ -78,6 +78,7 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  patternHint :: DeclHint patternHint _scope modu x =@@ -165,15 +166,14 @@          in RealSrcSpan (mkRealSrcSpan start end) hints gen (Pattern l t pats o@(GRHSs _ (unsnoc -> Just (gs, L _ (GRHS _ [test] bod))) binds))   | unsafePrettyPrint test == "True"-  = let tag = noLoc (mkRdrUnqual $ mkVarOcc "otherwise")-        otherwise_ = noLoc $ BodyStmt noExtField (noLoc (HsVar noExtField tag)) noSyntaxExpr noSyntaxExpr in+  = let otherwise_ = noLoc $ BodyStmt noExtField (strToVar "otherwise") noSyntaxExpr noSyntaxExpr in       [gen "Use otherwise" (Pattern l t pats o{grhssGRHSs = gs ++ [noLoc (GRHS noExtField [otherwise_] bod)]}) [Replace Expr (toSS test) [] "otherwise"]] hints _ _ = []  asGuards :: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)] asGuards (L _ (HsPar _ x)) = asGuards x asGuards (L _ (HsIf _ _ a b c)) = (a, b) : asGuards c-asGuards x = [(noLoc (HsVar noExtField (noLoc (mkRdrUnqual $ mkVarOcc "otherwise"))), x)]+asGuards x = [(strToVar "otherwise", x)]  data Pattern = Pattern SrcSpan R.RType [LPat GhcPs] (GRHSs GhcPs (LHsExpr GhcPs)) @@ -237,7 +237,7 @@   where     r = Replace Expr (toSS o) [("x", toSS e)] "x" expHint o@(L _ (HsCase _ (L _ (HsVar _ (L _ x))) (MG _ (L _ [L _ (Match _ CaseAlt [L _ (VarPat _ (L _ y))] (GRHSs _ [L _ (GRHS _ [] e)] (L  _ (EmptyLocalBinds _)))) ]) FromSource )))-  | occNameString (rdrNameOcc x) == occNameString (rdrNameOcc y) =+  | occNameStr x == occNameStr y =       [suggest "Redundant case" o e [r]]   where     r = Replace Expr (toSS o) [("x", toSS e)] "x"
src/Hint/Restrict.hs view
@@ -35,6 +35,7 @@ import Module import SrcLoc import OccName+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import GHC.Util  -- FIXME: The settings should be partially applied, but that's hard to orchestrate right now@@ -151,6 +152,6 @@     | d <- decls     , let dname = fromMaybe "" (declName d)     , x <- universeBi d :: [Located RdrName]-    , let ri@RestrictItem{..} = Map.findWithDefault (RestrictItem [] [("","") | def] [] Nothing) (occNameString (rdrNameOcc (unLoc x))) mp+    , let ri@RestrictItem{..} = Map.findWithDefault (RestrictItem [] [("","") | def] [] Nothing) (rdrNameStr x) mp     , not $ within modu dname ri     ]
src/Idea.hs view
@@ -2,7 +2,7 @@  module Idea(     Idea(..),-    rawIdea, idea, suggest, suggestRemove, warn, warnRemove, ignore,+    rawIdea, idea, suggest, suggestRemove, ideaRemove, warn, ignore,     rawIdeaN, suggestN, ignoreNoSuggestion,     showIdeasJson, showANSI,     Note(..), showNotes,@@ -107,9 +107,6 @@ warn :: (HasSrcSpan a, Outputable.Outputable a, HasSrcSpan b, Outputable.Outputable b) =>          String -> a -> b -> [Refactoring R.SrcSpan] -> Idea warn = idea Warning--warnRemove :: String -> SrcSpan -> String -> [Refactoring R.SrcSpan] -> Idea-warnRemove = ideaRemove Warning  ignoreNoSuggestion :: (HasSrcSpan a, Outputable.Outputable a)                     => String -> a -> Idea
src/Test/Annotations.hs view
@@ -129,7 +129,7 @@             | Just (x',_) <- stripInfix "@NoRefactor" x =                 f (Just s) SkipRefactor ((i, trimEnd x' ++ ['\\' | "\\" `isSuffixOf` x]) : xs)             | null x || "-- " `isPrefixOf` x = f (Just s) refact xs-            | "\\" `isSuffixOf` x, (_,y):ys <- xs = f (Just s) refact $ (i,init x++"\n"++y):ys+            | Just x <- stripSuffix "\\" x, (_,y):ys <- xs = f (Just s) refact $ (i,x++"\n"++y):ys             | otherwise = parseTest refact file i x s : f (Just s) TestRefactor xs         f _ _ [] = []