Skip to content

Commit 82c4457

Browse files
bgohlabgohla
committed
refactor name helper functions
1 parent 1a107f5 commit 82c4457

File tree

4 files changed

+61
-87
lines changed

4 files changed

+61
-87
lines changed

‎hlint.cabal‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -158,17 +158,18 @@ library
158158
Hint.ListRec
159159
Hint.Match
160160
Hint.Monad
161+
Hint.NameHelpers
161162
Hint.Naming
162163
Hint.Negation
163164
Hint.NewType
165+
Hint.NoCapitalisms
166+
Hint.NumLiteral
164167
Hint.Pattern
165168
Hint.Pragma
166169
Hint.Restrict
167170
Hint.Smell
168171
Hint.Type
169172
Hint.Unsafe
170-
Hint.NumLiteral
171-
Hint.NoCapitalisms
172173
Test.All
173174
Test.Annotations
174175
Test.InputOutput

‎src/Hint/NameHelpers.hs‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
module Hint.NameHelpers where
2+
3+
import Data.List.Extra as E
4+
import Data.List.NonEmpty as NE
5+
import Data.Maybe
6+
7+
import GHC.Types.Basic
8+
import GHC.Types.SourceText
9+
import GHC.Data.FastString
10+
import GHC.Hs.Decls
11+
import GHC.Hs.Extension
12+
import GHC.Hs
13+
import GHC.Types.SrcLoc
14+
15+
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
16+
import GHC.Util
17+
18+
-- | Replace RHSs of top-level value declarations with an ellipsis
19+
-- TODO remove where clauses, these are apparently not caught here
20+
shorten :: LHsDecl GhcPs -> LHsDecl GhcPs
21+
shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG FromSource (L locMatches matches))))) =
22+
L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ E.map shortenMatch matches}})
23+
shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ _ grhss@(GRHSs _ rhss _)))) =
24+
L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = E.map shortenLGRHS rhss}})
25+
shorten x = x
26+
27+
shortenMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
28+
shortenMatch (L locMatch match@(Match _ _ _ grhss@(GRHSs _ rhss _))) =
29+
L locMatch match {m_grhss = grhss {grhssGRHSs = E.map shortenLGRHS rhss}}
30+
31+
shortenLGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
32+
shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) =
33+
L locGRHS (GRHS ttg0 guards (L locExpr dots))
34+
where
35+
dots :: HsExpr GhcPs
36+
dots = HsLit noExtField (HsString (SourceText (fsLit "...")) (fsLit "..."))
37+
38+
-- | Get the names from all top-level declarations including constructor names
39+
getNames :: LHsDecl GhcPs -> [String]
40+
getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)
41+
42+
getConstructorNames :: HsDecl GhcPs -> [String]
43+
getConstructorNames tycld = case tycld of
44+
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (NewTypeCon con) _))) -> conNames [con]
45+
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (DataTypeCons _ cons) _))) -> conNames cons
46+
_ -> []
47+
where
48+
conNames :: [LConDecl GhcPs] -> [String]
49+
conNames = concatMap (E.map unsafePrettyPrint . conNamesInDecl . unLoc)
50+
51+
conNamesInDecl :: ConDecl GhcPs -> [LIdP GhcPs]
52+
conNamesInDecl ConDeclH98 {con_name = name} = [name]
53+
conNamesInDecl ConDeclGADT {con_names = names} = NE.toList names

‎src/Hint/Naming.hs‎

Lines changed: 1 addition & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -42,18 +42,15 @@ foreign import ccall hexml_node_child :: IO ()
4242

4343
module Hint.Naming(namingHint) where
4444

45+
import Hint.NameHelpers
4546
import Hint.Type (Idea,DeclHint,suggest,ghcModule)
4647
import Data.Generics.Uniplate.DataOnly
4748
import Data.List.Extra (nubOrd, isPrefixOf)
48-
import Data.List.NonEmpty (toList)
4949
import Data.Data
5050
import Data.Char
5151
import Data.Maybe
5252
import Data.Set qualified as Set
5353

54-
import GHC.Types.Basic
55-
import GHC.Types.SourceText
56-
import GHC.Data.FastString
5754
import GHC.Hs.Decls
5855
import GHC.Hs.Extension
5956
import GHC.Hs
@@ -62,7 +59,6 @@ import GHC.Types.SrcLoc
6259

6360
import Language.Haskell.GhclibParserEx.GHC.Hs.Decls
6461
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
65-
import GHC.Util
6662

6763
namingHint :: DeclHint
6864
namingHint _ modu = naming $ Set.fromList $ concatMap getNames $ hsmodDecls $ unLoc (ghcModule modu)
@@ -86,40 +82,6 @@ naming seen originalDecl =
8682
]
8783
replacedDecl = replaceNames suggestedNames originalDecl
8884

89-
shorten :: LHsDecl GhcPs -> LHsDecl GhcPs
90-
shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG FromSource (L locMatches matches))))) =
91-
L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ map shortenMatch matches}})
92-
shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ _ grhss@(GRHSs _ rhss _)))) =
93-
L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = map shortenLGRHS rhss}})
94-
shorten x = x
95-
96-
shortenMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
97-
shortenMatch (L locMatch match@(Match _ _ _ grhss@(GRHSs _ rhss _))) =
98-
L locMatch match {m_grhss = grhss {grhssGRHSs = map shortenLGRHS rhss}}
99-
100-
shortenLGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
101-
shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) =
102-
L locGRHS (GRHS ttg0 guards (L locExpr dots))
103-
where
104-
dots :: HsExpr GhcPs
105-
dots = HsLit noExtField (HsString (SourceText (fsLit "...")) (fsLit "..."))
106-
107-
getNames :: LHsDecl GhcPs -> [String]
108-
getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)
109-
110-
getConstructorNames :: HsDecl GhcPs -> [String]
111-
getConstructorNames tycld = case tycld of
112-
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (NewTypeCon con) _))) -> conNames [con]
113-
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (DataTypeCons _ cons) _))) -> conNames cons
114-
_ -> []
115-
where
116-
conNames :: [LConDecl GhcPs] -> [String]
117-
conNames = concatMap (map unsafePrettyPrint . conNamesInDecl . unLoc)
118-
119-
conNamesInDecl :: ConDecl GhcPs -> [LIdP GhcPs]
120-
conNamesInDecl ConDeclH98 {con_name = name} = [name]
121-
conNamesInDecl ConDeclGADT {con_names = names} = Data.List.NonEmpty.toList names
122-
12385
isSym :: String -> Bool
12486
isSym (x:_) = not $ isAlpha x || x `elem` "_'"
12587
isSym _ = False

‎src/Hint/NoCapitalisms.hs‎

Lines changed: 4 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,11 @@
99
Identifiers containing underscores are exempted from thus rule.
1010
Identifiers of FFI bindings are exempted from thus rule.
1111
12-
Locally bound identifiers and module names are not checked.
12+
Locally bound identifiers, field names and module names are not
13+
checked.
1314
1415
<TEST>
16+
data Foo = MkFoo { getID :: String }
1517
data IO -- @Ignore
1618
data PersonID = P -- @Ignore
1719
sendIO :: IO () -- @Ignore
@@ -49,22 +51,13 @@ getFOO = _ -- @Ignore
4951
module Hint.NoCapitalisms(noCapitalismsHint) where
5052

5153
import Hint.Type
54+
import Hint.NameHelpers
5255
import Data.List.Extra as E
53-
import Data.List.NonEmpty as NE
5456
import Data.Char
55-
import Data.Maybe
5657

57-
import GHC.Types.Basic
58-
import GHC.Types.SourceText
59-
import GHC.Data.FastString
60-
import GHC.Hs.Decls
61-
import GHC.Hs.Extension
6258
import GHC.Hs
63-
import GHC.Types.SrcLoc
6459

6560
import Language.Haskell.GhclibParserEx.GHC.Hs.Decls
66-
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
67-
import GHC.Util
6861

6962
noCapitalismsHint :: DeclHint
7063
noCapitalismsHint _ _ decl = [ remark Ignore "Avoid capitalisms" (reLoc (shorten decl))
@@ -87,39 +80,4 @@ bigrams = \case
8780
a:b:as -> [a,b] : bigrams (b:as)
8881
_otherwise -> []
8982

90-
--- these are copied from Hint.Naming ---
91-
92-
shorten :: LHsDecl GhcPs -> LHsDecl GhcPs
93-
shorten (L locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG FromSource (L locMatches matches))))) =
94-
L locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = L locMatches $ E.map shortenMatch matches}})
95-
shorten (L locDecl (ValD ttg0 bind@(PatBind _ _ _ grhss@(GRHSs _ rhss _)))) =
96-
L locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = E.map shortenLGRHS rhss}})
97-
shorten x = x
98-
99-
shortenMatch :: LMatch GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)
100-
shortenMatch (L locMatch match@(Match _ _ _ grhss@(GRHSs _ rhss _))) =
101-
L locMatch match {m_grhss = grhss {grhssGRHSs = E.map shortenLGRHS rhss}}
102-
103-
shortenLGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
104-
shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) =
105-
L locGRHS (GRHS ttg0 guards (L locExpr dots))
106-
where
107-
dots :: HsExpr GhcPs
108-
dots = HsLit noExtField (HsString (SourceText (fsLit "...")) (fsLit "..."))
109-
110-
getNames :: LHsDecl GhcPs -> [String]
111-
getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)
112-
113-
getConstructorNames :: HsDecl GhcPs -> [String]
114-
getConstructorNames tycld = case tycld of
115-
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (NewTypeCon con) _))) -> conNames [con]
116-
(TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ (DataTypeCons _ cons) _))) -> conNames cons
117-
_ -> []
118-
where
119-
conNames :: [LConDecl GhcPs] -> [String]
120-
conNames = concatMap (E.map unsafePrettyPrint . conNamesInDecl . unLoc)
121-
122-
conNamesInDecl :: ConDecl GhcPs -> [LIdP GhcPs]
123-
conNamesInDecl ConDeclH98 {con_name = name} = [name]
124-
conNamesInDecl ConDeclGADT {con_names = names} = NE.toList names
12583

0 commit comments

Comments
 (0)