Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package hlint for openSUSE:Factory checked
in at 2024-03-20 21:14:36
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/hlint (Old)
and /work/SRC/openSUSE:Factory/.hlint.new.1905 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "hlint"
Wed Mar 20 21:14:36 2024 rev:14 rq:1157280 version:3.8
Changes:
--------
--- /work/SRC/openSUSE:Factory/hlint/hlint.changes 2023-11-23
21:43:08.457000268 +0100
+++ /work/SRC/openSUSE:Factory/.hlint.new.1905/hlint.changes 2024-03-20
21:16:48.307461151 +0100
@@ -1,0 +2,12 @@
+Sat Jan 20 13:28:58 UTC 2024 - Peter Simons <psim...@suse.com>
+
+- Update hlint to version 3.8.
+ 3.8, released 2024-01-15
+ #1552, make --git and --ignore-glob work nicely together
+ #1502, fix incorrect free variable calculation in some cases
+ #1555, slightly more efficient concatMap usages (e.g. pull filter out)
+ #1500, suggest avoiding NonEmpty.unzip (use Functor.unzip)
+ * #1544, upgrade to GHC 9.8
+ #1540, correct Functor law hint, was missing brackets
+
+-------------------------------------------------------------------
Old:
----
hlint-3.6.1.tar.gz
New:
----
hlint-3.8.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ hlint.spec ++++++
--- /var/tmp/diff_new_pack.IXYqOw/_old 2024-03-20 21:16:49.699513320 +0100
+++ /var/tmp/diff_new_pack.IXYqOw/_new 2024-03-20 21:16:49.703513471 +0100
@@ -1,7 +1,7 @@
#
# spec file for package hlint
#
-# Copyright (c) 2023 SUSE LLC
+# Copyright (c) 2024 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name hlint
%global pkgver %{pkg_name}-%{version}
Name: %{pkg_name}
-Version: 3.6.1
+Version: 3.8
Release: 0
Summary: Source code suggestions
License: BSD-3-Clause
++++++ hlint-3.6.1.tar.gz -> hlint-3.8.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/CHANGES.txt new/hlint-3.8/CHANGES.txt
--- old/hlint-3.6.1/CHANGES.txt 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/CHANGES.txt 2001-09-09 03:46:40.000000000 +0200
@@ -1,5 +1,12 @@
Changelog for HLint (* = breaking change)
+3.8, released 2024-01-15
+ #1552, make --git and --ignore-glob work nicely together
+ #1502, fix incorrect free variable calculation in some cases
+ #1555, slightly more efficient concatMap usages (e.g. pull filter out)
+ #1500, suggest avoiding NonEmpty.unzip (use Functor.unzip)
+* #1544, upgrade to GHC 9.8
+ #1540, correct Functor law hint, was missing brackets
3.6.1, released 2023-07-03
Attempt to make a binary release
3.6, released 2023-06-26
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/LICENSE new/hlint-3.8/LICENSE
--- old/hlint-3.6.1/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,4 @@
-Copyright Neil Mitchell 2006-2023.
+Copyright Neil Mitchell 2006-2024.
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/README.md new/hlint-3.8/README.md
--- old/hlint-3.6.1/README.md 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/README.md 2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,4 @@
-# HLint [](https://hackage.haskell.org/package/hlint)
[](https://www.stackage.org/package/hlint)
[](https://github.com/ndmitchell/hlint/actions)
+# HLint [](https://hackage.haskell.org/package/hlint)
[](https://www.stackage.org/package/hlint)
[](https://github.com/ndmitchell/hlint/actions)
HLint is a tool for suggesting possible improvements to Haskell code. These
suggestions include ideas such as using alternative functions, simplifying code
and spotting redundancies. This document is structured as follows:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/data/hlint.yaml
new/hlint-3.8/data/hlint.yaml
--- old/hlint-3.6.1/data/hlint.yaml 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/data/hlint.yaml 2001-09-09 03:46:40.000000000 +0200
@@ -214,6 +214,7 @@
- hint: {lhs: map f (zip x y), rhs: zipWith (curry f) x y, side: not
(isApp f)}
- hint: {lhs: "map f (fromMaybe [] x)", rhs: "maybe [] (map f) x"}
- hint: {lhs: "concatMap f (fromMaybe [] x)", rhs: "maybe [] (concatMap f)
x"}
+ - hint: {lhs: "concat (fromMaybe [] x)", rhs: "maybe [] concat x"}
- warn: {lhs: not (elem x y), rhs: notElem x y}
- warn: {lhs: not (notElem x y), rhs: elem x y}
- hint: {lhs: foldr f z (map g x), rhs: foldr (f . g) z x, name: Fuse
foldr/map}
@@ -472,11 +473,12 @@
# FUNCTOR
- warn: {lhs: fmap f (fmap g x), rhs: fmap (f . g) x, name: Functor law}
- - warn: {lhs: f <$> g <$> x, rhs: f . g <$> x, name: Functor law}
+ - warn: {lhs: f <$> (g <$> x), rhs: f . g <$> x, name: Functor law}
- warn: {lhs: x <&> g <&> f, rhs: x <&> f . g, name: Functor law}
- warn: {lhs: fmap id, rhs: id, name: Functor law}
- warn: {lhs: id <$> x, rhs: x, name: Functor law}
- warn: {lhs: x <&> id, rhs: x, name: Functor law}
+ - warn: {lhs: f <$> g <$> x, rhs: f . g <$> 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 -> b x <&> a, rhs: fmap a . b}
@@ -670,6 +672,7 @@
- hint: {lhs: "\\x y z -> (x, y, z)", rhs: "(,,)"}
- hint: {lhs: "(,b) a", rhs: "(a,b)", side: isAtom a, name: Evaluate}
- hint: {lhs: "(a,) b", rhs: "(a,b)", side: isAtom b, name: Evaluate}
+ - warn: {lhs: "Data.List.NonEmpty.unzip", rhs: "Data.Functor.unzip", name:
"Avoid NonEmpty.unzip", note: "The function is being deprecated"}
# MAYBE
@@ -878,9 +881,12 @@
- warn: {lhs: all f (concatMap g x), rhs: all (all f . g) x}
- warn: {lhs: fold (concatMap f x), rhs: foldMap (fold . f) x}
- warn: {lhs: foldMap f (concatMap g x), rhs: foldMap (foldMap f . g) x}
- - warn: {lhs: catMaybes (concatMap f x), rhs: concatMap (catMaybes . f) x,
name: Move concatMap out}
- - hint: {lhs: filter f (concatMap g x), rhs: concatMap (filter f . g) x,
name: Move concatMap out}
- - warn: {lhs: mapMaybe f (concatMap g x), rhs: concatMap (mapMaybe f . g)
x, name: Move concatMap out}
+ - warn: {lhs: catMaybes (concatMap f x), rhs: concatMap (catMaybes . f) x,
name: Move catMaybes}
+ - warn: {lhs: catMaybes (concat x), rhs: concatMap catMaybes x, name: Move
catMaybes}
+ - hint: {lhs: filter f (concatMap g x), rhs: concatMap (filter f . g) x,
name: Move filter}
+ - hint: {lhs: filter f (concat x), rhs: concatMap (filter f) x, name: Move
filter}
+ - warn: {lhs: mapMaybe f (concatMap g x), rhs: concatMap (mapMaybe f . g)
x, name: Move mapMaybe}
+ - warn: {lhs: mapMaybe f (concat x), rhs: concatMap (mapMaybe f) x, name:
Move mapMaybe}
- warn: {lhs: or (fmap p x), rhs: any p x}
- warn: {lhs: or (p <$> x), rhs: any p x}
- warn: {lhs: or (x <&> p), rhs: any p x}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/data/import_style.yaml
new/hlint-3.8/data/import_style.yaml
--- old/hlint-3.6.1/data/import_style.yaml 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/data/import_style.yaml 2001-09-09 03:46:40.000000000
+0200
@@ -4,3 +4,5 @@
- {name: HypotheticalModule3, importStyle: qualified}
- {name: 'HypotheticalModule3.*', importStyle: unqualified}
- {name: 'HypotheticalModule3.OtherSubModule', importStyle: unrestricted,
qualifiedStyle: post}
+ - {name: HypotheticalModule4, importStyle: qualified, as: HM4, asRequired:
true}
+ - {name: HypotheticalModule5, importStyle: qualified, qualifiedStyle: post}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/hlint.cabal new/hlint-3.8/hlint.cabal
--- old/hlint-3.6.1/hlint.cabal 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/hlint.cabal 2001-09-09 03:46:40.000000000 +0200
@@ -1,13 +1,13 @@
cabal-version: 1.18
build-type: Simple
name: hlint
-version: 3.6.1
+version: 3.8
license: BSD3
license-file: LICENSE
category: Development
author: Neil Mitchell <ndmitch...@gmail.com>
maintainer: Neil Mitchell <ndmitch...@gmail.com>
-copyright: Neil Mitchell 2006-2023
+copyright: Neil Mitchell 2006-2024
synopsis: Source code suggestions
description:
HLint gives suggestions on how to improve your source code.
@@ -36,7 +36,7 @@
extra-doc-files:
README.md
CHANGES.txt
-tested-with: GHC==9.6, GHC==9.4, GHC==9.2
+tested-with: GHC==9.8, GHC==9.6, GHC==9.4
source-repository head
type: git
@@ -81,16 +81,16 @@
deriving-aeson >= 0.2,
filepattern >= 0.1.1
- if !flag(ghc-lib) && impl(ghc >= 9.6.1) && impl(ghc < 9.7.0)
+ if !flag(ghc-lib) && impl(ghc >= 9.8.1) && impl(ghc < 9.9.0)
build-depends:
- ghc == 9.6.*,
+ ghc == 9.8.*,
ghc-boot-th,
ghc-boot
else
build-depends:
- ghc-lib-parser == 9.6.*
+ ghc-lib-parser == 9.8.*
build-depends:
- ghc-lib-parser-ex >= 9.6.0.0 && < 9.6.1
+ ghc-lib-parser-ex >= 9.8.0.0 && < 9.8.1
if flag(gpl)
build-depends: hscolour >= 1.21
@@ -159,6 +159,7 @@
Hint.Match
Hint.Monad
Hint.Naming
+ Hint.Negation
Hint.NewType
Hint.Pattern
Hint.Pragma
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Apply.hs new/hlint-3.8/src/Apply.hs
--- old/hlint-3.6.1/src/Apply.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Apply.hs 2001-09-09 03:46:40.000000000 +0200
@@ -17,7 +17,7 @@
import Config.Type
import Config.Haskell
import GHC.Types.SrcLoc
-import GHC.Hs
+import GHC.Hs hiding (comments)
import Language.Haskell.GhclibParserEx.GHC.Hs
import Data.HashSet qualified as Set
import Prelude
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/CmdLine.hs
new/hlint-3.8/src/CmdLine.hs
--- old/hlint-3.6.1/src/CmdLine.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/CmdLine.hs 2001-09-09 03:46:40.000000000 +0200
@@ -12,6 +12,7 @@
import Control.Exception.Extra
import Data.ByteString qualified as BS
import Data.Char
+import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Maybe
import Data.Functor
@@ -182,9 +183,9 @@
,"To check all Haskell files in 'src' and generate a report
type:"
," hlint src --report"]
] &= program "hlint" &= verbosity
- &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell
2006-2023")
+ &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell
2006-2024")
where
- nam xs = nam_ xs &= name [head xs]
+ nam xs = nam_ xs &= name [NE.head $ NE.fromList xs]
nam_ xs = def &= explicit &= name xs
-- | Where should we find the configuration files?
@@ -278,7 +279,8 @@
pure [x | x <- xs, drop1 (takeExtension x) `elem` exts, not $
avoidFile x]
else do
isFil <- doesFileExist $ p <\> file
- if isFil then pure [p <\> file]
+ if isFil then
+ pure [p <\> file | not $ ignore $ p <\> file]
else do
res <- getModule p exts file
case res of
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Config/Yaml.hs
new/hlint-3.8/src/Config/Yaml.hs
--- old/hlint-3.6.1/src/Config/Yaml.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Config/Yaml.hs 2001-09-09 03:46:40.000000000 +0200
@@ -29,6 +29,7 @@
import Config.Type
import Data.Either.Extra
import Data.Maybe
+import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Tuple.Extra
import Control.Monad.Extra
@@ -163,7 +164,7 @@
-- aim to show a smallish but relevant context
dotDot (fromMaybe (encode focus) $ listToMaybe $ dropWhile (\x ->
BS.length x > 250) $ map encode contexts)
where
- (steps, contexts) = unzip $ reverse path
+ (steps, contexts) = Prelude.unzip $ reverse path
dotDot x = let (a,b) = BS.splitAt 250 x in BS.unpack a ++ (if BS.null
b then "" else "...")
parseArray :: Val -> Parser [Val]
@@ -235,7 +236,7 @@
case parser defaultParseFlags{enabledExtensions=configExtensions,
disabledExtensions=[]} x of
POk _ x -> pure x
PFailed ps ->
- let errMsg = head . bagToList . getMessages $ GhcPsMessage <$> snd
(getPsMessages ps)
+ let errMsg = NE.head . NE.fromList . bagToList . getMessages $
GhcPsMessage <$> snd (getPsMessages ps)
msg = showSDoc baseDynFlags $ pprLocMsgEnvelopeDefault errMsg
in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n "
++ x
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/GHC/All.hs
new/hlint-3.8/src/GHC/All.hs
--- old/hlint-3.6.1/src/GHC/All.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/GHC/All.hs 2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
@@ -14,6 +15,7 @@
import Control.Monad.IO.Class
import Util
import Data.Char
+import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Timing
import Language.Preprocessor.Cpphs
@@ -22,7 +24,7 @@
import Extension
import GHC.Data.FastString
-import GHC.Hs
+import GHC.Hs hiding (comments)
import GHC.Types.SrcLoc
import GHC.Types.Fixity
import GHC.Types.Error
@@ -192,12 +194,12 @@
POk s a -> do
let errs = bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages
s)
if not $ null errs then
- ExceptT $ parseFailureErr dynFlags str file str errs
+ ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList errs
else do
let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags
pure $ ModuleEx (applyFixities fixes a)
PFailed s ->
- ExceptT $ parseFailureErr dynFlags str file str $ bagToList .
getMessages $ GhcPsMessage <$> snd (getPsMessages s)
+ ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList .
bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s)
where
-- If parsing pragmas fails, synthesize a parse error from the
-- error message.
@@ -206,7 +208,7 @@
in ParseError (mkSrcSpan loc loc) msg src
parseFailureErr dynFlags ppstr file str errs =
- let errMsg = head errs
+ let errMsg = NE.head errs
loc = errMsgSpan errMsg
doc = pprLocMsgEnvelopeDefault errMsg
in ghcFailOpParseModuleEx ppstr file str (loc, doc)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/GHC/Util/ApiAnnotation.hs
new/hlint-3.8/src/GHC/Util/ApiAnnotation.hs
--- old/hlint-3.6.1/src/GHC/Util/ApiAnnotation.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hlint-3.8/src/GHC/Util/ApiAnnotation.hs 2001-09-09 03:46:40.000000000
+0200
@@ -1,9 +1,15 @@
{-# LANGUAGE ImportQualifiedPost #-}
module GHC.Util.ApiAnnotation (
- comment_, commentText, isCommentMultiline
- , pragmas, flags, languagePragmas
- , mkFlags, mkLanguagePragmas
+ comment_
+ , commentText
+ , GHC.Util.ApiAnnotation.comments
+ , isCommentMultiline
+ , pragmas
+ , flags
+ , languagePragmas
+ , mkFlags
+ , mkLanguagePragmas
, extensions
) where
@@ -45,6 +51,12 @@
commentText :: LEpaComment -> String
commentText = trimCommentDelims . comment_
+-- | Total replacement for the partial `GHC.Parser.Annotation.comments` field
of
+-- `EpAnn`
+comments :: EpAnn ann -> EpAnnComments
+comments EpAnn{ GHC.Parser.Annotation.comments = result } = result
+comments EpAnnNotUsed = emptyComments
+
isCommentMultiline :: LEpaComment -> Bool
isCommentMultiline (L _ (EpaComment (EpaBlockComment _) _)) = True
isCommentMultiline _ = False
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/GHC/Util/FreeVars.hs
new/hlint-3.8/src/GHC/Util/FreeVars.hs
--- old/hlint-3.6.1/src/GHC/Util/FreeVars.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/src/GHC/Util/FreeVars.hs 2001-09-09 03:46:40.000000000
+0200
@@ -122,8 +122,8 @@
freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map
freeVars flds -- Record construction.
freeVars (L _ (RecordUpd _ e flds)) =
case flds of
- Left fs -> Set.unions $ freeVars e : map freeVars fs
- Right ps -> Set.unions $ freeVars e : map freeVars ps
+ RegularRecUpdFields _ fs -> Set.unions $ freeVars e : map freeVars fs
+ OverloadedRecUpdFields _ ps -> Set.unions $ freeVars e : map freeVars ps
freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if.
freeVars (L _ (HsTypedBracket _ e)) = freeVars e
freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e
@@ -174,7 +174,7 @@
freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x
instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns
(AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
- freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $
rdrNameAmbiguousFieldOcc $ unLoc x -- a pun
+ freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $
ambiguousFieldOccRdrName $ unLoc x -- a pun
freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x
instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns
(FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where
@@ -233,7 +233,7 @@
allVars (L _ (PatSynBind _ PSB{})) = mempty -- Come back to it.
instance AllVars (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where
- allVars (MG _ _alts@(L _ alts)) = inVars (foldMap (allVars . m_pats) ms)
(allVars (map m_grhss ms))
+ allVars (MG _ _alts@(L _ alts)) = foldMap (\m -> inVars (allVars (m_pats m))
(allVars (m_grhss m))) ms
where ms = map unLoc alts
instance AllVars (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/GHC/Util/HsExpr.hs
new/hlint-3.8/src/GHC/Util/HsExpr.hs
--- old/hlint-3.6.1/src/GHC/Util/HsExpr.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/src/GHC/Util/HsExpr.hs 2001-09-09 03:46:40.000000000
+0200
@@ -58,7 +58,7 @@
-- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@
lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
-lambda vs body = noLocA $ HsLam noExtField (MG Generated (noLocA [noLocA $
Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS
EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]))
+lambda vs body = noLocA $ HsLam noExtField (MG (Generated DoPmc) (noLocA
[noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS
EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))]))
-- | 'paren e' wraps 'e' in parens if 'e' is non-atomic.
paren :: LHsExpr GhcPs -> LHsExpr GhcPs
@@ -242,7 +242,7 @@
let grhs = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs)
grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs],
grhssLocalBinds=EmptyLocalBinds noExtField}
match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LambdaExpr,
m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)
- matchGroup = MG {mg_ext=Generated, mg_alts=noLocA [match]}
+ matchGroup = MG {mg_ext=Generated DoPmc, mg_alts=noLocA [match]}
in (noLocA $ HsLam noExtField matchGroup, const [])
@@ -252,7 +252,7 @@
replaceBranches (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf
EpAnnNotUsed a b c))
replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) =
- (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG Generated . L l . g bs)
+ (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG (Generated DoPmc). L l . g
bs)
where
f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]
f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/All.hs
new/hlint-3.8/src/Hint/All.hs
--- old/hlint-3.6.1/src/Hint/All.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/All.hs 2001-09-09 03:46:40.000000000 +0200
@@ -21,6 +21,7 @@
import Hint.Bracket
import Hint.Fixities
import Hint.Naming
+import Hint.Negation
import Hint.Pattern
import Hint.Import
import Hint.Export
@@ -37,7 +38,7 @@
-- | A list of the builtin hints wired into HLint.
-- This list is likely to grow over time.
data HintBuiltin =
- HintList | HintListRec | HintMonad | HintLambda | HintFixities |
+ HintList | HintListRec | HintMonad | HintLambda | HintFixities |
HintNegation |
HintBracket | HintNaming | HintPattern | HintImport | HintExport |
HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |
HintComment | HintNewType | HintSmell | HintNumLiteral
@@ -63,6 +64,7 @@
HintNaming -> decl namingHint
HintBracket -> decl bracketHint
HintFixities -> mempty{hintDecl=fixitiesHint}
+ HintNegation -> decl negationParensHint
HintSmell -> mempty{hintDecl=smellHint,hintModule=smellModuleHint}
HintPattern -> decl patternHint
HintMonad -> decl monadHint
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Export.hs
new/hlint-3.8/src/Hint/Export.hs
--- old/hlint-3.6.1/src/Hint/Export.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Export.hs 2001-09-09 03:46:40.000000000 +0200
@@ -23,7 +23,7 @@
exportHint :: ModuHint
exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports =
exports}) )
| Nothing <- exports =
- let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents
EpAnnNotUsed name)] )} in
+ let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents
(Nothing, EpAnnNotUsed) name)] )} in
[(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note
"an explicit list is usually better"]}]
| Just (L _ xs) <- exports
, mods <- [x | x <- xs, isMod x]
@@ -32,7 +32,7 @@
, exports' <- [x | x <- xs, not (matchesModName modName x)]
, modName `elem` names =
let dots = mkRdrUnqual (mkVarOcc " ... ")
- r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA
(IEName noExtField (noLocA dots)))) : exports') )}
+ r = o{ hsmodExports = Just (noLocA (noLocA (IEVar Nothing (noLocA
(IEName noExtField (noLocA dots)))) : exports') )}
in
[ignore "Use explicit module export list" (L s o) (noLoc r) []]
where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Extensions.hs
new/hlint-3.8/src/Hint/Extensions.hs
--- old/hlint-3.6.1/src/Hint/Extensions.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/src/Hint/Extensions.hs 2001-09-09 03:46:40.000000000
+0200
@@ -249,6 +249,8 @@
foo = [|| x ||]
{-# LANGUAGE TemplateHaskell #-} \
foo = $bar
+{-# LANGUAGE TemplateHaskell #-} \
+foo = $$typedExpressionSplice
{-# LANGUAGE TypeData # -} \
type data Nat = Zero | Succ Nat -- @NoRefactor: refactor requires GHC >= 9.6.1
{-# LANGUAGE TypeData #-} \
@@ -272,6 +274,7 @@
import Data.Set qualified as Set
import Data.Map qualified as Map
+import GHC.Data.FastString
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Hs
@@ -425,7 +428,7 @@
f _ = False
used KindSignatures = hasT (un :: HsKind GhcPs)
used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch
-used TemplateHaskell = hasS $ not . isQuasiQuoteSplice
+used TemplateHaskell = hasS (not . isQuasiQuoteSplice) ||^ hasS isTypedSplice
used TemplateHaskellQuotes = hasS f
where
f :: HsExpr GhcPs -> Bool
@@ -490,8 +493,8 @@
used NumericUnderscores = hasS f
where
f :: OverLitVal -> Bool
- f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` t
- f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` t
+ f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` unpackFS t
+ f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` unpackFS t
f _ = False
used LambdaCase = hasS isLCase
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Lambda.hs
new/hlint-3.8/src/Hint/Lambda.hs
--- old/hlint-3.6.1/src/Hint/Lambda.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Lambda.hs 2001-09-09 03:46:40.000000000 +0200
@@ -87,6 +87,7 @@
yes = blah (\ x -> case x of A -> a; B -> b) -- \ case A -> a; B -> b
yes = blah (\ x -> case x of A -> a; B -> b) -- @Note may require `{-#
LANGUAGE LambdaCase #-}` adding to the top of the file
no = blah (\ x -> case x of A -> a x; B -> b x)
+no = blah (\ x -> case x of A -> a x; x -> b x)
foo = bar (\x -> case x of Y z | z > 0 -> z) -- \case Y z | z > 0 -> z
yes = blah (\ x -> (y, x)) -- (y,)
yes = blah (\ x -> (y, x, z+q)) -- (y, , z+q)
@@ -170,7 +171,7 @@
where
reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD
noExtField $
- origBind {fun_matches = MG Generated (noLocA [noLocA $ Match
EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $
EmptyLocalBinds noExtField])}
+ origBind {fun_matches = MG (Generated DoPmc) (noLocA [noLocA $
Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed []
b] $ EmptyLocalBinds noExtField])}
mkSubtsAndTpl newPats newBody = (sub, tpl)
where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/List.hs
new/hlint-3.8/src/Hint/List.hs
--- old/hlint-3.6.1/src/Hint/List.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/List.hs 2001-09-09 03:46:40.000000000 +0200
@@ -44,6 +44,7 @@
import Control.Applicative
import Data.Generics.Uniplate.DataOnly
+import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Maybe
import Prelude
@@ -103,9 +104,9 @@
listCompCheckGuards :: LHsExpr GhcPs -> HsDoFlavour -> [ExprLStmt GhcPs] ->
[Idea]
listCompCheckGuards o ctx stmts =
- let revs = reverse stmts
- e@(L _ LastStmt{}) = head revs -- In a ListComp, this is always last.
- xs = reverse (tail revs) in
+ let revs = NE.reverse $ NE.fromList stmts
+ e@(L _ LastStmt{}) = NE.head revs -- In a ListComp, this is always last.
+ xs = reverse (NE.tail revs) in
list_comp_aux e xs
where
list_comp_aux e xs
@@ -128,10 +129,10 @@
listCompCheckMap o mp f ctx stmts | varToStr mp == "map" =
[suggest "Move map inside list comprehension" (reLoc o) (reLoc o2)
(suggestExpr o o2)]
where
- revs = reverse stmts
- L _ (LastStmt _ body b s) = head revs -- In a ListComp, this is always
last.
+ revs = NE.reverse $ NE.fromList stmts
+ L _ (LastStmt _ body b s) = NE.head revs -- In a ListComp, this is
always last.
last = noLocA $ LastStmt noExtField (noLocA $ HsApp EpAnnNotUsed (paren
f) (paren body)) b s
- o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (tail revs) ++
[last])
+ o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (NE.tail revs) ++
[last])
listCompCheckMap _ _ _ _ _ = []
suggestExpr :: LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring R.SrcSpan]
@@ -162,7 +163,7 @@
listExp overloadedListsOn b (fromParen -> x) =
if null res
then concatMap (listExp overloadedListsOn $ isAppend x) $ children x
- else [head res]
+ else [NE.head $ NE.fromList res]
where
res = [suggest name (reLoc x) (reLoc x2) [r]
| (name, f) <- checks overloadedListsOn
@@ -170,7 +171,7 @@
, let r = Replace Expr (toSSA x) subts temp ]
listPat :: LPat GhcPs -> [Idea]
-listPat x = if null res then concatMap listPat $ children x else [head res]
+listPat x = if null res then concatMap listPat $ children x else [NE.head $
NE.fromList res]
where res = [suggest name (reLoc x) (reLoc x2) [r]
| (name, f) <- pchecks
, Just (x2, subts, temp) <- [f x]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/ListRec.hs
new/hlint-3.8/src/Hint/ListRec.hs
--- old/hlint-3.6.1/src/Hint/ListRec.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/ListRec.hs 2001-09-09 03:46:40.000000000 +0200
@@ -176,7 +176,7 @@
gRHS e = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs)
-- Guarded rhs.
gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs
set.
match e = Match{m_ext=EpAnnNotUsed,m_pats=ps12, m_grhss=gRHSSs e, ..} --
Match.
- matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated,
..} -- Match group.
+ matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated
DoPmc, ..} -- Match group.
funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs
GhcPs -- Fun bind.
pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Monad.hs
new/hlint-3.8/src/Hint/Monad.hs
--- old/hlint-3.6.1/src/Hint/Monad.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Monad.hs 2001-09-09 03:46:40.000000000 +0200
@@ -298,7 +298,7 @@
grhs = noLocA (GRHS EpAnnNotUsed [] rhs)
grhss = GRHSs emptyComments [grhs] (EmptyLocalBinds noExtField)
match = noLocA $ Match EpAnnNotUsed (FunRhs p Prefix NoSrcStrict)
[] grhss
- fb = noLocA $ FunBind noExtField p (MG Generated (noLocA [match]))
+ fb = noLocA $ FunBind noExtField p (MG (Generated DoPmc) (noLocA
[match]))
binds = unitBag fb
valBinds = ValBinds NoAnnSortKey binds []
localBinds = HsValBinds EpAnnNotUsed valBinds
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Naming.hs
new/hlint-3.8/src/Hint/Naming.hs
--- old/hlint-3.6.1/src/Hint/Naming.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Naming.hs 2001-09-09 03:46:40.000000000 +0200
@@ -102,7 +102,7 @@
L locGRHS (GRHS ttg0 guards (L locExpr dots))
where
dots :: HsExpr GhcPs
- dots = HsLit EpAnnNotUsed (HsString (SourceText "...") (mkFastString
"..."))
+ dots = HsLit EpAnnNotUsed (HsString (SourceText (fsLit "...")) (fsLit
"..."))
getNames :: LHsDecl GhcPs -> [String]
getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Negation.hs
new/hlint-3.8/src/Hint/Negation.hs
--- old/hlint-3.6.1/src/Hint/Negation.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/hlint-3.8/src/Hint/Negation.hs 2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,62 @@
+{-
+
+Raise a warning if negation precedence may appear ambiguous to human readers.
+
+<TEST>
+yes = -1 ^ 2 -- @Suggestion -(1 ^ 2)
+yes = -x ^ y -- @Suggestion -(x ^ y)
+yes = -5 `plus` 3 -- @Suggestion -(5 `plus` 3)
+yes = -f x `mod` y -- @Suggestion -(f x `mod` y)
+yes = -x `mod` y -- @Suggestion -(x `mod` y)
+no = -(5 + 3)
+no = -5 + 3
+no = -(f x)
+no = -x
+</TEST>
+-}
+
+module Hint.Negation(negationParensHint) where
+
+import Hint.Type(DeclHint,Idea(..),rawIdea,toSSA)
+import Config.Type
+import Data.Generics.Uniplate.DataOnly
+import Refact.Types
+import GHC.Hs
+import GHC.Util
+import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
+import GHC.Types.SrcLoc
+
+-- | See [motivating issue
#1484](https://github.com/ndmitchell/hlint/issues/1484).
+--
+-- == Implementation note
+--
+-- The original intention was to compare fixities so as
+-- to only fire the rule when the operand of prefix negation
+-- has higher fixity than the negation itself (fixity 6).
+--
+-- However, since there do not exist any numerically-valued
+-- operators with lower fixity than 6
+-- (see [table](https://www.haskell.org/onlinereport/decls.html#sect4.4.2)),
+-- we do not have to worry about fixity comparisons.
+negationParensHint :: DeclHint
+negationParensHint _ _ x =
+ concatMap negatedOp (universeBi x :: [LHsExpr GhcPs])
+
+negatedOp :: LHsExpr GhcPs -> [Idea]
+negatedOp e =
+ case e of
+ L b1 (NegApp a1 inner@(L _ OpApp {}) a2) ->
+ pure $
+ rawIdea
+ Suggestion
+ "Parenthesize unary negation"
+ (locA (getLoc e))
+ (unsafePrettyPrint e)
+ (Just renderedNewExpr)
+ []
+ [Replace (findType e) (toSSA e) [] renderedNewExpr]
+ where
+ renderedNewExpr = unsafePrettyPrint newExpr
+ parenthesizedOperand = addParen inner
+ newExpr = L b1 $ NegApp a1 parenthesizedOperand a2
+ _ -> []
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/NumLiteral.hs
new/hlint-3.8/src/Hint/NumLiteral.hs
--- old/hlint-3.6.1/src/Hint/NumLiteral.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/src/Hint/NumLiteral.hs 2001-09-09 03:46:40.000000000
+0200
@@ -22,6 +22,7 @@
module Hint.NumLiteral (numLiteralHint) where
import GHC.Hs
+import GHC.Data.FastString
import GHC.LanguageExtensions.Type (Extension (..))
import GHC.Types.SrcLoc
import GHC.Types.SourceText
@@ -49,18 +50,20 @@
suggestUnderscore :: LHsExpr GhcPs -> [Idea]
suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL
(SourceText srcTxt) _ _))))) =
- [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt,
srcTxt /= underscoredSrcTxt ]
+ [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt',
srcTxt' /= underscoredSrcTxt ]
where
- underscoredSrcTxt = addUnderscore srcTxt
+ srcTxt' = unpackFS srcTxt
+ underscoredSrcTxt = addUnderscore srcTxt'
y :: LocatedAn an (HsExpr GhcPs)
- y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral
intLit{il_text = SourceText underscoredSrcTxt}}
+ y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral
intLit{il_text = SourceText (fsLit underscoredSrcTxt)}}
r = Replace Expr (toSSA x) [("a", toSSA y)] "a"
suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL
(SourceText srcTxt) _ _ _ _))))) =
- [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt,
srcTxt /= underscoredSrcTxt ]
+ [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt',
srcTxt' /= underscoredSrcTxt ]
where
- underscoredSrcTxt = addUnderscore srcTxt
+ srcTxt' = unpackFS srcTxt
+ underscoredSrcTxt = addUnderscore srcTxt'
y :: LocatedAn an (HsExpr GhcPs)
- y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional
fracLit{fl_text = SourceText underscoredSrcTxt}}
+ y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional
fracLit{fl_text = SourceText (fsLit underscoredSrcTxt)}}
r = Replace Expr (toSSA x) [("a", toSSA y)] "a"
suggestUnderscore _ = mempty
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Pragma.hs
new/hlint-3.8/src/Hint/Pragma.hs
--- old/hlint-3.6.1/src/Hint/Pragma.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Pragma.hs 2001-09-09 03:46:40.000000000 +0200
@@ -144,7 +144,7 @@
-- 'ls' is a list of language features enabled by this
-- OPTIONS_GHC pragma that are not enabled by LANGUAGE pragmas
-- in this module.
- let ls = filter (not . (`elem` languagePragmas)) (concat $ catMaybes vs)
in
+ let ls = concatMap (filter (`notElem` languagePragmas)) $ catMaybes vs in
Just (res, ls)
where
-- Try reinterpreting each flag as a list of language features
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Restrict.hs
new/hlint-3.8/src/Hint/Restrict.hs
--- old/hlint-3.6.1/src/Hint/Restrict.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/src/Hint/Restrict.hs 2001-09-09 03:46:40.000000000 +0200
@@ -31,6 +31,7 @@
import Data.Map qualified as Map
import Data.List.Extra
import Data.List.NonEmpty (nonEmpty)
+import Data.Either
import Data.Maybe
import Data.Monoid
import Data.Semigroup
@@ -157,6 +158,11 @@
, not $ null bad]
isGood def mp x = maybe def (within modu "" . riWithin) $ Map.lookup x mp
+
+-- | Extension to GHC's 'ImportDeclQualifiedStyle', expressing
@qualifiedStyle: unrestricted@,
+-- i.e. the preference of "either pre- or post-, but qualified" in a rule.
+data QualifiedPostOrPre = QualifiedPostOrPre deriving Eq
+
checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String
RestrictItem) -> [Idea]
checkImports modu lImportDecls (def, mp) = mapMaybe getImportHint lImportDecls
where
@@ -190,30 +196,37 @@
case fromMaybe ImportStyleUnrestricted $ getAlt riImportStyle of
ImportStyleUnrestricted
| NotQualified <- ideclQualified -> (Nothing, Nothing)
- | otherwise -> (second (<> " or unqualified") <$>
expectedQualStyle, Nothing)
- ImportStyleQualified -> (expectedQualStyleDef, Nothing)
+ | otherwise -> (Just $ second (<> " or unqualified")
expectedQualStyle, Nothing)
+ ImportStyleQualified -> (Just expectedQualStyle, Nothing)
ImportStyleExplicitOrQualified
| Just (False, _) <- first (== EverythingBut) <$>
ideclImportList -> (Nothing, Nothing)
| otherwise ->
- ( second (<> " or with an explicit import list") <$>
expectedQualStyleDef
+ ( Just $ second (<> " or with an explicit import list")
expectedQualStyle
, Nothing )
ImportStyleExplicit
| Just (False, _) <- first (== EverythingBut) <$>
ideclImportList -> (Nothing, Nothing)
| otherwise ->
- ( Just (NotQualified, "unqualified")
+ ( Just (Right NotQualified, "unqualified")
, Just $ Just (Exactly, noLocA []) )
- ImportStyleUnqualified -> (Just (NotQualified, "unqualified"),
Nothing)
- expectedQualStyleDef = expectedQualStyle <|> Just (QualifiedPre,
"qualified")
+ ImportStyleUnqualified -> (Just (Right NotQualified,
"unqualified"), Nothing)
expectedQualStyle =
case fromMaybe QualifiedStyleUnrestricted $ getAlt
riQualifiedStyle of
- QualifiedStyleUnrestricted -> Nothing
- QualifiedStylePost -> Just (QualifiedPost, "post-qualified")
- QualifiedStylePre -> Just (QualifiedPre, "pre-qualified")
+ QualifiedStyleUnrestricted -> (Left QualifiedPostOrPre,
"qualified")
+ QualifiedStylePost -> (Right QualifiedPost, "post-qualified")
+ QualifiedStylePre -> (Right QualifiedPre, "pre-qualified")
+ -- unless expectedQual is Nothing, it holds the Idea (hint) to
ultimately emit,
+ -- except in these cases when the rule's requirements are
fulfilled in-source:
qualIdea
- | Just ideclQualified == (fst <$> expectedQual) = Nothing
+ -- the rule demands a particular importStyle, and the decl obeys
exactly
+ | Just (Right ideclQualified) == (fst <$> expectedQual) = Nothing
+ -- the rule demands a QualifiedPostOrPre import, and the decl
does either
+ | Just (Left QualifiedPostOrPre) == (fst <$> expectedQual)
+ && ideclQualified `elem` [QualifiedPost, QualifiedPre] =
Nothing
+ -- otherwise, expectedQual gets converted into a warning below
(or is Nothing)
| otherwise = expectedQual
whenJust qualIdea $ \(qual, hint) -> do
- let i' = noLoc $ (unLoc i){ ideclQualified = qual
+ -- convert non-Nothing qualIdea into hlint's refactoring Idea
+ let i' = noLoc $ (unLoc i){ ideclQualified = fromRight QualifiedPre
qual
, ideclImportList = fromMaybe
ideclImportList expectedHiding }
msg = moduleNameString (unLoc ideclName) <> " should be imported
" <> hint
Left $ warn msg (reLoc i) i' []
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Hint/Unsafe.hs
new/hlint-3.8/src/Hint/Unsafe.hs
--- old/hlint-3.6.1/src/Hint/Unsafe.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Hint/Unsafe.hs 2001-09-09 03:46:40.000000000 +0200
@@ -60,13 +60,15 @@
-- 'x' is not marked 'NOINLINE'.
, x `notElem` noinline]
where
+ noInline :: FastString
+ noInline = fsLit "{-# NOINLINE"
gen :: OccName -> LHsDecl GhcPs
gen x = noLocA $
SigD noExtField (InlineSig EpAnnNotUsed (noLocA (mkRdrUnqual x))
- (InlinePragma (SourceText "{-# NOINLINE") (NoInline
(SourceText "{-# NOINLINE")) Nothing NeverActive FunLike))
+ (InlinePragma (SourceText noInline) (NoInline
(SourceText noInline)) Nothing NeverActive FunLike))
noinline :: [OccName]
noinline = [q | L _(SigD _ (InlineSig _ (L _ (Unqual q))
- (InlinePragma _ (NoInline
(SourceText "{-# NOINLINE")) Nothing NeverActive FunLike))
+ (InlinePragma _ (NoInline
(SourceText noInline)) Nothing NeverActive FunLike))
) <- hsmodDecls m]
isUnsafeDecl :: HsDecl GhcPs -> Bool
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Refact.hs new/hlint-3.8/src/Refact.hs
--- old/hlint-3.6.1/src/Refact.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Refact.hs 2001-09-09 03:46:40.000000000 +0200
@@ -10,6 +10,7 @@
import Control.Exception.Extra
import Control.Monad
+import Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Version.Extra
import GHC.LanguageExtensions.Type
@@ -58,7 +59,7 @@
mexc <- findExecutable excPath
case mexc of
Just exc -> do
- ver <- readVersion . tail <$> readProcess exc ["--version"] ""
+ ver <- readVersion . NE.tail . NE.fromList <$> readProcess exc
["--version"] ""
pure $ if ver >= minRefactorVersion
then Right exc
else Left $ "Your version of refactor is too old,
please install apply-refact "
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/src/Summary.hs
new/hlint-3.8/src/Summary.hs
--- old/hlint-3.6.1/src/Summary.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/hlint-3.8/src/Summary.hs 2001-09-09 03:46:40.000000000 +0200
@@ -9,6 +9,7 @@
import Data.Map qualified as Map
import Control.Monad.Extra
import System.FilePath
+import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import System.Directory
@@ -121,7 +122,7 @@
++ ["", "# All LHS/RHS hints"]
++ (mkLine <$> sortDedup (hintRuleName <$> sLhsRhsRules))
where
- sortDedup = fmap head . group . sort
+ sortDedup = fmap (NE.head . NE.fromList) . group . sort
mkLine name = "- " <> show severity <> ": {name: " <> jsonToString name <>
"}"
genSummaryMd :: Summary -> String
@@ -161,7 +162,7 @@
where
row1 = row $
[ "<td>" ++ hName ++ "</td>", "<td>"]
- ++ showExample (head hExamples)
+ ++ showExample (NE.head (NE.fromList hExamples))
++ ["Does not support refactoring." | not hRefactoring]
++ ["</td>"] ++
[ "<td>" ++ show hSeverity ++ "</td>"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hlint-3.6.1/tests/import_style.test
new/hlint-3.8/tests/import_style.test
--- old/hlint-3.6.1/tests/import_style.test 2001-09-09 03:46:40.000000000
+0200
+++ new/hlint-3.8/tests/import_style.test 2001-09-09 03:46:40.000000000
+0200
@@ -66,3 +66,64 @@
No hints
---------------------------------------------------------------------
+RUN tests/importStyle-postqual-pos.hs --hint=data/import_style.yaml
-XImportQualifiedPost
+FILE tests/importStyle-postqual-pos.hs
+import HypotheticalModule1 qualified as HM1
+import HypotheticalModule2 qualified
+import HypotheticalModule2 qualified as Arbitrary
+import HypotheticalModule3 qualified
+import HypotheticalModule3 qualified as Arbitrary
+import HypotheticalModule4 qualified as HM4
+import HypotheticalModule5 qualified
+import HypotheticalModule5 qualified as HM5
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/importStyle-postqual-neg.hs --hint=data/import_style.yaml
-XImportQualifiedPost
+FILE tests/importStyle-postqual-neg.hs
+import HypotheticalModule1 qualified
+import qualified HypotheticalModule4
+import qualified HypotheticalModule4 as Verbotten
+import qualified HypotheticalModule4 as HM4
+import HypotheticalModule5 as HM5
+import qualified HypotheticalModule5
+
+OUTPUT
+tests/importStyle-postqual-neg.hs:1:1-36: Warning: Avoid restricted alias
+Found:
+ import HypotheticalModule1 qualified
+Perhaps:
+ import HypotheticalModule1 qualified as HM1
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:2:1-36: Warning: Avoid restricted alias
+Found:
+ import qualified HypotheticalModule4
+Perhaps:
+ import qualified HypotheticalModule4 as HM4
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:3:1-49: Warning: Avoid restricted alias
+Found:
+ import qualified HypotheticalModule4 as Verbotten
+Perhaps:
+ import qualified HypotheticalModule4 as HM4
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:5:1-33: Warning: HypotheticalModule5 should
be imported post-qualified
+Found:
+ import HypotheticalModule5 as HM5
+Perhaps:
+ import HypotheticalModule5 qualified as HM5
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:6:1-36: Warning: HypotheticalModule5 should
be imported post-qualified
+Found:
+ import qualified HypotheticalModule5
+Perhaps:
+ import HypotheticalModule5 qualified
+Note: may break the code
+
+5 hints
+---------------------------------------------------------------------
