@@ -7,17 +7,18 @@ import Data.Array.NonEmpty as NEA
77import Data.Foldable (foldMap)
88import Data.Maybe (Maybe(..))
99import Data.Monoid (power)
10−import Data.Newtype (un)
1110import Data.String as String
12−import Data.Tuple (Tuple(..), snd)
11+import Data.Tuple (Tuple(..))
1312import Data.Tuple.Nested ((/\))
14−import Data.Void (Void)
13+import Data.Void (Void, absurd)
1514import Purelint.Print (printBinder, printExpr)
1615import Purelint.Rule (Rule, RuleContext, mkRule)
1716import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))
18−import PureScript.CST.Range (rangeOf)
17+import PureScript.CST.Print (printToken)
18+import PureScript.CST.Range (rangeOf, tokensOf)
19+import PureScript.CST.Range.TokenList as TokenList
1920import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)
20−import PureScript.CST.Types (Binder(..), Declaration(..), Guarded(..), GuardedExpr(..), Ident(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), ValueBindingFields, Where(..))
21+import PureScript.CST.Types (Binder(..), Comment(..), Declaration(..), Expr, Guarded(..), GuardedExpr(..), Ident(..), LetBinding(..), LineFeed(..), Module(..), ModuleBody(..), Name(..), SourceToken, ValueBindingFields, Where(..))
2122
2223-- | Rule: Functions with multiple clauses where the name repeats can use case _ of
2324-- |
@@ -33,12 +34,13 @@ useCaseOfRule :: Rule
3334useCaseOfRule = mkRule (RuleId "UseCaseOf") run
3435 where
3536 run :: RuleContext -> Module Void -> Array LintWarning
36− run _ctx mod@(Module m) =
37− let
37+ run _ctx mod@(Module m) =
38+ let
3839 ModuleBody body = m.body
3940 topLevelWarnings = groupByName body.decls # Array.concatMap (checkGroup 0)
4041 nestedWarnings = foldMapModule visitor mod
41− in topLevelWarnings <> nestedWarnings
42+ in
43+ topLevelWarnings <> nestedWarnings
4244 where
4345 visitor = defaultMonoidalVisitor { onDecl = checkDecl }
4446
@@ -62,7 +64,7 @@ useCaseOfRule = mkRule (RuleId "UseCaseOf") run
6264
6365 checkLetBindings :: NEA.NonEmptyArray (LetBinding Void) -> Array LintWarning
6466 checkLetBindings bindings =
65− let
67+ let
6668 vbs = NEA.toArray bindings # Array.mapMaybe case _ of
6769 LetBindingName vb -> Just vb
6870 _ -> Nothing
@@ -71,7 +73,8 @@ useCaseOfRule = mkRule (RuleId "UseCaseOf") run
7173 Just vb -> (rangeOf (LetBindingName vb)).start.column
7274 Nothing -> 0
7375 groups = groupByNameVB vbs
74− in groups # Array.concatMap (checkGroup baseCol)
76+ in
77+ groups # Array.concatMap (checkGroup baseCol)
7578
7679 -- Group consecutive DeclValue with same name (for top-level)
7780 groupByName :: Array (Declaration Void) -> Array (Array (ValueBindingFields Void))
@@ -84,11 +87,13 @@ useCaseOfRule = mkRule (RuleId "UseCaseOf") run
8487 Just c -> Array.snoc acc c.clauses
8588 Just { head: d, tail: rest } -> case d of
8689 DeclValue vb ->
87− let name = getName vb
88− in case current of
89− Nothing -> go acc (Just { name, clauses: [vb] }) rest
90− Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest
91− Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [vb] }) rest
90+ let
91+ name = getName vb
92+ in
93+ case current of
94+ Nothing -> go acc (Just { name, clauses: [ vb ] }) rest
95+ Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest
96+ Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [ vb ] }) rest
9297 _ -> case current of
9398 Nothing -> go acc Nothing rest
9499 Just c -> go (Array.snoc acc c.clauses) Nothing rest
@@ -103,11 +108,13 @@ useCaseOfRule = mkRule (RuleId "UseCaseOf") run
103108 Nothing -> acc
104109 Just c -> Array.snoc acc c.clauses
105110 Just { head: vb, tail: rest } ->
106− let name = getName vb
107− in case current of
108− Nothing -> go acc (Just { name, clauses: [vb] }) rest
109− Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest
110− Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [vb] }) rest
111+ let
112+ name = getName vb
113+ in
114+ case current of
115+ Nothing -> go acc (Just { name, clauses: [ vb ] }) rest
116+ Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest
117+ Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [ vb ] }) rest
111118
112119 getName :: ValueBindingFields Void -> String
113120 getName vb = case vb.name of
@@ -117,53 +124,114 @@ useCaseOfRule = mkRule (RuleId "UseCaseOf") run
117124 checkGroup baseCol clauses
118125 | Array.length clauses < 2 = []
119126 | not (Array.all hasBindersAndUnconditional clauses) = []
120− | otherwise = case Array.head clauses of
121− Nothing -> []
122− Just first ->
123− let
124− name = getName first
125− numArgs = Array.length first.binders
126− -- Check all clauses have same number of binders
127− sameBinders = Array.all (\vb -> Array.length vb.binders == numArgs) clauses
128− in
129− if not sameBinders || numArgs == 0 then []
130− else
131− let
132− -- Build the replacement
133− indent = power " " baseCol
134− wildcards = Array.replicate numArgs "_" # String.joinWith ", "
135− caseHeader = name <> " = case " <> wildcards <> " of"
136− caseArms = clauses # Array.mapMaybe formatClause
137− replacement = caseHeader <> "\n" <> (caseArms # map ((indent <> " ") <> _) # String.joinWith "\n")
138− -- Range spans from first clause to last
139− firstRange = rangeOf (LetBindingName first)
140− lastRange = case Array.last clauses of
141− Just lst -> rangeOf (LetBindingName lst)
142− Nothing -> firstRange
143− fullRange = { start: firstRange.start, end: lastRange.end }
144− in
145− [ LintWarning
146− { ruleId: RuleId "UseCaseOf"
147− , message: WarningMessage $ "Function '" <> name <> "' has " <> show (Array.length clauses) <> " clauses - consider using case _ of"
148− , range: fullRange
149− , severity: Refactor
150− , suggestion: Just $ Suggestion
151− { replacement: ReplacementText replacement
152− , description: SuggestionDescription "Convert to case _ of"
153− }
154− }
155− ]
127+ | otherwise = foldMap
128+ ( \first ->
129+ let
130+ name = getName first
131+ numArgs = Array.length first.binders
132+ -- Check all clauses have same number of binders
133+ sameBinders = Array.all (\vb -> Array.length vb.binders == numArgs) clauses
134+ in
135+ if not sameBinders || numArgs == 0 then []
136+ else
137+ let
138+ -- Build the replacement
139+ indent = power " " baseCol
140+ wildcards = Array.replicate numArgs "_" # String.joinWith ", "
141+ caseHeader = name <> " = case " <> wildcards <> " of"
142+ caseArms = clauses # Array.mapMaybe (formatClause (baseCol + 2))
143+ replacement = caseHeader <> "\n" <> (caseArms # map ((indent <> " ") <> _) # String.joinWith "\n")
144+ -- Range spans from first clause to last
145+ firstRange = rangeOf (LetBindingName first)
146+ lastRange = case Array.last clauses of
147+ Just lst -> rangeOf (LetBindingName lst)
148+ Nothing -> firstRange
149+ fullRange = { start: firstRange.start, end: lastRange.end }
150+ in
151+ [ LintWarning
152+ { ruleId: RuleId "UseCaseOf"
153+ , message: WarningMessage $ "Function '" <> name <> "' has " <> show (Array.length clauses) <> " clauses - consider using case _ of"
154+ , range: fullRange
155+ , severity: Refactor
156+ , suggestion: Just $ Suggestion
157+ { replacement: ReplacementText replacement
158+ , description: SuggestionDescription "Convert to case _ of"
159+ }
160+ }
161+ ]
162+ )
163+ (Array.head clauses)
156164
157165 hasBindersAndUnconditional :: ValueBindingFields Void -> Boolean
158166 hasBindersAndUnconditional vb = case vb.guarded of
159167 Unconditional _ (Where { bindings: Nothing }) -> Array.length vb.binders > 0
168+ Unconditional _ (Where { bindings: Just _ }) -> Array.length vb.binders > 0
160169 _ -> false
161170
162− formatClause :: ValueBindingFields Void -> Maybe String
163− formatClause vb = case vb.guarded of
171+ formatClause :: Int -> ValueBindingFields Void -> Maybe String
172+ formatClause baseCol vb = case vb.guarded of
164173 Unconditional _ (Where { expr, bindings: Nothing }) ->
174+ let
175+ binders = vb.binders # map printBinder # String.joinWith ", "
176+ exprRange = rangeOf expr
177+ isMultiline = exprRange.start.line /= exprRange.end.line
178+ in
179+ if isMultiline
180+ then
181+ let
182+ -- Target indentation for the expression body
183+ targetCol = baseCol + 2
184+ body = printExprTokens targetCol expr
185+ in
186+ Just $ binders <> " ->\n" <> power " " targetCol <> body
187+ else Just $ binders <> " -> " <> printExpr expr
188+ Unconditional _ (Where { expr, bindings: Just (_ /\ letBindings) }) ->
165189 let
166190 binders = vb.binders # map printBinder # String.joinWith ", "
167191 body = printExpr expr
168− in Just $ binders <> " -> " <> body
192+ indent = power " " baseCol
193+ -- Format the where bindings with proper indentation
194+ whereBindings = NEA.toArray letBindings # map (printBindingTokens (baseCol + 4))
195+ whereText = String.joinWith ("\n" <> indent <> " ") whereBindings
196+ in
197+ Just $ binders <> " ->\n" <> indent <> " " <> body <> "\n" <> indent <> " where\n" <> indent <> " " <> whereText
169198 _ -> Nothing
199+
200+ printExprTokens :: Int -> Expr Void -> String
201+ printExprTokens targetCol expr =
202+ let
203+ exprCol = (rangeOf expr).start.column
204+ shiftAmount = targetCol - exprCol
205+ in
206+ String.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf expr))
207+
208+ printBindingTokens :: Int -> LetBinding Void -> String
209+ printBindingTokens targetCol b =
210+ let
211+ bindingCol = (rangeOf b).start.column
212+ shiftAmount = targetCol - bindingCol
213+ in
214+ String.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf b))
215+
216+ printSourceToken :: Int -> SourceToken -> String
217+ printSourceToken shiftAmount tok =
218+ foldMap (printLeadingComment shiftAmount) tok.leadingComments
219+ <> printToken tok.value
220+ <> foldMap printTrailingComment tok.trailingComments
221+
222+ printLeadingComment :: Int -> Comment LineFeed -> String
223+ printLeadingComment shiftAmount = case _ of
224+ Comment str -> str
225+ Space n -> power " " (max 0 (n + shiftAmount))
226+ Line lf n -> foldMap printLineFeed (Array.replicate n lf)
227+
228+ printLineFeed :: LineFeed -> String
229+ printLineFeed = case _ of
230+ LF -> "\n"
231+ CRLF -> "\r\n"
232+
233+ printTrailingComment :: Comment Void -> String
234+ printTrailingComment = case _ of
235+ Comment str -> str
236+ Space n -> power " " n
237+ Line v _ -> absurd v