packages feed

hlint 3.2.8 → 3.3

raw patch · 46 files changed

+395/−359 lines, 46 filesdep ~aesondep ~extradep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, extra, ghc, ghc-lib-parser, ghc-lib-parser-ex

API changes (from Hackage documentation)

- Language.Haskell.HLint: createModuleEx :: ApiAnns -> Located (HsModule GhcPs) -> ModuleEx
+ Language.Haskell.HLint: createModuleEx :: ApiAnns -> Located HsModule -> ModuleEx

Files

CHANGES.txt view
@@ -1,8 +1,14 @@ Changelog for HLint (* = breaking change) -3.2.8, released 2021-12-27-    #1304, support aeson-2.0-    #1286, compatibility with extra-1.7.10+3.3, released 2021-03-14+    #1212, don't suggest redundant brackets on $(x)+    #1215, suggest varE 'foo ==> [|foo|]+    #1215, allow matching on Template Haskell variables+    #1216, require apply-refact 0.9.1.0+*   #1209, switch to the GHC 9.0.1 parse tree+    Drop GHC 8.6 support+    #1206, require apply-refact 0.9.0.0 or higher+    #1205, generalize hints which were with '&' form 3.2.7, released 2021-01-16     #1202, add missing parentheses for Avoid Lambda     #1201, allow matching through the & operator (similar to $)
data/hlint.yaml view
@@ -36,6 +36,7 @@     - import Maybe as Data.Maybe     - import Monad as Control.Monad     - import Char as Data.Char+    - import Language.Haskell.TH as TH  - package:     name: lens@@ -811,6 +812,10 @@     - warn: {lhs: "Data.Map.Lazy.fromList []", rhs: Data.Map.Lazy.empty}     - warn: {lhs: "Data.Map.Strict.fromList []", rhs: Data.Map.Strict.empty} +    # TEMPLATE HASKELL++    - hint: {lhs: "TH.varE 'a", rhs: "[|a|]", name: Use TH quotation brackets}+ - group:     name: lens     enabled: true@@ -821,9 +826,9 @@     - warn: {lhs: "(a ^. b) ^. c", rhs: "a ^. (b . c)"}     - warn: {lhs: "fromJust (a ^? b)", rhs: "a ^?! b"}     - warn: {lhs: "a .~ Just b", rhs: "a ?~ b"}-    - warn: {lhs: "a & (mapped %~ b)", rhs: "a <&> b"}-    - warn: {lhs: "a & ((mapped . b) %~ c)", rhs: "a <&> b %~ c"}-    - warn: {lhs: "a & (mapped .~ b)", rhs: "b <$ a"}+    - warn: {lhs: "(mapped %~ b) a", rhs: "a <&> b"}+    - warn: {lhs: "((mapped . b) %~ c) a", rhs: "a <&> b %~ c"}+    - warn: {lhs: "(mapped .~ b) a", rhs: "b <$ a"}     - warn: {lhs: "ask <&> (^. a)", rhs: "view a"}     - warn: {lhs: "view a <&> (^. b)", rhs: "view (a . b)"} @@ -1107,6 +1112,7 @@ # yes = foo (elem x y) -- x `elem` y # no  = x `elem` y # no  = elem 1 [] : []+# yes = a & (mapped . b) %~ c -- a <&> b %~ c # test a = foo (\x -> True) -- const True # test a = foo (\_ -> True) -- const True # test a = foo (\x -> x) -- id@@ -1216,6 +1222,8 @@ # issue1183 = (a >= 'a') && a <= 'z' -- isAsciiLower a # issue1183 = (a >= 'a') && (a <= 'z') -- isAsciiLower a +# import Language.Haskell.TH\+# yes = varE 'foo -- [|foo|] # import Prelude \ # yes = flip mapM -- Control.Monad.forM # import Control.Monad \
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            3.2.8+version:            3.3 license:            BSD3 license-file:       LICENSE category:           Development@@ -32,7 +32,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==8.10, GHC==8.8, GHC==8.6+tested-with:        GHC==9.0, GHC==8.10, GHC==8.8  source-repository head     type:     git@@ -76,16 +76,16 @@         aeson >= 1.1.2.0,         filepattern >= 0.1.1 -    if !flag(ghc-lib) && impl(ghc >= 8.10.0) && impl(ghc < 8.11.0)+    if !flag(ghc-lib) && impl(ghc >= 9.0.0) && impl(ghc < 9.1.0)       build-depends:-        ghc == 8.10.*,+        ghc == 9.0.*,         ghc-boot-th,         ghc-boot     else       build-depends:-          ghc-lib-parser == 8.10.*+          ghc-lib-parser == 9.0.*     build-depends:-        ghc-lib-parser-ex >= 8.10.0.17 && < 8.10.1+        ghc-lib-parser-ex >= 9.0.0.4 && < 9.0.1      if flag(gpl)         build-depends: hscolour >= 1.21
src/Apply.hs view
@@ -15,7 +15,7 @@ import Data.Ord import Config.Type import Config.Haskell-import SrcLoc+import GHC.Types.SrcLoc import GHC.Hs import Language.Haskell.GhclibParserEx.GHC.Hs import qualified Data.HashSet as Set@@ -58,8 +58,8 @@     , let classifiers = cls ++ mapMaybe readPragma (universeBi (ghcModule m)) ++ concatMap readComment (ghcComments m)     , seq (length classifiers) True -- to force any errors from readPragma or readComment     , let decHints = hintDecl hints settings nm m -- partially apply-    , let order n = map (\i -> i{ideaModule = f $ modName (ghcModule m) : ideaModule i, ideaDecl = f $ n ++ ideaDecl i}) . sortOn ideaSpan-    , let merge = mergeBy (comparing ideaSpan)] +++    , let order n = map (\i -> i{ideaModule = f $ modName (ghcModule m) : ideaModule i, ideaDecl = f $ n ++ ideaDecl i}) . sortOn (SrcSpanD . ideaSpan)+    , let merge = mergeBy (comparing (SrcSpanD . ideaSpan))] ++     [map (classify cls) (hintModules hints settings mns)]     where         f = nubOrd . filter (/= "")
src/CC.hs view
@@ -19,7 +19,7 @@  import Idea (Idea(..), Severity(..)) -import qualified SrcLoc as GHC+import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Util as GHC  data Issue = Issue
src/CmdLine.hs view
@@ -17,7 +17,7 @@ import GHC.All(CppFlags(..)) import GHC.LanguageExtensions.Type import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx-import DynFlags hiding (verbosity)+import GHC.Driver.Session hiding (verbosity)  import Language.Preprocessor.Cpphs import System.Console.ANSI(hSupportsANSIWithoutEmulation)
src/Config/Compute.hs view
@@ -10,10 +10,10 @@ import Fixity import Data.Generics.Uniplate.DataOnly import GHC.Hs hiding (Warning)-import RdrName-import Name-import Bag-import SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name+import GHC.Data.Bag+import GHC.Types.SrcLoc import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
src/Config/Haskell.hs view
@@ -15,14 +15,14 @@  import GHC.Util -import SrcLoc+import GHC.Types.SrcLoc import GHC.Hs.Extension import GHC.Hs.Decls hiding (SpliceDecl) import GHC.Hs.Expr hiding (Match) import GHC.Hs.Lit-import FastString-import ApiAnnotation-import Outputable+import GHC.Data.FastString+import GHC.Parser.Annotation+import GHC.Utils.Outputable  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader@@ -45,7 +45,6 @@         f (L _ (HsPar _ x)) = f x         f (L _ (ExprWithTySig _ x _)) = f x         f _ = Nothing-readPragma _ = Nothing  readComment :: Located AnnotationComment -> [Classify] readComment c@(L pos AnnBlockComment{})
src/Config/Yaml.hs view
@@ -22,27 +22,24 @@ import GHC.All import Fixity import Extension-import Module+import GHC.Unit.Module import Data.Functor import Data.Semigroup import Timing import Prelude -import Bag-import Lexer-import ErrUtils hiding (Severity)-import Outputable+import GHC.Data.Bag+import GHC.Parser.Lexer+import GHC.Utils.Error hiding (Severity)+import GHC.Utils.Outputable import GHC.Hs-import SrcLoc-import RdrName-import OccName+import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence import GHC.Util (baseDynFlags, Scope, scopeCreate) import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Data.Char-#if MIN_VERSION_aeson(2,0,0)-import Data.Aeson.KeyMap (toHashMapText)-#endif  #ifdef HS_YAML @@ -71,10 +68,6 @@  #endif -#if !MIN_VERSION_aeson(2,0,0)-toHashMapText :: a -> a-toHashMapText = id-#endif  -- | Read a config file in YAML format. Takes a filename, and optionally the contents. --   Fails if the YAML doesn't parse or isn't valid HLint YAML@@ -145,7 +138,7 @@ parseArray v = pure [v]  parseObject :: Val -> Parser (Map.HashMap T.Text Value)-parseObject (getVal -> Object x) = pure (toHashMapText x)+parseObject (getVal -> Object x) = pure x parseObject v = parseFail v "Expected an Object"  parseObject1 :: Val -> Parser (String, Val)@@ -205,7 +198,7 @@         PFailed ps ->           let (_, errs) = getMessages ps baseDynFlags               errMsg = head (bagToList errs)-              msg = Outputable.showSDoc baseDynFlags $ ErrUtils.pprLocErrMsg errMsg+              msg = GHC.Utils.Outputable.showSDoc baseDynFlags $ GHC.Utils.Error.pprLocErrMsg errMsg           in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n " ++ x  ---------------------------------------------------------------------@@ -371,7 +364,7 @@               scope'= asScope' packageMap' (map (fmap unextendInstances) groupImports)  asScope' :: Map.HashMap String [LImportDecl GhcPs] -> [Either String (LImportDecl GhcPs)] -> Scope-asScope' packages xs = scopeCreate (HsModule Nothing Nothing (concatMap f xs) [] Nothing Nothing)+asScope' packages xs = scopeCreate (HsModule NoLayoutInfo Nothing Nothing (concatMap f xs) [] Nothing Nothing)     where         f (Right x) = [x]         f (Left x) | Just pkg <- Map.lookup x packages = pkg
src/Fixity.hs view
@@ -9,10 +9,10 @@ import GHC.Generics(Associativity(..)) import GHC.Hs.Binds import GHC.Hs.Extension-import OccName-import RdrName-import SrcLoc-import BasicTypes+import GHC.Types.Name.Occurrence+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+import GHC.Types.Basic import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Language.Haskell.GhclibParserEx.Fixity @@ -33,7 +33,6 @@         f InfixL = LeftAssociative         f InfixR = RightAssociative         f InfixN = NotAssociative-fromFixitySig _ = []  toFixity :: FixityInfo -> (String, Fixity) toFixity (name, dir, i) = (name, Fixity NoSourceText i $ f dir)
src/GHC/All.hs view
@@ -20,17 +20,17 @@ import System.IO.Extra import Fixity import Extension-import FastString+import GHC.Data.FastString  import GHC.Hs-import SrcLoc-import ErrUtils-import Outputable-import Lexer hiding (context)+import GHC.Types.SrcLoc+import GHC.Utils.Error+import GHC.Utils.Outputable+import GHC.Parser.Lexer hiding (context) import GHC.LanguageExtensions.Type-import ApiAnnotation-import DynFlags hiding (extensions)-import Bag+import GHC.Parser.Annotation+import GHC.Driver.Session hiding (extensions)+import GHC.Data.Bag  import Language.Haskell.GhclibParserEx.GHC.Parser import Language.Haskell.GhclibParserEx.Fixity@@ -84,26 +84,34 @@  -- | Result of 'parseModuleEx', representing a parsed module. data ModuleEx = ModuleEx {-    ghcModule :: Located (HsModule GhcPs)+    ghcModule :: Located HsModule   , ghcAnnotations :: ApiAnns }  -- | Extract a list of all of a parsed module's comments. ghcComments :: ModuleEx -> [Located AnnotationComment]-ghcComments m = concat (Map.elems $ snd (ghcAnnotations m))-+ghcComments m =+  map realToLoc $+    concat (Map.elems $ apiAnnComments (ghcAnnotations m)) +++      apiAnnRogueComments (ghcAnnotations m)+   where+     -- TODO (2020-10-03, SF): This utility is repeated in+     -- ApiAnnotation.hs. Consider doing something in+     -- ghc-lib-parser-ex to clean this up.+     realToLoc :: RealLocated a -> Located a+     realToLoc (L r x) = L (RealSrcSpan r Nothing) x  -- | The error handler invoked when GHC parsing has failed. ghcFailOpParseModuleEx :: String                        -> FilePath                        -> String-                       -> (SrcSpan, ErrUtils.MsgDoc)+                       -> (SrcSpan, GHC.Utils.Error.MsgDoc)                        -> IO (Either ParseError ModuleEx) ghcFailOpParseModuleEx ppstr file str (loc, err) = do    let pe = case loc of-            RealSrcSpan r -> context (srcSpanStartLine r) ppstr+            RealSrcSpan r _ -> context (srcSpanStartLine r) ppstr             _ -> ""-       msg = Outputable.showSDoc baseDynFlags err+       msg = GHC.Utils.Outputable.showSDoc baseDynFlags err    pure $ Left $ ParseError loc msg pe  -- GHC extensions to enable/disable given HSE parse flags.@@ -144,7 +152,7 @@ -- | Create a 'ModuleEx' from GHC annotations and module tree. It -- is assumed the incoming parse module has not been adjusted to -- account for operator fixities (it uses the HLint default fixities).-createModuleEx :: ApiAnns -> Located (HsModule GhcPs) -> ModuleEx+createModuleEx :: ApiAnns -> Located HsModule -> ModuleEx createModuleEx anns ast =   ModuleEx (applyFixities (fixitiesFromModule ast ++ map toFixity defaultFixities) ast) anns @@ -181,10 +189,12 @@       if not $ null errs then         ExceptT $ parseFailureErr dynFlags str file str errs       else do-        let anns =-              ( Map.fromListWith (++) $ annotations s-              , Map.fromList ((noSrcSpan, comment_q s) : annotations_comments s)-              )+        let anns = ApiAnns {+              apiAnnItems = Map.fromListWith (++) $ annotations s+            , apiAnnEofPos = Nothing+            , apiAnnComments = Map.fromListWith (++) $ annotations_comments s+            , apiAnnRogueComments = comment_q s+            }         let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags         pure $ ModuleEx (applyFixities fixes a) anns     PFailed s ->@@ -199,7 +209,9 @@     parseFailureErr dynFlags ppstr file str errs =       let errMsg = head errs           loc = errMsgSpan errMsg-          doc = formatErrDoc dynFlags (errMsgDoc errMsg)+          style = mkErrStyle (errMsgContext errMsg)+          ctx = initSDocContext dynFlags style+          doc = formatErrDoc ctx (errMsgDoc errMsg)       in ghcFailOpParseModuleEx ppstr file str (loc, doc)  -- | Given a line number, and some source code, put bird ticks around the appropriate bit.
src/GHC/Util.hs view
@@ -33,15 +33,15 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable  import GHC.Hs-import Lexer-import SrcLoc-import DynFlags-import FastString+import GHC.Parser.Lexer+import GHC.Types.SrcLoc+import GHC.Driver.Session+import GHC.Data.FastString  import System.FilePath import Language.Preprocessor.Unlit -fileToModule :: FilePath -> String -> DynFlags -> ParseResult (Located (HsModule GhcPs))+fileToModule :: FilePath -> String -> DynFlags -> ParseResult (Located HsModule) fileToModule filename str flags =   parseFile filename flags     (if takeExtension filename /= ".lhs" then str else unlit filename str)@@ -66,7 +66,7 @@       ))  toOldeSpan :: SrcSpan -> (String, Int, Int, Int, Int)-toOldeSpan (RealSrcSpan span) =+toOldeSpan (RealSrcSpan span _) =   ( unpackFS $ srcSpanFile span   , srcSpanStartLine span   , srcSpanStartCol span@@ -75,8 +75,8 @@   ) -- TODO: the bad locations are all (-1) right now -- is this fine? it should be, since noLoc from HSE previously also used (-1) as an invalid location-toOldeSpan (UnhelpfulSpan str) =-  ( unpackFS str+toOldeSpan (UnhelpfulSpan _) =+  ( "no-span"   , -1   , -1   , -1@@ -98,13 +98,13 @@       ))  toOldeLoc :: SrcLoc -> (String, Int, Int)-toOldeLoc (RealSrcLoc loc) =+toOldeLoc (RealSrcLoc loc _) =   ( unpackFS $ srcLocFile loc   , srcLocLine loc   , srcLocCol loc   )-toOldeLoc (UnhelpfulLoc str) =-  ( unpackFS str+toOldeLoc (UnhelpfulLoc _) =+  ( "no-loc"   , -1   , -1   )
src/GHC/Util/ApiAnnotation.hs view
@@ -5,12 +5,10 @@   , mkFlags, mkLanguagePragmas ) where -import ApiAnnotation-import SrcLoc+import GHC.Parser.Annotation+import GHC.Types.SrcLoc  import Control.Applicative-import qualified Data.Map.Strict as Map-import Data.Maybe import Data.List.Extra  trimCommentStart :: String -> String@@ -56,12 +54,15 @@   -- encountered in the source file with the last at the head of the   -- list (makes sense when you think about it).   reverse-    [ (c, s) |-        c@(L _ (AnnBlockComment comm)) <- fromMaybe [] $ Map.lookup noSrcSpan (snd anns)+    [ (realToLoc c, s) |+        c@(L _ (AnnBlockComment comm)) <- apiAnnRogueComments anns       , let body = trimCommentDelims comm       , Just rest <- [stripSuffix "#" =<< stripPrefix "#" body]       , let s = trim rest     ]+   where+     realToLoc :: RealLocated a -> Located a+     realToLoc (L r x) = L (RealSrcSpan r Nothing) x  -- Utility for a case insensitive prefix strip. stripPrefixCI :: String -> String -> Maybe String
src/GHC/Util/Brackets.hs view
@@ -4,8 +4,8 @@ module GHC.Util.Brackets (Brackets(..), isApp,isOpApp,isAnyApp) where  import GHC.Hs-import SrcLoc-import BasicTypes+import GHC.Types.SrcLoc+import GHC.Types.Basic import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Refact.Types @@ -111,8 +111,8 @@     ParPat{} -> True     TuplePat{} -> True     ListPat{} -> True-    ConPatIn _ RecCon{} -> True-    ConPatIn _ (PrefixCon []) -> True+    ConPat _ _ RecCon{} -> True+    ConPat _ _ (PrefixCon []) -> True     VarPat{} -> True     WildPat{} -> True     SumPat{} -> True
src/GHC/Util/DynFlags.hs view
@@ -1,6 +1,6 @@ module GHC.Util.DynFlags (initGlobalDynFlags, baseDynFlags) where -import DynFlags+import GHC.Driver.Session import GHC.LanguageExtensions.Type import Data.List.Extra import Language.Haskell.GhclibParserEx.GHC.Settings.Config
src/GHC/Util/FreeVars.hs view
@@ -7,13 +7,12 @@     Vars (..), FreeVars(..) , AllVars (..)   ) where -import RdrName-import GHC.Hs.Types-import OccName-import Name+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence+import GHC.Types.Name import GHC.Hs-import SrcLoc-import Bag (bagToList)+import GHC.Types.SrcLoc+import GHC.Data.Bag (bagToList)  import Data.Generics.Uniplate.DataOnly import Data.Monoid@@ -98,7 +97,7 @@  instance FreeVars (LHsExpr GhcPs) where   freeVars (L _ (HsVar _ x)) = Set.fromList $ unqualNames x -- Variable.-  freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [unboundVarOcc x] -- Unbound variable; also used for "holes".+  freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [x] -- Unbound variable; also used for "holes".   freeVars (L _ (HsLam _ mg)) = free (allVars mg) -- Lambda abstraction. Currently always a single match.   freeVars (L _ (HsLamCase _ MG{mg_alts=(L _ ms)})) = free (allVars ms) -- Lambda case   freeVars (L _ (HsCase _ of_ MG{mg_alts=(L _ ms)})) = freeVars of_ ^+ free (allVars ms) -- Case expr.@@ -107,6 +106,8 @@   freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map freeVars flds -- Record construction.   freeVars (L _ (RecordUpd _ e flds)) = Set.unions $ freeVars e : map freeVars flds -- Record update.   freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if.+  freeVars (L _ (HsBracket _ (ExpBr _ e))) = freeVars e+  freeVars (L _ (HsBracket _ (VarBr _ _ v))) = Set.fromList [occName v]    freeVars (L _ HsConLikeOut{}) = mempty -- After typechecker.   freeVars (L _ HsRecFld{}) = mempty -- Variable pointing to a record selector.@@ -116,7 +117,6 @@   freeVars (L _ HsLit{}) = mempty -- Simple literal.   freeVars (L _ HsRnBracketOut{}) = mempty -- Renamer produces these.   freeVars (L _ HsTcBracketOut{}) = mempty -- Typechecker produces these.-  freeVars (L _ HsWrap{}) = mempty -- Typechecker output.    -- freeVars (e@(L _ HsAppType{})) = freeVars $ children e -- Visible type application e.g. f @ Int x y.   -- freeVars (e@(L _ HsApp{})) = freeVars $ children e -- Application.@@ -162,12 +162,11 @@ instance AllVars (Located (Pat GhcPs)) where   allVars (L _ (VarPat _ (L _ x))) = Vars (Set.singleton $ rdrNameOcc x) Set.empty -- Variable pattern.   allVars (L _ (AsPat _  n x)) = allVars (noLoc $ VarPat noExtField n :: LPat GhcPs) <> allVars x -- As pattern.-  allVars (L _ (ConPatIn _ (RecCon (HsRecFields flds _)))) = allVars flds+  allVars (L _ (ConPat _ _ (RecCon (HsRecFields flds _)))) = allVars flds   allVars (L _ (NPlusKPat _ n _ _ _ _)) = allVars (noLoc $ VarPat noExtField n :: LPat GhcPs) -- n+k pattern.   allVars (L _ (ViewPat _ e p)) = freeVars_ e <> allVars p -- View pattern.    allVars (L _ WildPat{}) = mempty -- Wildcard pattern.-  allVars (L _ ConPatOut{}) = mempty -- Renamer/typechecker.   allVars (L _ LitPat{}) = mempty -- Literal pattern.   allVars (L _ NPat{}) = mempty -- Natural pattern. @@ -188,7 +187,7 @@  instance AllVars (LStmt GhcPs (LHsExpr GhcPs)) where   allVars (L _ (LastStmt _ expr _ _)) = freeVars_ expr -- The last stmt of a ListComp, MonadComp, DoExpr,MDoExpr.-  allVars (L _ (BindStmt _ pat expr _ _)) = allVars pat <> freeVars_ expr -- A generator e.g. x <- [1, 2, 3].+  allVars (L _ (BindStmt _ pat expr)) = allVars pat <> freeVars_ expr -- A generator e.g. x <- [1, 2, 3].   allVars (L _ (BodyStmt _ expr _ _)) = freeVars_ expr -- A boolean guard e.g. even x.   allVars (L _ (LetStmt _ binds)) = allVars binds -- A local declaration e.g. let y = x + 1   allVars (L _ (TransStmt _ _ stmts _ using by _ _ fmap_)) = allVars stmts <> freeVars_ using <> maybe mempty freeVars_ by <> freeVars_ (noLoc fmap_ :: Located (HsExpr GhcPs)) -- Apply a function to a list of statements in order.@@ -197,21 +196,14 @@   allVars (L _ ApplicativeStmt{}) = mempty -- Generated by the renamer.   allVars (L _ ParStmt{}) = mempty -- Parallel list thing. Come back to it. -  allVars _ = mempty -- New ctor.- instance AllVars (LHsLocalBinds GhcPs) where   allVars (L _ (HsValBinds _ (ValBinds _ binds _))) = allVars (bagToList binds) -- Value bindings.   allVars (L _ (HsIPBinds _ (IPBinds _ binds))) = allVars binds -- Implicit parameter bindings.-   allVars (L _ EmptyLocalBinds{}) =  mempty -- The case of no local bindings (signals the empty `let` or `where` clause). -  allVars _ = mempty -- New ctor.- instance AllVars (LIPBind GhcPs) where   allVars (L _ (IPBind _ _ e)) = freeVars_ e -  allVars _ = mempty -- New ctor.- instance AllVars (LHsBind GhcPs) where   allVars (L _ FunBind{fun_id=n, fun_matches=MG{mg_alts=(L _ ms)}}) = allVars (noLoc $ VarPat noExtField n :: LPat GhcPs) <> allVars ms -- Function bindings and simple variable bindings e.g. f x = e, f !x = 3, f = e, !x = e, x `f` y = e   allVars (L _ PatBind{pat_lhs=n, pat_rhs=grhss}) = allVars n <> allVars grhss -- Ctor patterns and some other interesting cases e.g. Just x = e, (x) = e, x :: Ty = e.@@ -220,41 +212,28 @@   allVars (L _ VarBind{}) = mempty -- Typechecker.   allVars (L _ AbsBinds{}) = mempty -- Not sure but I think renamer. -  allVars _ = mempty -- New ctor.- instance AllVars (MatchGroup GhcPs (LHsExpr GhcPs)) where   allVars (MG _ _alts@(L _ alts) _) = inVars (foldMap (allVars . m_pats) ms) (allVars (map m_grhss ms))     where ms = map unLoc alts-  allVars _ = mempty -- New ctor.  instance AllVars (LMatch GhcPs (LHsExpr GhcPs)) where   allVars (L _ (Match _ FunRhs {mc_fun=name} pats grhss)) = allVars (noLoc $ VarPat noExtField name :: LPat GhcPs) <> allVars pats <> allVars grhss -- A pattern matching on an argument of a function binding.   allVars (L _ (Match _ (StmtCtxt ctxt) pats grhss)) = allVars ctxt <> allVars pats <> allVars grhss -- Pattern of a do-stmt, list comprehension, pattern guard etc.   allVars (L _ (Match _ _ pats grhss)) = inVars (allVars pats) (allVars grhss) -- Everything else. -  allVars _ = mempty -- New ctor.--instance AllVars (HsStmtContext RdrName) where+instance AllVars (HsStmtContext GhcPs) where   allVars (PatGuard FunRhs{mc_fun=n}) = allVars (noLoc $ VarPat noExtField n :: LPat GhcPs)   allVars ParStmtCtxt{} = mempty -- Come back to it.   allVars TransStmtCtxt{}  = mempty -- Come back to it. -  allVars _ = mempty -- Everything else (correct).- instance AllVars (GRHSs GhcPs (LHsExpr GhcPs)) where   allVars (GRHSs _ grhss binds) = inVars binds (mconcatMap allVars grhss) -  allVars _ = mempty -- New ctor.- instance AllVars (LGRHS GhcPs (LHsExpr GhcPs)) where   allVars (L _ (GRHS _ guards expr)) = Vars (bound gs) (free gs ^+ (freeVars expr ^- bound gs)) where gs = allVars guards -  allVars _ = mempty -- New ctor.- instance AllVars (LHsDecl GhcPs) where   allVars (L l (ValD _ bind)) = allVars (L l bind :: LHsBind GhcPs)--  allVars _ = mempty  -- We only consider value bindings.   vars :: FreeVars a => a -> [String]
src/GHC/Util/HsDecl.hs view
@@ -4,7 +4,7 @@ where  import GHC.Hs-import SrcLoc+import GHC.Types.SrcLoc import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader  -- | @declName x@ returns the \"new name\" that is created (for
src/GHC/Util/HsExpr.hs view
@@ -15,12 +15,12 @@ ) where  import GHC.Hs-import BasicTypes-import SrcLoc-import FastString-import RdrName-import OccName-import Bag(bagToList)+import GHC.Types.Basic+import GHC.Types.SrcLoc+import GHC.Data.FastString+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence+import GHC.Data.Bag(bagToList)  import GHC.Util.Brackets import GHC.Util.FreeVars@@ -121,7 +121,7 @@ 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 _))))]) _) _ _)]+    [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]'.       | occNameStr x `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->@@ -245,10 +245,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 (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf noExtField a b c))  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)))+  (concatMap f bs, \xs -> L s (HsCase noExtField a (MG noExtField (L l (g bs xs)) Generated)))   where     f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]     f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs]@@ -256,7 +256,7 @@      g :: [LMatch GhcPs (LHsExpr GhcPs)] -> [LHsExpr GhcPs] -> [LMatch GhcPs (LHsExpr GhcPs)]     g (L s1 (Match _ CaseAlt a (GRHSs _ ns b)) : rest) xs =-      cL s1 (Match noExtField CaseAlt a (GRHSs noExtField [cL a (GRHS noExtField gs x) | (L a (GRHS _ gs _), x) <- zip ns as] b)) : g rest bs+      L s1 (Match noExtField CaseAlt a (GRHSs noExtField [L a (GRHS noExtField gs x) | (L a (GRHS _ gs _), x) <- zip ns as] b)) : g rest bs       where  (as, bs) = splitAt (length ns) xs     g [] [] = []     g _ _ = error "GHC.Util.HsExpr.replaceBranches': internal invariant failed, lists are of differing lengths"
src/GHC/Util/Scope.hs view
@@ -8,12 +8,12 @@ ) where  import GHC.Hs-import SrcLoc-import BasicTypes-import Module-import FastString-import RdrName-import OccName+import GHC.Types.SrcLoc+import GHC.Types.Basic+import GHC.Unit.Module+import GHC.Data.FastString+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence  import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -29,7 +29,7 @@     show (Scope x) = unsafePrettyPrint x  -- Create a 'Scope from a module's import declarations.-scopeCreate :: HsModule GhcPs -> Scope+scopeCreate :: HsModule -> Scope scopeCreate xs = Scope $ [prelude | not $ any isPrelude res] ++ res   where     -- Package qualifier of an import declaration.
src/GHC/Util/SrcLoc.hs view
@@ -5,8 +5,8 @@   , SrcSpanD(..)   ) where -import SrcLoc-import Outputable+import GHC.Types.SrcLoc+import GHC.Utils.Outputable  import Data.Default import Data.Data@@ -14,10 +14,31 @@  -- 'stripLocs x' is 'x' with all contained source locs replaced by -- 'noSrcSpan'.-stripLocs :: (Data from, HasSrcSpan from) => from -> from+stripLocs :: Data from => from -> from stripLocs = transformBi (const noSrcSpan) --- 'Duplicates.hs' requires 'SrcSpan' be in 'Default'.+-- TODO (2020-10-03, SF): Maybe move the following definitions down to+-- ghc-lib-parser at some point.++-- 'Duplicates.hs' requires 'SrcSpan' be in 'Default' and 'Ord'. newtype SrcSpanD = SrcSpanD SrcSpan-  deriving (Outputable, Eq, Ord)+  deriving (Outputable, Eq) instance Default SrcSpanD where def = SrcSpanD noSrcSpan++-- SrcSpan no longer provides 'Ord' so we are forced to roll our own.+--+-- Note: This implementation chooses that any span compares 'EQ to an+-- 'UnhelpfulSpan'. Ex falso quodlibet!+compareSrcSpans (SrcSpanD a) (SrcSpanD b) =+  case a of+    RealSrcSpan a1 _ ->+      case b of+        RealSrcSpan b1 _ ->+          a1 `compareRealSrcSpans` b1+        _ -> EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"+    _ -> EQ -- error "'Duplicate.hs' invariant error: can't compare unhelpful spans"+compareRealSrcSpans a b =+  let (a1, a2, a3, a4, a5) = (srcSpanFile a, srcSpanStartLine a, srcSpanStartCol a, srcSpanEndLine a, srcSpanEndCol a)+      (b1, b2, b3, b4, b5) = (srcSpanFile b, srcSpanStartLine b, srcSpanStartCol b, srcSpanEndLine b, srcSpanEndCol b)+  in compare (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)+instance Ord SrcSpanD where compare = compareSrcSpans
src/GHC/Util/Unify.hs view
@@ -16,9 +16,9 @@ import Util  import GHC.Hs-import SrcLoc-import Outputable hiding ((<>))-import RdrName+import GHC.Types.SrcLoc+import GHC.Utils.Outputable hiding ((<>))+import GHC.Types.Name.Reader  import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr@@ -27,7 +27,7 @@ import GHC.Util.HsExpr import GHC.Util.View import Data.Maybe-import FastString+import GHC.Data.FastString  isUnifyVar :: String -> Bool isUnifyVar [x] = x == '?' || isAlpha x@@ -73,13 +73,13 @@     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 (L 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 (L 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 (L loc (SectionR noExtField y exp))     exp _ = Nothing      pat :: LPat GhcPs -> LPat GhcPs@@ -224,6 +224,10 @@ unifyExp' nm root x y@(L _ (OpApp _ lhs2 op2@(L _ (HsVar _ op2')) rhs2)) =   noExtra $ unifyExp nm root x y +unifyExp' nm root (L _ (HsBracket _ (VarBr _ b0 (occNameStr -> v1))))+                  (L _ (HsBracket _ (VarBr _ b1 (occNameStr -> v2))))+    | b0 == b1 && isUnifyVar v1 = Just (Subst [(v1, strToVar v2)])+ unifyExp' nm root x y | isOther x, isOther y = unifyDef' nm x y     where         -- Types that are not already handled in unify.@@ -242,7 +246,7 @@   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 =+unifyPat' nm (L _ (ConPat _ x _)) (L _ (ConPat _ y _)) | rdrNameStr x /= rdrNameStr y =   Nothing unifyPat' nm x y =   unifyDef' nm x y@@ -251,6 +255,6 @@ unifyType' nm (L loc (HsTyVar _ _ x)) y =   let wc = HsWC noExtField y :: LHsWcType (NoGhcTc GhcPs)       unused = strToVar "__unused__" :: LHsExpr GhcPs-      appType = cL loc (HsAppType noExtField unused wc) :: LHsExpr GhcPs+      appType = L loc (HsAppType noExtField unused wc) :: LHsExpr GhcPs  in Just $ Subst [(rdrNameStr x, appType)] unifyType' nm x y = unifyDef' nm x y
src/GHC/Util/View.hs view
@@ -8,9 +8,9 @@ ) where  import GHC.Hs-import RdrName-import SrcLoc-import BasicTypes+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+import GHC.Types.Basic import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import GHC.Util.Brackets @@ -54,9 +54,9 @@   view _ = NoPVar_  instance View (Located (Pat GhcPs)) PApp_ where-  view (fromPParen -> L _ (ConPatIn (L _ x) (PrefixCon args))) =+  view (fromPParen -> L _ (ConPat _ (L _ x) (PrefixCon args))) =     PApp_ (occNameStr x) args-  view (fromPParen -> L _ (ConPatIn (L _ x) (InfixCon lhs rhs))) =+  view (fromPParen -> L _ (ConPat _ (L _ x) (InfixCon lhs rhs))) =     PApp_ (occNameStr x) [lhs, rhs]   view _ = NoPApp_
src/Hint/Bracket.hs view
@@ -28,11 +28,11 @@ main = do f; (print x) -- @Suggestion do f print x yes = f (x) y -- @Warning x no = f (+x) y-no = f ($x) y-no = ($x)-yes = (($x))-no = ($1)-yes = (($1)) -- @Warning ($1)+no = f ($ x) y+no = ($ x)+yes = (($ x))  -- @Warning ($ x)+no = ($ 1)+yes = (($ 1)) -- @Warning ($ 1) no = (+5) yes = ((+5)) -- @Warning (+5) issue909 = case 0 of { _ | n <- (0 :: Int) -> n }@@ -42,6 +42,8 @@ issue909 = do {((x :: y) -> z) <- e; return 1} issue970 = (f x +) (g x) -- f x + (g x) issue969 = (Just \x -> x || x) *> Just True+issue1179 = do(this is a test) -- do this is a test+issue1212 = $(Git.hash)  -- type bracket reduction foo :: (Int -> Int) -> Int@@ -108,8 +110,8 @@ import Refact.Types  import GHC.Hs-import Outputable-import SrcLoc+import GHC.Utils.Outputable+import GHC.Types.SrcLoc import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -117,8 +119,8 @@ bracketHint :: DeclHint bracketHint _ _ x =   concatMap (\x -> bracket prettyExpr isPartialAtom True x ++ dollar x) (childrenBi (descendBi annotations x) :: [LHsExpr GhcPs]) ++-  concatMap (bracket unsafePrettyPrint (const False) False) (childrenBi x :: [LHsType GhcPs]) ++-  concatMap (bracket unsafePrettyPrint (const False) False) (childrenBi x :: [LPat GhcPs]) +++  concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi x :: [LHsType GhcPs]) +++  concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi x :: [LPat GhcPs]) ++   concatMap fieldDecl (childrenBi x)    where      -- Brackets the roots of annotations are fine, so we strip them.@@ -140,41 +142,43 @@  -- 'Just _' if at least one set of parens were removed. 'Nothing' if -- zero parens were removed.-remParens' :: Brackets a => a -> Maybe a+remParens' :: Brackets (Located a) => Located a -> Maybe (Located a) remParens' = fmap go . remParen   where     go e = maybe e go (remParen e) -isPartialAtom :: LHsExpr GhcPs -> Bool+isPartialAtom :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool -- Might be '$x', which was really '$ x', but TH enabled misparsed it.-isPartialAtom (L _ (HsSpliceE _ (HsTypedSplice _ HasDollar _ _) )) = True-isPartialAtom (L _ (HsSpliceE _ (HsUntypedSplice _ HasDollar _ _) )) = True-isPartialAtom x = isRecConstr x || isRecUpdate x+isPartialAtom _ (L _ (HsSpliceE _ (HsTypedSplice _ DollarSplice _ _) )) = True+isPartialAtom _ (L _ (HsSpliceE _ (HsUntypedSplice _ DollarSplice _ _) )) = True+-- Might be '$(x)' where the brackets are required in GHC 8.10 and below+isPartialAtom (Just (L _ HsSpliceE{})) _ = True+isPartialAtom _ x = isRecConstr x || isRecUpdate x -bracket :: forall a . (Data a, HasSrcSpan a, Outputable a, Brackets a) => (a -> String) -> (a -> Bool) -> Bool -> a -> [Idea]+bracket :: forall a . (Data a, Outputable a, Brackets (Located a)) => (Located a -> String) -> (Maybe (Located a) -> Located a -> Bool) -> Bool -> Located a -> [Idea] bracket pretty isPartialAtom root = f Nothing   where     msg = "Redundant bracket"     -- 'f' is a (generic) function over types in 'Brackets     -- (expressions, patterns and types). Arguments are, 'f (Maybe     -- (index, parent, gen)) child'.-    f :: (HasSrcSpan a, Data a, Outputable a, Brackets a) => Maybe (Int, a , a -> a) -> a -> [Idea]+    f :: (Data a, Outputable a, Brackets (Located a)) => Maybe (Int, Located a , Located a -> Located a) -> Located a -> [Idea]     -- No context. Removing parentheses from 'x' succeeds?     f Nothing o@(remParens' -> Just x)       -- If at the root, or 'x' is an atom, 'x' parens are redundant.       | root || isAtom x-      , not $ isPartialAtom x =+      , not $ isPartialAtom Nothing x =           (if isAtom x then bracketError else bracketWarning) msg o x : g x     -- In some context, removing parentheses from 'x' succeeds and 'x'     -- is atomic?-    f Just{} o@(remParens' -> Just x)+    f (Just (_, p, _)) o@(remParens' -> Just x)       | isAtom x-      , not $ isPartialAtom x =+      , not $ isPartialAtom (Just p) x =           bracketError msg o x : g x     -- In some context, removing parentheses from 'x' succeeds. Does     -- 'x' actually need bracketing in this context?     f (Just (i, o, gen)) v@(remParens' -> Just x)-      | not $ needBracket i o x, not $ isPartialAtom x =+      | not $ needBracket i o x, not $ isPartialAtom (Just o) x =           rawIdea Suggestion msg (getLoc v) (pretty o) (Just (pretty (gen x))) [] [r] : g x       where         typ = findType v@@ -183,16 +187,16 @@     -- from 'x'.     f _ x = g x -    g :: (HasSrcSpan a, Data a, Outputable a, Brackets a) => a -> [Idea]+    g :: (Data a, Outputable a, Brackets (Located a)) => Located a -> [Idea]     -- Enumerate over all the immediate children of 'o' looking for     -- redundant parentheses in each.     g o = concat [f (Just (i, o, gen)) x | (i, (x, gen)) <- zipFrom 0 $ holes o] -bracketWarning :: (HasSrcSpan a, HasSrcSpan b, Outputable a, Outputable b, Brackets b)  => String -> a -> b -> Idea+bracketWarning :: (Outputable a, Outputable b, Brackets (Located b))  => String -> Located a -> Located b -> Idea bracketWarning msg o x =   suggest msg o x [Replace (findType x) (toSS o) [("x", toSS x)] "x"] -bracketError :: (HasSrcSpan a, HasSrcSpan b, Outputable a, Outputable b, Brackets b) => String -> a -> b -> Idea+bracketError :: (Outputable a, Outputable b, Brackets (Located b)) => String -> Located a -> Located b -> Idea bracketError msg o x =   warn msg o x [Replace (findType x) (toSS o) [("x", toSS x)] "x"] @@ -226,7 +230,7 @@             , let y = noLoc (HsApp noExtField a b) :: LHsExpr GhcPs             , not $ needBracket 0 y a             , not $ needBracket 1 y b-            , not $ isPartialAtom b+            , not $ isPartialAtom (Just x) b             , let r = Replace Expr (toSS x) [("a", toSS a), ("b", toSS b)] "a b"]           ++           [ suggest "Move brackets to avoid $" x (t y) [r]
src/Hint/Comment.hs view
@@ -18,8 +18,8 @@ import Data.Char import Data.List.Extra import Refact.Types(Refactoring(ModifyComment))-import SrcLoc-import ApiAnnotation+import GHC.Types.SrcLoc+import GHC.Parser.Annotation import GHC.Util  directives :: [String]
src/Hint/Duplicate.hs view
@@ -33,10 +33,10 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map -import SrcLoc+import GHC.Types.SrcLoc import GHC.Hs-import Outputable-import Bag+import GHC.Utils.Outputable+import GHC.Data.Bag import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
src/Hint/Export.hs view
@@ -16,10 +16,10 @@ import Hint.Type(ModuHint, ModuleEx(..),ideaNote,ignore,Note(..))  import GHC.Hs-import Module-import SrcLoc-import OccName-import RdrName+import GHC.Unit.Module+import GHC.Types.SrcLoc+import GHC.Types.Name.Occurrence+import GHC.Types.Name.Reader  exportHint :: ModuHint exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = exports}) _)
src/Hint/Extensions.hs view
@@ -246,12 +246,12 @@ import qualified Data.Set as Set import qualified Data.Map as Map -import SrcLoc+import GHC.Types.SrcLoc import GHC.Hs-import BasicTypes-import Class-import RdrName-import ForeignCall+import GHC.Types.Basic+import GHC.Core.Class+import GHC.Types.Name.Reader+import GHC.Types.ForeignCall  import GHC.Util import GHC.LanguageExtensions.Type@@ -342,7 +342,7 @@ deriveStock :: [String] deriveStock = deriveHaskell ++ deriveGenerics ++ deriveCategory -usedExt :: Extension -> Located (HsModule GhcPs) -> Bool+usedExt :: Extension -> Located HsModule -> Bool usedExt NumDecimals = hasS isWholeFrac   -- Only whole number fractions are permitted by NumDecimals   -- extension.  Anything not-whole raises an error.@@ -350,8 +350,16 @@ usedExt DeriveAnyClass = not . null . derivesAnyclass . derives usedExt x = used x -used :: Extension -> Located (HsModule GhcPs) -> Bool-used RecursiveDo = hasS isMDo ||^ hasS isRecStmt+-- The ghc-lib-parser-ex functions are getting fixed to have the new+-- signatures.+isMDo' :: HsStmtContext GhcRn -> Bool+isMDo' = \case MDoExpr _ -> True; _ -> False+isStrictMatch' :: HsMatchContext GhcPs -> Bool+isStrictMatch' = \case FunRhs{mc_strictness=SrcStrict} -> True; _ -> False++used :: Extension -> Located HsModule -> Bool++used RecursiveDo = hasS isMDo' ||^ hasS isRecStmt used ParallelListComp = hasS isParComp used FunctionalDependencies = hasT (un :: FunDep (Located RdrName)) used ImplicitParams = hasT (un :: HsIPName)@@ -368,7 +376,7 @@     f (HsLamCase _ (MG _ (L _ []) _)) = True     f _ = False used KindSignatures = hasT (un :: HsKind GhcPs)-used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch+used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch' used TemplateHaskell = hasT2' (un :: (HsBracket GhcPs, HsSplice GhcPs)) ||^ hasS f ||^ hasS isSpliceDecl   where     f :: HsBracket GhcPs -> Bool@@ -380,7 +388,6 @@   where     f :: GRHS GhcPs (LHsExpr GhcPs) -> Bool     f (GRHS _ xs _) = g xs-    f _ = False -- Extension constructor     g :: [GuardLStmt GhcPs] -> Bool     g [] = False     g [L _ BodyStmt{}] = False@@ -471,7 +478,7 @@  used _= const True -hasDerive :: [String] -> Located (HsModule GhcPs) -> Bool+hasDerive :: [String] -> Located HsModule -> Bool hasDerive want = any (`elem` want) . derivesStock' . derives  -- Derivations can be implemented using any one of 3 strategies, so for each derivation@@ -500,12 +507,11 @@     ,derivesNewtype' = if maybe True isNewType nt then filter (`notElem` noDeriveNewtype) xs else []}     where (stock, other) = partition (`elem` deriveStock) xs -derives :: Located (HsModule GhcPs) -> Derives+derives :: Located HsModule -> Derives derives (L _ m) =  mconcat $ map decl (childrenBi m) ++ map idecl (childrenBi m)   where     idecl :: Located (DataFamInstDecl GhcPs) -> Derives     idecl (L _ (DataFamInstDecl (HsIB _ FamEqn {feqn_rhs=HsDataDefn {dd_ND=dn, dd_derivs=(L _ ds)}}))) = g dn ds-    idecl _ = mempty      decl :: LHsDecl GhcPs -> Derives     decl (L _ (TyClD _ (DataDecl _ _ _ _ HsDataDefn {dd_ND=dn, dd_derivs=(L _ ds)}))) = g dn ds -- Data declaration.@@ -524,7 +530,6 @@         ih (L _ (HsAppTy _ a _)) = ih a         ih (L _ (HsTyVar _ _ a)) = unsafePrettyPrint $ unqual a         ih (L _ a) = unsafePrettyPrint a -- I don't anticipate this case is called.-    derivedToStr _ = "" -- new ctor  un = undefined
src/Hint/Fixities.hs view
@@ -24,21 +24,21 @@ import Data.Generics.Uniplate.DataOnly import Refact.Types -import BasicTypes (compareFixity)+import GHC.Types.Basic (compareFixity) import Fixity import GHC.Hs import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable-import OccName-import SrcLoc-import RdrName+import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence  fixitiesHint :: [Setting] -> DeclHint fixitiesHint settings _ _ x =   concatMap (infixBracket fixities) (childrenBi x :: [LHsExpr GhcPs])    where      fixities = foldMap getFixity settings `mappend` fromList (toFixity <$> defaultFixities)-     getFixity (Infix x) = uncurry singleton (toFixity x)+     getFixity (Infix x) = uncurry Data.Map.singleton (toFixity x)      getFixity _ = mempty  infixBracket :: Map String Fixity -> LHsExpr GhcPs -> [Idea]@@ -62,7 +62,7 @@             | i == 0 = (c, p)             | otherwise = (p, c)     in-    case compareFixity <$> (fixities Data.Map.!? occNameString lop) <*> (fixities Data.Map.!? occNameString rop) of+    case compareFixity <$> (fixities !? occNameString lop) <*> (fixities !? occNameString rop) of     Just (False, r)         | i == 0 -> not (needParenAsChild cr || r)         | otherwise -> r
src/Hint/Import.hs view
@@ -47,10 +47,11 @@ import Control.Applicative import Prelude -import FastString-import BasicTypes+import GHC.Data.FastString+import GHC.Types.Basic import GHC.Hs-import SrcLoc+import GHC.Types.SrcLoc+import GHC.Unit.Types -- for 'NotBoot'  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable @@ -60,7 +61,7 @@   -- Ideas for combining multiple imports.   concatMap (reduceImports . snd) (     groupSort [((n, pkg), i) | i <- ms-              , not $ ideclSource (unLoc i)+              , ideclSource (unLoc i) == NotBoot               , let i' = unLoc i               , let n = unLoc $ ideclName i'               , let pkg  = unpackFS . sl_fs <$> ideclPkgQual i']) ++@@ -133,5 +134,5 @@ stripRedundantAlias x@(L loc i@ImportDecl {..})   -- Suggest 'import M as M' be just 'import M'.   | Just (unLoc ideclName) == fmap unLoc ideclAs =-      [suggest "Redundant as" x (cL loc i{ideclAs=Nothing} :: LImportDecl GhcPs) [RemoveAsKeyword (toSS x)]]+      [suggest "Redundant as" x (L loc i{ideclAs=Nothing} :: LImportDecl GhcPs) [RemoveAsKeyword (toSS x)]] stripRedundantAlias _ = []
src/Hint/Lambda.hs view
@@ -113,11 +113,11 @@ import Refact.Types hiding (RType(Match)) import Data.Generics.Uniplate.DataOnly (universe, universeBi, transformBi) -import BasicTypes+import GHC.Types.Basic import GHC.Hs-import OccName-import RdrName-import SrcLoc+import GHC.Types.Name.Occurrence+import GHC.Types.Name.Reader+import GHC.Types.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@@ -259,7 +259,7 @@                  oldMG@(MG _ (L _ [L _ oldmatch]) _)                    | all (\(L _ (GRHS _ stmts _)) -> null stmts) (grhssGRHSs (m_grhss oldmatch)) ->                      let patLocs = fmap getLoc (m_pats oldmatch)-                         bodyLocs = concatMap (\case L _ (GRHS _ _ body) -> [getLoc body]; _ -> [])+                         bodyLocs = concatMap (\case L _ (GRHS _ _ body) -> [getLoc body])                                         $ grhssGRHSs (m_grhss oldmatch)                          r | notNull patLocs && notNull bodyLocs =                              let xloc = foldl1' combineSrcSpans patLocs@@ -287,7 +287,6 @@                  MG _ (L _ _) _ ->                      [(suggestN "Use lambda-case" o $ noLoc $ HsLamCase noExtField matchGroup)                          {ideaNote=[RequiresExtension "LambdaCase"]}]-                 _ -> []         _ -> []     where         -- | Filter out tuple arguments, converting the @x@ (matched in the lambda) variable argument
src/Hint/List.hs view
@@ -51,12 +51,11 @@ import qualified Refact.Types as R  import GHC.Hs-import SrcLoc-import BasicTypes-import RdrName-import Name-import FastString-import TysWiredIn+import GHC.Types.SrcLoc+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Data.FastString+import GHC.Builtin.Types  import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.Pat@@ -66,6 +65,7 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader + listHint :: DeclHint listHint _ _ = listDecl @@ -92,7 +92,7 @@   listCompCheckMap o mp f MonadComp stmts listComp _ = [] -listCompCheckGuards :: LHsExpr GhcPs -> HsStmtContext Name -> [ExprLStmt GhcPs] -> [Idea]+listCompCheckGuards :: LHsExpr GhcPs -> HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> [Idea] listCompCheckGuards o ctx stmts =   let revs = reverse stmts       e@(L _ LastStmt{}) = head revs -- In a ListComp, this is always last.@@ -115,7 +115,7 @@         qualCon _ = Nothing  listCompCheckMap ::-  LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsStmtContext Name -> [ExprLStmt GhcPs] -> [Idea]+  LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> [Idea] listCompCheckMap o mp f ctx stmts  | varToStr mp == "map" =     [suggest "Move map inside list comprehension" o o2 (suggestExpr o o2)]     where@@ -131,7 +131,7 @@ moveGuardsForward :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs] moveGuardsForward = reverse . f [] . reverse   where-    f guards (x@(L _ (BindStmt _ p _ _ _)) : xs) = reverse stop ++ x : f move xs+    f guards (x@(L _ (BindStmt _ p _)) : xs) = reverse stop ++ x : f move xs       where (move, stop) =               span (if any hasPFieldsDotDot (universeBi x)                        || any isPFieldWildcard (universeBi x)
src/Hint/ListRec.hs view
@@ -40,16 +40,16 @@ import Control.Monad import Refact.Types hiding (RType(Match)) -import SrcLoc+import GHC.Types.SrcLoc import GHC.Hs.Extension import GHC.Hs.Pat-import GHC.Hs.Types-import TysWiredIn-import RdrName+import GHC.Builtin.Types+import GHC.Hs.Type+import GHC.Types.Name.Reader import GHC.Hs.Binds import GHC.Hs.Expr import GHC.Hs.Decls-import BasicTypes+import GHC.Types.Basic  import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.Pat@@ -119,7 +119,7 @@       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+    , [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 $@@ -141,9 +141,9 @@                                         [L _ (GRHS _ [] rhs)]                                         (L _ (EmptyLocalBinds _))}]}))       ) =-  [ noLoc $ BindStmt noExtField v lhs noSyntaxExpr noSyntaxExpr+  [ noLoc $ BindStmt noExtField v lhs   , noLoc $ BodyStmt noExtField rhs noSyntaxExpr noSyntaxExpr ]-asDo (L _ (HsDo _ DoExpr (L _ stmts))) = stmts+asDo (L _ (HsDo _ (DoExpr _) (L _ stmts))) = stmts asDo x = [noLoc $ BodyStmt noExtField x noSyntaxExpr noSyntaxExpr]  @@ -223,8 +223,8 @@  readPat :: LPat GhcPs -> Maybe (Either String BList) readPat (view -> PVar_ x) = Just $ Left x-readPat (L _ (ParPat _ (L _ (ConPatIn (L _ n) (InfixCon (view -> PVar_ x) (view -> PVar_ xs))))))+readPat (L _ (ParPat _ (L _ (ConPat _ (L _ n) (InfixCon (view -> PVar_ x) (view -> PVar_ xs))))))  | n == consDataCon_RDR = Just $ Right $ BCons x xs-readPat (L _ (ConPatIn (L _ n) (PrefixCon [])))+readPat (L _ (ConPat _ (L _ n) (PrefixCon [])))   | n == nameRdrName nilDataConName = Just $ Right BNil readPat _ = Nothing
src/Hint/Match.hs view
@@ -40,6 +40,10 @@ module Hint.Match(readMatch) where  import Hint.Type (ModuleEx,Idea,idea,ideaNote,toSS)++-- import Language.Haskell.GhclibParserEx.Dump+-- import GHC.Utils.Outputable+ import Util import Timing import qualified Data.Set as Set@@ -51,18 +55,19 @@ import Config.Type import Data.Generics.Uniplate.DataOnly -import Bag+import GHC.Data.Bag import GHC.Hs-import SrcLoc-import BasicTypes-import RdrName-import OccName+import GHC.Types.SrcLoc+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence import Data.Data import GHC.Util 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+-- import Debug.Trace  readMatch :: [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea] readMatch settings = findIdeas (concatMap readRule settings)@@ -99,8 +104,8 @@    --   If a == b then   --   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)+  let lSec = addParen (L l (SectionL noExtField x op)) -- (a == )+      rSec = addParen (L l (SectionR noExtField op y)) -- ( == b)   in (first (lSec :) <$> dotVersion y) ++ (first (rSec :) <$> dotVersion x) -- [([(a ==)], b), ([(b == )], a])]. dotVersion _ = [] @@ -215,8 +220,8 @@       asInt :: LHsExpr GhcPs -> Maybe Integer       asInt (L _ (HsPar _ x)) = asInt x       asInt (L _ (NegApp _ x _)) = negate <$> asInt x-      asInt (L _ (HsLit _ (HsInt _ (IL _ neg x)) )) = Just $ if neg then -x else x-      asInt (L _ (HsOverLit _ (OverLit _ (HsIntegral (IL _ neg x)) _))) = Just $ if neg then -x else x+      asInt (L _ (HsLit _ (HsInt _ (IL _ _ x)) )) = Just x+      asInt (L _ (HsOverLit _ (OverLit _ (HsIntegral (IL _ _ x)) _))) = Just x       asInt _ = Nothing        list :: LHsExpr GhcPs -> [LHsExpr GhcPs]
src/Hint/Monad.hs view
@@ -63,12 +63,11 @@ import Hint.Type  import GHC.Hs hiding (Warning)-import SrcLoc-import BasicTypes-import TcEvidence-import RdrName-import OccName-import Bag+import GHC.Types.SrcLoc+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence+import GHC.Data.Bag import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -109,19 +108,19 @@   case x of     (view -> App2 op x1 x2) | isTag ">>" op -> f x1     (view -> App2 op x1 (view -> LamConst1 _)) | isTag ">>=" op -> f x1-    (L l (HsApp _ op x)) | isTag "void" op -> seenVoid (cL l . HsApp noExtField op) x-    (L l (OpApp _ op dol x)) | isTag "void" op, isDol dol -> seenVoid (cL l . OpApp noExtField op dol) x+    (L l (HsApp _ op x)) | isTag "void" op -> seenVoid (L l . HsApp noExtField op) x+    (L l (OpApp _ op dol x)) | isTag "void" op, isDol dol -> seenVoid (L l . OpApp noExtField op dol) x     (L loc (HsDo _ ctx (L loc2 [L loc3 (BodyStmt _ y _ _ )]))) ->-      let doOrMDo = case ctx of MDoExpr -> "mdo"; _ -> "do"+      let doOrMDo = case ctx of MDoExpr _ -> "mdo"; _ -> "do"        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 +++    (L loc (HsDo _ (DoExpr mm) (L _ xs))) ->+      monadSteps (L loc . HsDo noExtField (DoExpr mm) . noLoc) xs ++       [suggest "Use let" from to [r] | (from, to, r) <- monadLet xs] ++       concat [f x | (L _ (BodyStmt _ x _ _)) <- dropEnd1 xs] ++-      concat [f x | (L _ (BindStmt _ (LL _ WildPat{}) x _ _)) <- dropEnd1 xs]+      concat [f x | (L _ (BindStmt _ (L _ WildPat{}) x)) <- dropEnd1 xs]     _ -> []   where     f = monadNoResult (fromMaybe "" decl) id@@ -129,10 +128,10 @@       ++ [warn "Redundant void" (wrap x) x [Replace Expr (toSS (wrap x)) [("a", toSS x)] "a"] | returnsUnit x]     doSpan doOrMDo = \case       UnhelpfulSpan s -> UnhelpfulSpan s-      RealSrcSpan s ->+      RealSrcSpan s _ ->         let start = realSrcSpanStart s             end = mkRealSrcLoc (srcSpanFile s) (srcLocLine start) (srcLocCol start + length doOrMDo)-         in RealSrcSpan (mkRealSrcSpan start end)+         in RealSrcSpan (mkRealSrcSpan start end) Nothing  -- Sometimes people write 'a * do a + b', to avoid brackets, -- or using BlockArguments they can write 'a do a b',@@ -148,7 +147,7 @@ -- https://github.com/ndmitchell/hlint/issues/978 -- Return True if they are using do as avoiding identation doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool-doAsAvoidingIndentation (Just (L _ (HsDo _ _ (L (RealSrcSpan a) _)))) (L _ (HsDo _ _ (L (RealSrcSpan b) _)))+doAsAvoidingIndentation (Just (L _ (HsDo _ _ (L (RealSrcSpan a _) _)))) (L _ (HsDo _ _ (L (RealSrcSpan b _) _)))     = srcSpanStartCol a == srcSpanStartCol b doAsAvoidingIndentation parent self = False @@ -163,11 +162,11 @@ -- See through HsPar, and down HsIf/HsCase, return the name to use in -- the hint, and the revised expression. monadNoResult :: String -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]-monadNoResult inside wrap (L l (HsPar _ x)) = monadNoResult inside (wrap . cL l . HsPar noExtField) x-monadNoResult inside wrap (L l (HsApp _ x y)) = monadNoResult inside (\x -> wrap $ cL l (HsApp noExtField x y)) x+monadNoResult inside wrap (L l (HsPar _ x)) = monadNoResult inside (wrap . L l . HsPar noExtField) x+monadNoResult inside wrap (L l (HsApp _ x y)) = monadNoResult inside (\x -> wrap $ L 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-    | occNameStr op == ">>=" = monadNoResult inside (wrap . cL l . OpApp noExtField x tag) y+    | isDol tag = monadNoResult inside (\x -> wrap $ L l (OpApp noExtField x tag y)) x+    | occNameStr op == ">>=" = monadNoResult inside (wrap . L l . OpApp noExtField x tag) y monadNoResult inside wrap x     | x2 : _ <- filter (`isTag` x) badFuncs     , let x3 = x2 ++ "_"@@ -185,14 +184,14 @@   = [ideaRemove Warning ("Redundant " ++ ret) (getLoc o) (unsafePrettyPrint o) [Delete Stmt (toSS o)]]  -- Rewrite 'do a <- $1; return a' as 'do $1'.-monadStep wrap o@[ g@(L _ (BindStmt _ (LL _ (VarPat _ (L _ p))) x _ _ ))+monadStep wrap o@[ g@(L _ (BindStmt _ (L _ (VarPat _ (L _ p))) x))                   , q@(L _ (BodyStmt _ (fromRet -> Just (ret, L _ (HsVar _ (L _ 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)]]  -- Suggest to use join. Rewrite 'do x <- $1; x; $2' as 'do join $1; $2'.-monadStep wrap o@(g@(L _ (BindStmt _ (view -> PVar_ p) x _ _)):q@(L _ (BodyStmt _ (view -> Var_ v) _ _)):xs)+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@@ -202,9 +201,9 @@  -- Redundant variable capture. Rewrite 'do _ <- <return ()>; $1' as -- 'do <return ()>; $1'.-monadStep wrap (o@(L loc (BindStmt _ p x _ _)) : rest)+monadStep wrap (o@(L loc (BindStmt _ p x)) : rest)     | isPWildcard p, returnsUnit x-    = let body = cL loc $ BodyStmt noExtField x noSyntaxExpr noSyntaxExpr :: ExprLStmt GhcPs+    = let body = L loc $ BodyStmt noExtField x noSyntaxExpr noSyntaxExpr :: ExprLStmt GhcPs       in [warn "Redundant variable capture" o body [Replace Stmt (toSS o) [("x", toSS x)] "x"]]  -- Redundant unit return : 'do <return ()>; return ()'.@@ -216,7 +215,7 @@  -- Rewrite 'do x <- $1; return $ f $ g x' as 'f . g <$> x' monadStep wrap-  o@[g@(L _ (BindStmt _ (view -> PVar_ u) x _ _))+  o@[g@(L _ (BindStmt _ (view -> PVar_ u) x))     , q@(L _ (BodyStmt _ (fromApplies -> (ret:f:fs, view -> Var_ v)) _ _))]   | isReturn ret, notDol x, u == v, length fs < 3, all isSimple (f : fs), v `notElem` vars (f : fs)   =@@ -241,10 +240,10 @@ monadLet :: [ExprLStmt GhcPs] -> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)] monadLet xs = mapMaybe mkLet xs   where-    vs = concatMap pvars [p | (L _ (BindStmt _ p _ _ _)) <- xs]+    vs = concatMap pvars [p | (L _ (BindStmt _ p _ )) <- xs]      mkLet :: ExprLStmt GhcPs -> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)-    mkLet x@(L _ (BindStmt _ v@(view -> PVar_ p) (fromRet -> Just (_, y)) _ _ ))+    mkLet x@(L _ (BindStmt _ v@(view -> PVar_ p) (fromRet -> Just (_, y))))       | p `notElem` vars y, p `notElem` delete p vs       = Just (x, template p y, refact)       where@@ -258,7 +257,7 @@             grhs = noLoc (GRHS noExtField [] rhs)             grhss = GRHSs noExtField [grhs] (noLoc (EmptyLocalBinds noExtField))             match = noLoc $ Match noExtField (FunRhs p Prefix NoSrcStrict) [] grhss-            fb = noLoc $ FunBind noExtField p (MG noExtField (noLoc [match]) Generated) WpHole []+            fb = noLoc $ FunBind noExtField p (MG noExtField (noLoc [match]) Generated) []             binds = unitBag fb             valBinds = ValBinds noExtField binds []             localBinds = noLoc $ HsValBinds noExtField valBinds
src/Hint/Naming.hs view
@@ -49,13 +49,13 @@ import Data.Maybe import qualified Data.Set as Set -import BasicTypes-import FastString+import GHC.Types.Basic+import GHC.Data.FastString import GHC.Hs.Decls import GHC.Hs.Extension import GHC.Hs-import OccName-import SrcLoc+import GHC.Types.Name.Occurrence+import GHC.Types.SrcLoc  import Language.Haskell.GhclibParserEx.GHC.Hs.Decls import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -84,7 +84,7 @@         replacedDecl = replaceNames suggestedNames originalDecl  shorten :: LHsDecl GhcPs -> LHsDecl GhcPs-shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG _ (L locMatches matches) FromSource) _ _))) =+shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG _ (L locMatches matches) FromSource) _))) =     L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ map shortenMatch matches}}) shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ grhss@(GRHSs _ rhss _) _))) =     L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = map shortenLGRHS rhss}})@@ -93,22 +93,24 @@ shortenMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) shortenMatch (L locMatch match@(Match _ _ _ grhss@(GRHSs _ rhss _))) =     L locMatch match {m_grhss = grhss {grhssGRHSs = map shortenLGRHS rhss}}-shortenMatch x = x  shortenLGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs) shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) =-    L locGRHS (GRHS ttg0 guards (cL locExpr dots))+    L locGRHS (GRHS ttg0 guards (L locExpr dots))     where         dots :: HsExpr GhcPs         dots = HsLit noExtField (HsString (SourceText "...") (mkFastString "..."))-shortenLGRHS x = x  getNames :: LHsDecl GhcPs -> [String] getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)  getConstructorNames :: HsDecl GhcPs -> [String] getConstructorNames (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ _ cons _))) =-    concatMap (map unsafePrettyPrint . getConNames . unLoc) cons+    concatMap (map unsafePrettyPrint . getConNames' . unLoc) cons+    where+      getConNames' ConDeclH98  {con_name  = name}  = [name]+      getConNames' ConDeclGADT {con_names = names} = names+ getConstructorNames _ = []  isSym :: String -> Bool
src/Hint/NewType.hs view
@@ -46,7 +46,7 @@ import Data.List (isSuffixOf) import GHC.Hs.Decls import GHC.Hs-import SrcLoc+import GHC.Types.SrcLoc import Data.Generics.Uniplate.Data import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable @@ -78,7 +78,6 @@ isData :: HsDataDefn GhcPs -> Bool isData (HsDataDefn _ NewType _ _ _ _ _) = False isData (HsDataDefn _ DataType _ _ _ _ _) = True-isData _ = False  hasStrategyClause :: LHsDerivingClause GhcPs -> Bool hasStrategyClause (L _ (HsDerivingClause _ (Just _) _)) = True@@ -129,7 +128,7 @@ -- | Checks whether its argument is a \"simple\" constructor (see criteria in 'singleSimpleField') -- returning the type inside the constructor if it is. This is needed for strictness analysis. simpleCons :: ConDecl GhcPs -> Maybe (HsType GhcPs)-simpleCons (ConDeclH98 _ _ _ [] context (PrefixCon [L _ inType]) _)+simpleCons (ConDeclH98 _ _ _ [] context (PrefixCon [HsScaled _ (L _ inType)]) _)     | emptyOrNoContext context     , not $ isUnboxedTuple inType     , not $ isHashy inType@@ -155,10 +154,13 @@  -- | The \"Bang\" here refers to 'HsSrcBang', which notably also includes @UNPACK@ pragmas! dropConsBang :: ConDecl GhcPs -> ConDecl GhcPs+-- fields [HsScaled GhcPs (LBangType GhcPs)] dropConsBang decl@(ConDeclH98 _ _ _ _ _ (PrefixCon fields) _) =-    decl {con_args = PrefixCon $ map getBangType fields}+    -- decl {con_args = PrefixCon $ map getBangType fields}+    let fs' = map (\(HsScaled s lt) -> HsScaled s (getBangType lt)) fields  :: [HsScaled GhcPs (LBangType GhcPs)]+    in decl {con_args = PrefixCon fs'} dropConsBang decl@(ConDeclH98 _ _ _ _ _ (RecCon (L recloc conDeclFields)) _) =-    decl {con_args = RecCon $ cL recloc $ removeUnpacksRecords conDeclFields}+    decl {con_args = RecCon $ L recloc $ removeUnpacksRecords conDeclFields}     where         removeUnpacksRecords :: [LConDeclField GhcPs] -> [LConDeclField GhcPs]         removeUnpacksRecords = map (\(L conDeclFieldLoc x) -> L conDeclFieldLoc $ removeConDeclFieldUnpacks x)@@ -166,8 +168,6 @@         removeConDeclFieldUnpacks :: ConDeclField GhcPs -> ConDeclField GhcPs         removeConDeclFieldUnpacks conDeclField@(ConDeclField _ _ fieldType _) =             conDeclField {cd_fld_type = getBangType fieldType}-        removeConDeclFieldUnpacks x = x-dropConsBang x = x  isUnboxedTuple :: HsType GhcPs -> Bool isUnboxedTuple (HsTupleTy _ HsUnboxedTuple _) = True
src/Hint/Pattern.hs view
@@ -69,11 +69,11 @@ import qualified Refact.Types as R (RType(Pattern, Match), SrcSpan)  import GHC.Hs-import SrcLoc-import RdrName-import OccName-import Bag-import BasicTypes+import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name.Occurrence+import GHC.Data.Bag+import GHC.Types.Basic  import GHC.Util import Language.Haskell.GhclibParserEx.GHC.Hs.Pat@@ -161,10 +161,10 @@     f _ = False     whereSpan = case l of       UnhelpfulSpan s -> UnhelpfulSpan s-      RealSrcSpan s ->+      RealSrcSpan s _ ->         let end = realSrcSpanEnd s             start = mkRealSrcLoc (srcSpanFile s) (srcLocLine end) (srcLocCol end - 5)-         in RealSrcSpan (mkRealSrcSpan start end)+         in RealSrcSpan (mkRealSrcSpan start end) Nothing hints gen (Pattern l t pats o@(GRHSs _ (unsnoc -> Just (gs, L _ (GRHS _ [test] bod))) binds))   | unsafePrettyPrint test == "True"   = let otherwise_ = noLoc $ BodyStmt noExtField (strToVar "otherwise") noSyntaxExpr noSyntaxExpr in@@ -173,7 +173,7 @@  asGuards :: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)] asGuards (L _ (HsPar _ x)) = asGuards x-asGuards (L _ (HsIf _ _ a b c)) = (a, b) : asGuards c+asGuards (L _ (HsIf _ a b c)) = (a, b) : asGuards c asGuards x = [(strToVar "otherwise", x)]  data Pattern = Pattern SrcSpan R.RType [LPat GhcPs] (GRHSs GhcPs (LHsExpr GhcPs))@@ -184,20 +184,19 @@   where     decl :: HsBind GhcPs -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]     decl o@(PatBind _ pat rhs _) = [(Pattern loc Bind [pat] rhs, \msg (Pattern _ _ [pat] rhs) rs -> suggest msg (L loc o :: LHsBind GhcPs) (noLoc (PatBind noExtField pat rhs ([], [])) :: LHsBind GhcPs) rs)]-    decl (FunBind _ _ (MG _ (L _ xs) _) _ _) = map match xs+    decl (FunBind _ _ (MG _ (L _ xs) _) _) = map match xs     decl _ = []      match :: LMatch GhcPs (LHsExpr GhcPs) -> (Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)     match o@(L loc (Match _ ctx pats grhss)) = (Pattern loc R.Match pats grhss, \msg (Pattern _ _ pats grhss) rs -> suggest msg o (noLoc (Match noExtField ctx  pats grhss) :: LMatch GhcPs (LHsExpr GhcPs)) rs)-    match _ = undefined -- {-# COMPLETE L #-}  -- First Bool is if 'Strict' is a language extension. Second Bool is -- if this pattern in this context is going to be evaluated strictly. patHint :: Bool -> Bool -> LPat GhcPs -> [Idea]-patHint _ _ o@(L _ (ConPatIn name (PrefixCon args)))+patHint _ _ o@(L _ (ConPat _ name (PrefixCon args)))   | length args >= 3 && all isPWildcard args =   let rec_fields = HsRecFields [] Nothing :: HsRecFields GhcPs (LPat GhcPs)-      new        = noLoc $ ConPatIn name (RecCon rec_fields) :: LPat GhcPs+      new        = noLoc $ ConPat noExtField name (RecCon rec_fields) :: LPat GhcPs   in   [suggest "Use record patterns" o new [Replace R.Pattern (toSS o) [] (unsafePrettyPrint new)]] patHint _ _ o@(L _ (VarPat _ (L _ name)))@@ -211,7 +210,7 @@     f (AsPat _ _ (L _ x)) = f x     f LitPat {} = True     f NPat {} = True-    f ConPatIn {} = True+    f ConPat {} = True     f TuplePat {} = True     f ListPat {} = True     f (SigPat _ (L _ p) _) = f p
src/Hint/Pragma.hs view
@@ -39,11 +39,11 @@ import Refact.Types import qualified Refact.Types as R -import ApiAnnotation-import SrcLoc+import GHC.Parser.Annotation+import GHC.Types.SrcLoc  import GHC.Util-import DynFlags+import GHC.Driver.Session  pragmaHint :: ModuHint pragmaHint _ modu =
src/Hint/Restrict.hs view
@@ -37,11 +37,11 @@ import Prelude  import GHC.Hs-import RdrName-import ApiAnnotation-import Module-import SrcLoc-import OccName+import GHC.Types.Name.Reader+import GHC.Parser.Annotation+import GHC.Unit.Module+import GHC.Types.SrcLoc+import GHC.Types.Name.Occurrence import Language.Haskell.GhclibParserEx.GHC.Hs import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader import GHC.Util
src/Hint/Smell.hs view
@@ -85,12 +85,11 @@ import Data.List.Extra import qualified Data.Map as Map -import BasicTypes+import GHC.Types.Basic import GHC.Hs-import RdrName-import Outputable-import Bag-import SrcLoc+import GHC.Utils.Outputable+import GHC.Data.Bag+import GHC.Types.SrcLoc import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable  smellModuleHint :: [Setting] -> ModuHint@@ -145,11 +144,10 @@ declSpans _ = []  -- The span of a guarded right hand side.-rhsSpans :: HsMatchContext RdrName -> LGRHS GhcPs (LHsExpr GhcPs) -> [(SrcSpan, Idea)]+rhsSpans :: HsMatchContext GhcPs -> LGRHS GhcPs (LHsExpr GhcPs) -> [(SrcSpan, Idea)] rhsSpans _ (L _ (GRHS _ _ (L _ RecordCon {}))) = [] -- record constructors get a pass rhsSpans ctx (L _ r@(GRHS _ _ (L l _))) =   [(l, rawIdea Config.Type.Warning "Long function" l (showSDocUnsafe (pprGRHS ctx r)) Nothing [] [])]-rhsSpans _ _ = []  -- The spans of a 'where' clause are the spans of its bindings. whereSpans :: LHsLocalBinds GhcPs -> [(SrcSpan, Idea)]@@ -158,7 +156,7 @@ whereSpans _ = []  spanLength :: SrcSpan -> Int-spanLength (RealSrcSpan span) = srcSpanEndLine span - srcSpanStartLine span + 1+spanLength (RealSrcSpan span _) = srcSpanEndLine span - srcSpanStartLine span + 1 spanLength (UnhelpfulSpan _) = -1  smellLongTypeLists :: LHsDecl GhcPs -> Int -> [Idea]@@ -177,7 +175,7 @@ smellManyArgFunctions _ _ = []  countFunctionArgs :: HsType GhcPs -> Int-countFunctionArgs (HsFunTy _ _ t) = 1 + countFunctionArgs (unLoc t)+countFunctionArgs (HsFunTy _ _ _ t) = 1 + countFunctionArgs (unLoc t) countFunctionArgs (HsParTy _ t) = countFunctionArgs (unLoc t) countFunctionArgs _ = 0
src/Hint/Unsafe.hs view
@@ -24,11 +24,11 @@ import Data.Generics.Uniplate.DataOnly  import GHC.Hs-import OccName-import RdrName-import FastString-import BasicTypes-import SrcLoc+import GHC.Types.Name.Occurrence+import GHC.Types.Name.Reader+import GHC.Data.FastString+import GHC.Types.Basic+import GHC.Types.SrcLoc import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
src/Idea.hs view
@@ -15,8 +15,8 @@ import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R import Prelude-import SrcLoc-import Outputable+import GHC.Types.SrcLoc+import GHC.Utils.Outputable import GHC.Util  import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable@@ -33,7 +33,7 @@     ,ideaNote :: [Note] -- ^ Notes about the effect of applying the replacement.     ,ideaRefactoring :: [Refactoring R.SrcSpan] -- ^ How to perform this idea     }-    deriving (Eq,Ord)+    deriving Eq  -- I don't use aeson here for 2 reasons: -- 1) Aeson doesn't esape unicode characters, and I want to (allows me to ignore encoding)@@ -89,8 +89,8 @@ rawIdeaN :: Severity -> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea rawIdeaN a b c d e f = Idea [] [] a b c d e f [] -idea :: (HasSrcSpan a, Outputable.Outputable a, HasSrcSpan b, Outputable.Outputable b) =>-         Severity -> String -> a -> b -> [Refactoring R.SrcSpan] -> Idea+idea :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>+         Severity -> String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea idea severity hint from to =   rawIdea severity hint (getLoc from) (unsafePrettyPrint from) (Just $ unsafePrettyPrint to) [] @@ -98,29 +98,29 @@ ideaRemove :: Severity -> String -> SrcSpan -> String -> [Refactoring R.SrcSpan] -> Idea ideaRemove severity hint span from = rawIdea severity hint span from (Just "") [] -suggest :: (HasSrcSpan a, Outputable.Outputable a, HasSrcSpan b, Outputable.Outputable b) =>-            String -> a -> b -> [Refactoring R.SrcSpan] -> Idea+suggest :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>+            String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea suggest = idea Suggestion  suggestRemove :: String -> SrcSpan -> String -> [Refactoring R.SrcSpan] -> Idea suggestRemove = ideaRemove Suggestion -warn :: (HasSrcSpan a, Outputable.Outputable a, HasSrcSpan b, Outputable.Outputable b) =>-         String -> a -> b -> [Refactoring R.SrcSpan] -> Idea+warn :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>+         String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea warn = idea Warning -ignoreNoSuggestion :: (HasSrcSpan a, Outputable.Outputable a)-                    => String -> a -> Idea+ignoreNoSuggestion :: (GHC.Utils.Outputable.Outputable a)+                    => String -> Located a -> Idea ignoreNoSuggestion hint x = rawIdeaN Ignore hint (getLoc x) (unsafePrettyPrint x) Nothing [] -ignore :: (HasSrcSpan a, Outputable.Outputable a) =>-           String -> a -> a -> [Refactoring R.SrcSpan] -> Idea+ignore :: (GHC.Utils.Outputable.Outputable a) =>+           String -> Located a -> Located a -> [Refactoring R.SrcSpan] -> Idea ignore = idea Ignore -ideaN :: (HasSrcSpan a, Outputable.Outputable a) =>-          Severity -> String -> a -> a -> Idea+ideaN :: (GHC.Utils.Outputable.Outputable a) =>+          Severity -> String -> Located a -> Located a -> Idea ideaN severity hint from to = idea severity hint from to [] -suggestN :: (HasSrcSpan a, Outputable.Outputable a) =>-             String -> a -> a -> Idea+suggestN :: (GHC.Utils.Outputable.Outputable a) =>+             String -> Located a -> Located a -> Idea suggestN = ideaN Suggestion
src/Language/Haskell/HLint.hs view
@@ -36,11 +36,11 @@ import qualified Apply as H import HLint import Fixity-import FastString ( unpackFS )+import GHC.Data.FastString ( unpackFS ) import GHC.All import Hint.All hiding (resolveHints) import qualified Hint.All as H-import SrcLoc+import GHC.Types.SrcLoc import CmdLine import Paths_hlint @@ -144,7 +144,7 @@ --   Following the GHC API, he end column is the column /after/ the end of the error. --   Lines and columns are 1-based. Returns 'Nothing' if there is no helpful location information. unpackSrcSpan :: SrcSpan -> Maybe (FilePath, (Int, Int), (Int, Int))-unpackSrcSpan (RealSrcSpan x) = Just+unpackSrcSpan (RealSrcSpan x _) = Just     (unpackFS $ srcSpanFile x     ,(srcSpanStartLine x, srcSpanStartCol x)     ,(srcSpanEndLine x, srcSpanEndCol x))
src/Refact.hs view
@@ -19,14 +19,14 @@ import System.Process.Extra import qualified Refact.Types as R -import qualified SrcLoc as GHC+import qualified GHC.Types.SrcLoc as GHC  substVars :: [String] substVars = [letter : number | number <- "" : map show [0..], letter <- ['a'..'z']]  toRefactSrcSpan :: GHC.SrcSpan -> R.SrcSpan toRefactSrcSpan = \case-    GHC.RealSrcSpan span ->+    GHC.RealSrcSpan span _ ->         R.SrcSpan (GHC.srcSpanStartLine span)                   (GHC.srcSpanStartCol span)                   (GHC.srcSpanEndLine span)@@ -36,7 +36,7 @@  -- | Don't crash in case ghc gives us a \"fake\" span, -- opting instead to show @-1 -1 -1 -1@ coordinates.-toSS :: GHC.HasSrcSpan a => a -> R.SrcSpan+toSS :: GHC.Located a -> R.SrcSpan toSS = toRefactSrcSpan . GHC.getLoc  checkRefactor :: Maybe FilePath -> IO FilePath@@ -51,7 +51,9 @@             ver <- readVersion . tail <$> readProcess exc ["--version"] ""             pure $ if ver >= minRefactorVersion                        then Right exc-                       else Left $ "Your version of refactor is too old, please upgrade to " ++ showVersion minRefactorVersion ++ " or later"+                       else Left $ "Your version of refactor is too old, please install apply-refact "+                                ++ showVersion minRefactorVersion+                                ++ " or later. Apply-refact can be installed from Cabal or Stack."         Nothing -> pure $ Left $ unlines                        [ "Could not find 'refactor' executable"                        , "Tried to find '" ++ excPath ++ "' on the PATH"@@ -72,4 +74,4 @@     waitForProcess phand  minRefactorVersion :: Version-minRefactorVersion = makeVersion [0,8,2,0]+minRefactorVersion = makeVersion [0,9,1,0]
src/Test/Annotations.hs view
@@ -27,10 +27,10 @@ import Test.Util import Prelude import Config.Yaml-import FastString+import GHC.Data.FastString  import GHC.Util-import SrcLoc+import GHC.Types.SrcLoc import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable  #ifdef HS_YAML
tests/hint.test view
@@ -45,9 +45,9 @@ OUTPUT tests/brackets.hs:1:8-49: Warning: Use fromMaybe Found:-  if isNothing x then (- 1.0) else fromJust x+  if isNothing x then (-1.0) else fromJust x Perhaps:-  fromMaybe (- 1.0) x+  fromMaybe (-1.0) x  1 hint