Add a hint to avoid capitalisms #1608
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,52 @@ | ||
| module Hint.NameHelpers where | ||
|
|
||
| import Data.List.Extra as E | ||
| import Data.List.NonEmpty as NE | ||
| import Data.Maybe | ||
|
|
||
| import GHC.Types.Basic | ||
| import GHC.Types.SourceText | ||
| import GHC.Data.FastString | ||
| import GHC.Hs.Decls | ||
| import GHC.Hs.Extension | ||
| import GHC.Hs | ||
| import GHC.Types.SrcLoc | ||
|
|
||
| import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable | ||
| import GHC.Util | ||
|
|
||
| -- | Replace RHSs of top-level value declarations with an ellipsis | ||
| shorten :: LHsDecl GhcPs -> LHsDecl GhcPs | ||
| shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG FromSource (L locMatches matches))))) = | ||
| L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ E.map shortenMatch matches}}) | ||
| shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ _ grhss@(GRHSs _ rhss _)))) = | ||
| L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = E.map shortenLGRHS rhss}}) | ||
| shorten x = x | ||
|
|
||
| shortenMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) | ||
| shortenMatch (L locMatch match@(Match _ _ _ grhss@(GRHSs _ rhss _))) = | ||
| L locMatch match {m_grhss = grhss {grhssGRHSs = E.map shortenLGRHS rhss}} | ||
|
|
||
| shortenLGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs) | ||
| shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) = | ||
| L locGRHS (GRHS ttg0 guards (L locExpr dots)) | ||
| where | ||
| dots :: HsExpr GhcPs | ||
| dots = HsLit noExtField (HsString (SourceText (fsLit "...")) (fsLit "...")) | ||
|
|
||
| -- | Get the names from all top-level declarations including constructor names | ||
| getNames :: LHsDecl GhcPs -> [String] | ||
| getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl) | ||
|
|
||
| getConstructorNames :: HsDecl GhcPs -> [String] | ||
| getConstructorNames tycld = case tycld of | ||
| (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (NewTypeCon con) _))) -> conNames [con] | ||
| (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (DataTypeCons _ cons) _))) -> conNames cons | ||
| _ -> [] | ||
| where | ||
| conNames :: [LConDecl GhcPs] -> [String] | ||
| conNames = concatMap (E.map unsafePrettyPrint . conNamesInDecl . unLoc) | ||
|
|
||
| conNamesInDecl :: ConDecl GhcPs -> [LIdP GhcPs] | ||
| conNamesInDecl ConDeclH98 {con_name = name} = [name] | ||
| conNamesInDecl ConDeclGADT {con_names = names} = NE.toList names |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,83 @@ | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {- | ||
| Detect uses of capitalisms | ||
|
|
||
| Do not allow two consecutive capital letters in top level | ||
| identifiers of types, classes, values and constructors. | ||
|
|
||
| Identifiers containing underscores are exempted from thus rule. | ||
| Identifiers of FFI bindings are exempted from thus rule. | ||
|
|
||
| Locally bound identifiers, field names and module names are not | ||
| checked. | ||
|
|
||
| <TEST> | ||
| data Foo = MkFoo { getID :: String } | ||
| data IO -- @Ignore | ||
| data PersonID = P -- @Ignore | ||
| sendIO :: IO () -- @Ignore | ||
| sendIO = _ -- @Ignore | ||
| class HasIO where -- @Ignore | ||
| data Foo = FO -- @Ignore | ||
| data LHsDecl -- @Ignore | ||
| class FOO a where -- @Ignore | ||
| class Foo a where getFOO :: Bool | ||
| data Foo = Bar | BAAZ -- @Ignore | ||
| data Foo = B_ar | BAAZ -- @Ignore | ||
| data Foo = Bar | B_AAZ | ||
| data OTPToken = OTPToken -- @Ignore | ||
| data OTP_Token = Foo | ||
| sendSMS = _ -- @Ignore | ||
| runTLS = _ -- @Ignore | ||
| runTLSSocket = _ -- @Ignore | ||
| runTLS_Socket | ||
| newtype TLSSettings = TLSSettings -- @Ignore | ||
| tlsSettings | ||
| data CertSettings = CertSettings | ||
| tlsServerHooks | ||
| tlsServerDHEParams = _ -- @Ignore | ||
| type WarpTLSException = () -- @Ignore | ||
| get_SMS | ||
| runCI | ||
| foreign import ccall _FIREMISSLES :: IO () | ||
| getSMS :: IO () -- @Ignore | ||
| gFOO = _ -- @Ignore | ||
| geFOO = _ -- @Ignore | ||
| getFOO = _ -- @Ignore | ||
| </TEST> | ||
| -} | ||
|
|
||
| module Hint.NoCapitalisms(noCapitalismsHint) where | ||
|
|
||
| import Hint.Type | ||
| import Hint.NameHelpers | ||
| import Data.List.Extra as E | ||
| import Data.Char | ||
|
|
||
| import GHC.Hs | ||
|
|
||
| import Language.Haskell.GhclibParserEx.GHC.Hs.Decls | ||
|
|
||
| noCapitalismsHint :: DeclHint | ||
| noCapitalismsHint _ _ decl = [ remark Ignore "Avoid capitalisms" (reLoc (shorten decl)) | ||
|
There was a problem hiding this comment. Add a Note to the hint, explaining what it does? There was a problem hiding this comment. Isn't the description at beginning of the file sufficient? I followed the style of There was a problem hiding this comment. That's just a code comment. A Note is attached to a hint and is displayed with the hint. Alternatively, you can make the hint name more descriptive: "Avoid three consecutive capital letters" instead of "Avoid capitalisms". |
||
| | not $ isForD decl | ||
| , name <- nubOrd $ getNames decl | ||
| , not $ hasUnderscore name | ||
| , hasCapitalism name | ||
| ] | ||
|
|
||
| hasUnderscore :: String -> Bool | ||
| hasUnderscore = elem '_' | ||
|
|
||
| hasCapitalism :: String -> Bool | ||
| hasCapitalism s = any isAllUpper (bigrams s) | ||
| where | ||
| isAllUpper = all isUpper | ||
|
|
||
| bigrams :: String -> [String] | ||
| bigrams = \case | ||
| a:b:as -> [a,b] : bigrams (b:as) | ||
| _otherwise -> [] | ||
|
|
||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
"capitalism"? How about "NoCAPs"?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Capitalism, as in, an expression written in all caps.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I do not see such a meaning for capitalism in the dictionary.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Yeah, "NoCAPs" seems better since it doesn't have political connotations and shouldn't provoke unnecessary discussions, unlike the current name.