fey.naomi/fennel-ls
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yet another lint refactor

Browse Source
This commit is contained in:
XeroOl 2025-07-11 16:25:54 -05:00
parent 7b215e15e8
commit b4d2683c33
2 changed files with 293 additions and 264 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/fennel-ls/config.fnl
View File

@ -11,6 +11,7 @@ There are no global settings. They're all stored in the `server` object.
(local files (require :fennel-ls.files)) (local files (require :fennel-ls.files))
(local docs (require :fennel-ls.docs)) (local docs (require :fennel-ls.docs))
(local utils (require :fennel-ls.utils)) (local utils (require :fennel-ls.utils))
(local lint (require :fennel-ls.lint))
(local option-mt {}) (local option-mt {})
(fn option [default-value] (doto [default-value] (setmetatable option-mt))) (fn option [default-value] (doto [default-value] (setmetatable option-mt)))
@ -24,19 +25,8 @@ There are no global settings. They're all stored in the `server` object.
"src/?.fnl" "src/?/init-macros.fnl" "src/?.fnl" "src/?/init-macros.fnl"
"src/?/init.fnl"] ";")) "src/?/init.fnl"] ";"))
:lua-version (option "lua54") :lua-version (option "lua54")
:lints {:unused-definition (option true) :lints (collect [_ lint (ipairs lint.list)]
:unknown-module-field (option true) lint.name (option lint.enabled))
:unnecessary-method (option true)
:unnecessary-tset (option true)
:unnecessary-do (option true)
:redundant-do (option true)
:match-should-case (option true)
:bad-unpack (option true)
:var-never-set (option true)
:op-with-no-arguments (option true)
:multival-in-middle-of-call (option true)
:no-decreasing-comparison (option false)
:empty-let (option true)}
:libraries (option {}) :libraries (option {})
:extra-globals (option "")}) :extra-globals (option "")})

541
src/fennel-ls/lint.fnl
View File

@ -18,27 +18,48 @@ the `file.diagnostics` field, filling it with diagnostics."
(set self.fix nil) (set self.fix nil)
(setmetatable {: self : fix} diagnostic-mt))) (setmetatable {: self : fix} diagnostic-mt)))
(local lints {:definition []
:reference []
:macro-call []
:function-call []
:special-call []
:file []})
(local all-lints [])
(fn add-lint [code lint]
(set lint.name code)
(table.insert all-lints lint)
(if (= (type lint.type) :table)
(each [_ t (ipairs lint.type)]
(table.insert (. lints t) lint))
(table.insert (. lints lint.type) lint)))
(fn could-be-rewritten-as-sym? [str] (fn could-be-rewritten-as-sym? [str]
(and (= :string (type str)) (not (str:find "^%d")) (and (= :string (type str)) (not (str:find "^%d"))
(not (str:find "[^!$%*+/0-9<=>?A-Z\\^_a-z|\128-\255-]")))) (not (str:find "[^!$%*+/0-9<=>?A-Z\\^_a-z|\128-\255-]"))))
(λ unused-definition [server file symbol definition]
"local variable that is defined but not used" (add-lint :unused-definition
(if (not (or (= "_" (: (tostring symbol) :sub 1 1)) {:type :definition
(= "_" (: (tostring symbol) :sub -1 -1)) :enabled true
(accumulate [reference false :impl (λ [server file symbol definition]
_ ref (ipairs definition.referenced-by) "local variable that is defined but not used"
&until reference] (if (not (or (= "_" (: (tostring symbol) :sub 1 1))
(or (= ref.ref-type :read) (= "_" (: (tostring symbol) :sub -1 -1))
(= ref.ref-type :mutate))))) (accumulate [reference false
(diagnostic _ ref (ipairs definition.referenced-by)
{:range (message.ast->range server file symbol) &until reference]
:message (.. "unused definition: " (tostring symbol)) (or (= ref.ref-type :read)
:severity message.severity.WARN (= ref.ref-type :mutate)))))
:code :unused-definition (diagnostic
:fix #{:title (.. "Replace " (tostring symbol) " with _" (tostring symbol)) {:range (message.ast->range server file symbol)
:changes [{:range (message.ast->range server file symbol) :message (.. "unused definition: " (tostring symbol))
:newText (.. "_" (tostring symbol))}]}}))) :severity message.severity.WARN
:code :unused-definition
:fix #{:title (.. "Replace " (tostring symbol) " with _" (tostring symbol))
:changes [{:range (message.ast->range server file symbol)
:newText (.. "_" (tostring symbol))}]}})))})
;; this is way too specific; it's also safe to do this inside an `if` or `case` ;; this is way too specific; it's also safe to do this inside an `if` or `case`
(fn in-or? [calls symbol] (fn in-or? [calls symbol]
@ -62,161 +83,189 @@ the `file.diagnostics` field, filling it with diagnostics."
:severity message.severity.WARN :severity message.severity.WARN
:code :unknown-module-field})))) :code :unknown-module-field}))))
(λ unknown-module-field [server file] (add-lint :unknown-module-field
"any multisym whose definition can't be found through a (require) call" {:type :file
(icollect [symbol (pairs file.references) &into file.diagnostics] :enabled true
(if (. (utils.multi-sym-split symbol) 2) :impl (λ [server file]
(module-field-helper server file symbol symbol))) "any multisym whose definition can't be found through a (require) call"
(icollect [symbol (pairs file.references) &into file.diagnostics]
(if (. (utils.multi-sym-split symbol) 2)
(module-field-helper server file symbol symbol)))
(icollect [symbol binding (pairs file.definitions) &into file.diagnostics] (icollect [symbol binding (pairs file.definitions) &into file.diagnostics]
(if binding.keys (if binding.keys
(module-field-helper server file symbol binding.definition (module-field-helper server file symbol binding.definition
(fcollect [i (length binding.keys) 1 -1] (fcollect [i (length binding.keys) 1 -1]
(. binding.keys i)))))) (. binding.keys i))))))})
(λ unnecessary-method [server file colon call] (add-lint :unnecessary-method
"a call to the : builtin that could just be a multisym" {:type :special-call
(if (and (sym? colon ":") :enabled true
(sym? (. call 2)) :impl (λ [server file colon call]
(. file.lexical call)) "a call to the : builtin that could just be a multisym"
(let [method (. call 3)] (if (and (sym? colon ":")
(if (could-be-rewritten-as-sym? method) (sym? (. call 2))
{:range (message.ast->range server file call) (. file.lexical call))
:message (.. "unnecessary : call: use (" (tostring (. call 2)) (let [method (. call 3)]
":" method ")") (if (could-be-rewritten-as-sym? method)
:severity message.severity.WARN {:range (message.ast->range server file call)
:code :unnecessary-method})))) :message (.. "unnecessary : call: use (" (tostring (. call 2))
":" method ")")
:severity message.severity.WARN
:code :unnecessary-method}))))})
(λ unnecessary-tset [server file head call] (add-lint :unnecessary-tset
(λ all-syms? [call start end] {:type :special-call
(faccumulate [syms true :enabled true
i start end] :impl (λ [server file head call]
(and syms (λ all-syms? [call start end]
(could-be-rewritten-as-sym? (. call i))))) (faccumulate [syms true
i start end]
(and syms
(could-be-rewritten-as-sym? (. call i)))))
(λ make-new-text [call] (λ make-new-text [call]
(.. (faccumulate [text "(set " (.. (faccumulate [text "(set "
i 2 (- (length call) 2)] i 2 (- (length call) 2)]
(.. text (tostring (. call i)) ".")) (.. text (tostring (. call i)) "."))
(tostring (. call (- (length call) 1))) (tostring (. call (- (length call) 1)))
" " " "
(view (. call (length call))) (view (. call (length call)))
")")) ")"))
(if (and (sym? head :tset) (if (and (sym? head :tset)
(sym? (. call 2)) (sym? (. call 2))
(all-syms? call 3 (- (length call) 1)) (all-syms? call 3 (- (length call) 1))
(. file.lexical call)) (. file.lexical call))
(diagnostic {:range (message.ast->range server file call) (diagnostic {:range (message.ast->range server file call)
:message (.. "unnecessary " (tostring head)) :message (.. "unnecessary " (tostring head))
:severity message.severity.WARN :severity message.severity.WARN
:code :unnecessary-tset :code :unnecessary-tset
:fix #{:title "Replace tset with set" :fix #{:title "Replace tset with set"
:changes [{:range (message.ast->range server file call) :changes [{:range (message.ast->range server file call)
:newText (make-new-text call)}]}}))) :newText (make-new-text call)}]}})))})
(λ unnecessary-do-values [server file head call] (add-lint :unnecessary-do-values
(if (and (or (sym? head :do) (sym? head :values)) {:type :special-call
(= nil (. call 3)) (. file.lexical call)) :enabled true
(diagnostic {:range (message.ast->range server file call) :impl (λ [server file head call]
:message (.. "unnecessary " (tostring head)) (if (and (or (sym? head :do) (sym? head :values))
:severity message.severity.WARN (= nil (. call 3)) (. file.lexical call))
:code :unnecessary-do-values (diagnostic {:range (message.ast->range server file call)
:fix #{:title "Unwrap the expression" :message (.. "unnecessary " (tostring head))
:changes [{:range (message.ast->range server file call) :severity message.severity.WARN
:newText (view (. call 2))}]}}))) :code :unnecessary-do-values
:fix #{:title "Unwrap the expression"
:changes [{:range (message.ast->range server file call)
:newText (view (. call 2))}]}})))})
(local implicit-do-forms (collect [form {: body-form?} (pairs (fennel.syntax))] (local implicit-do-forms (collect [form {: body-form?} (pairs (fennel.syntax))]
(values form body-form?))) (values form body-form?)))
(λ redundant-do [server file head call] (add-lint :redundant-do
(let [last-body (. call (length call))] {:type :special-call
(if (and (. implicit-do-forms (tostring head)) :enabled true
(. file.lexical call) :impl (λ [server file head call]
(list? last-body) (let [last-body (. call (length call))]
(sym? (. last-body 1) :do) (if (and (. implicit-do-forms (tostring head))
(not (unnecessary-do-values server file head call))) ;; we don't want two lints to trigger for same call (. file.lexical call)
(diagnostic {:range (message.ast->range server file last-body) (list? last-body)
:message "redundant do" (sym? (. last-body 1) :do)
:severity message.severity.WARN (not (and (sym? head :do) (= 3 (length call))))) ;; we don't want two lints to trigger for same call
:code :redundant-do (diagnostic {:range (message.ast->range server file last-body)
:fix #{:title "Unwrap the expression" :message "redundant do"
:changes [{:range (message.ast->range server file last-body) :severity message.severity.WARN
:newText (table.concat :code :redundant-do
(fcollect [i 2 (length last-body)] :fix #{:title "Unwrap the expression"
(view (. last-body i))) :changes [{:range (message.ast->range server file last-body)
" ")}]}})))) :newText (table.concat
(fcollect [i 2 (length last-body)]
(view (. last-body i)))
" ")}]}}))))})
(λ bad-unpack [server file op call] (add-lint :bad-unpack
"an unpack call leading into an operator" {:type :special-call
(let [last-item (. call (length call))] :enabled true
(if (and (op? op) :impl (λ [server file op call]
;; last item is an unpack call "an unpack call leading into an operator"
(list? last-item) (let [last-item (. call (length call))]
(or (sym? (. last-item 1) :unpack) (if (and (op? op)
(sym? (. last-item 1) :_G.unpack) ;; last item is an unpack call
(sym? (. last-item 1) :table.unpack)) (list? last-item)
(. file.lexical last-item) (or (sym? (. last-item 1) :unpack)
(. file.lexical call)) (sym? (. last-item 1) :_G.unpack)
(diagnostic (sym? (. last-item 1) :table.unpack))
{:range (message.ast->range server file last-item) (. file.lexical last-item)
:message (.. "faulty unpack call: " (tostring op) (. file.lexical call))
" isn't variadic at runtime." (diagnostic
(if (sym? op "..") {:range (message.ast->range server file last-item)
(let [unpackme (view (. last-item 2))] :message (.. "faulty unpack call: " (tostring op)
(.. " Use (table.concat " unpackme " isn't variadic at runtime."
") instead of (.. (unpack " unpackme "))")) (if (sym? op "..")
(.. " Use a loop when you have a dynamic number of " (let [unpackme (view (. last-item 2))]
"arguments to (" (tostring op) ")"))) (.. " Use (table.concat " unpackme
:severity message.severity.WARN ") instead of (.. (unpack " unpackme "))"))
:code :bad-unpack (.. " Use a loop when you have a dynamic number of "
:fix (if (and (= (length last-item) 2) "arguments to (" (tostring op) ")")))
(sym? op "..")) :severity message.severity.WARN
#{:title "Replace with a call to table.concat" :code :bad-unpack
:changes [{:range (message.ast->range server file (if (= 2 (length call)) call last-item)) :fix (if (and (= (length last-item) 2)
:newText (.. "(table.concat " (view (. last-item 2)) ")")}]})})))) (sym? op ".."))
#{:title "Replace with a call to table.concat"
:changes [{:range (message.ast->range server file (if (= 2 (length call)) call last-item))
:newText (.. "(table.concat " (view (. last-item 2)) ")")}]})}))))})
(λ var-never-set [server file symbol definition] (add-lint :var-not-set
(if (and definition.var? (not definition.var-set) (. file.lexical symbol)) {:type :definition
;; we can't provide a quickfix for this because the hooks don't give us :enabled true
;; the full AST of the call to var; just the LHS/RHS :impl (λ [server file symbol definition]
(diagnostic {:range (message.ast->range server file symbol) (if (and definition.var? (not definition.var-set) (. file.lexical symbol))
:message (.. "var is never set: " (tostring symbol) ;; we can't provide a quickfix for this because the hooks don't give us
" Consider using (local) instead of (var)") ;; the full AST of the call to var; just the LHS/RHS
:severity message.severity.WARN (diagnostic {:range (message.ast->range server file symbol)
:code :var-never-set}))) :message (.. "var is never set: " (tostring symbol)
" Consider using (local) instead of (var)")
:severity message.severity.WARN
:code :var-never-set})))})
(local op-identity-value {:+ 0 :* 1 :and true :or false :band -1 :bor 0 :.. ""}) (local op-identity-value {:+ 0 :* 1 :and true :or false :band -1 :bor 0 :.. ""})
(λ op-with-no-arguments [server file op call]
"A call like (+) that could be replaced with a literal"
(let [identity (. op-identity-value (tostring op))]
(if (and (op? op)
(= 1 (length call))
(. file.lexical call)
(not= nil identity))
(diagnostic
{:range (message.ast->range server file call)
:message (.. "write " (view identity) " instead of (" (tostring op) ")")
:severity message.severity.WARN
:code :op-with-no-arguments
:fix #{:title (.. "Replace (" (tostring op) ") with " (view identity))
:changes [{:range (message.ast->range server file call)
:newText (view identity)}]}}))))
(λ no-decreasing-comparison [server file op call] (add-lint :op-with-no-arguments
(if (or (sym? op :>) (sym? op :>=)) {:type :special-call
(diagnostic :enabled true
{:range (message.ast->range server file call) :impl (λ [server file op call]
:message "Use increasing operator instead of decreasing" "A call like (+) that could be replaced with a literal"
:severity message.severity.WARN (let [identity (. op-identity-value (tostring op))]
:code :no-decreasing-comparison (if (and (op? op)
:fix #{:title "Reverse the comparison" (= 1 (length call))
:changes [{:range (message.ast->range server file call) (. file.lexical call)
:newText (let [new (if (sym? op :>=) (fennel.sym :<=) (fennel.sym :<)) (not= nil identity))
reversed (fcollect [i (length call) 2 -1 (diagnostic
&into (list (sym new))] {:range (message.ast->range server file call)
(. call i))] :message (.. "write " (view identity) " instead of (" (tostring op) ")")
(view reversed))}]}}))) :severity message.severity.WARN
:code :op-with-no-arguments
:fix #{:title (.. "Replace (" (tostring op) ") with " (view identity))
:changes [{:range (message.ast->range server file call)
:newText (view identity)}]}}))))})
(add-lint :no-decreasing-comparison
{:type :special-call
:enabled false
:impl (λ [server file op call]
(if (or (sym? op :>) (sym? op :>=))
(diagnostic
{:range (message.ast->range server file call)
:message "Use increasing operator instead of decreasing"
:severity message.severity.WARN
:code :no-decreasing-comparison
:fix #{:title "Reverse the comparison"
:changes [{:range (message.ast->range server file call)
:newText (let [new (if (sym? op :>=) (fennel.sym :<=) (fennel.sym :<))
reversed (fcollect [i (length call) 2 -1
&into (list (sym new))]
(. call i))]
(view reversed))}]}})))})
(λ match-reference? [ast references] (λ match-reference? [ast references]
(if (sym? ast) (?. references ast :target) (if (sym? ast) (?. references ast :target)
@ -224,102 +273,92 @@ the `file.diagnostics` field, filling it with diagnostics."
(accumulate [ref false _ subast (pairs ast) &until ref] (accumulate [ref false _ subast (pairs ast) &until ref]
(match-reference? subast references)))) (match-reference? subast references))))
(λ match-should-case [server {: references &as file} ast] (add-lint :match-should-case
(when (and (list? ast) {:type :macro-call
(sym? (. ast 1) :match) :enabled true
(not (faccumulate [ref false i 3 (length ast) 2 &until ref] :impl (λ [server {: references &as file} ast]
(match-reference? (. ast i) references)))) (when (and (list? ast)
(diagnostic {:range (message.ast->range server file (. ast 1)) (sym? (. ast 1) :match)
:message "no pinned patterns; use case instead of match" (not (faccumulate [ref false i 3 (length ast) 2 &until ref]
:severity message.severity.WARN (match-reference? (. ast i) references))))
:code :match-should-case (diagnostic {:range (message.ast->range server file (. ast 1))
:fix #{:title "Replace match with case" :message "no pinned patterns; use case instead of match"
:changes [{:range (message.ast->range server file (. ast 1)) :severity message.severity.WARN
:newText "case"}]}}))) :code :match-should-case
:fix #{:title "Replace match with case"
:changes [{:range (message.ast->range server file (. ast 1))
:newText "case"}]}})))})
(λ multival-in-middle-of-call [server file fun call arg index] (add-lint :inline-unpack
"generally, values and unpack are signs that the user is trying to do {:type [:function-call :special-call]
something with multiple values. However, multiple values will get :enabled true
\"adjusted\" to one value if they don't come at the end of the call." :impl (λ [server file fun call]
(if (and (not (and (special? fun) (not (op? fun)))) "generally, values and unpack are signs that the user is trying to do
(not= index (length call)) something with multiple values. However, multiple values will get
(list? arg) \"adjusted\" to one value if they don't come at the end of the call."
(or (sym? (. arg 1) :values) (faccumulate [f nil index 2 (length call) &until f]
(sym? (. arg 1) :unpack) (let [arg (. call index)]
(sym? (. arg 1) :_G.unpack) (if (and (not (and (special? fun) (not (op? fun))))
(sym? (. arg 1) :table.unpack))) (not= index (length call))
{:range (message.ast->range server file arg) (list? arg)
:message (.. "bad " (tostring (. arg 1)) (or (sym? (. arg 1) :values)
" call: only the first value of the multival will be used") (sym? (. arg 1) :unpack)
:severity message.severity.WARN (sym? (. arg 1) :_G.unpack)
:code :inline-unpack})) (sym? (. arg 1) :table.unpack)))
{:range (message.ast->range server file arg)
:message (.. "bad " (tostring (. arg 1))
" call: only the first value of the multival will be used")
:severity message.severity.WARN
:code :inline-unpack}))))})
(λ empty-let [server file _ call] (add-lint :empty-let
(case call {:type :special-call
(where [let* binding] :enabled true
(. file.lexical call) :impl (λ [server file _ call]
(sym? let* :let) (case call
(fennel.sequence? binding) (where [let* binding]
(= 0 (length binding))) (. file.lexical call)
(diagnostic {:range (message.ast->range server file binding) (sym? let* :let)
:message "use do instead of let with no bindings" (fennel.sequence? binding)
:severity message.severity.WARN (= 0 (length binding)))
:code :empty-let (diagnostic {:range (message.ast->range server file binding)
:fix #{:title "Replace (let [] ...) with (do ...)" :message "use do instead of let with no bindings"
:changes [(let [{: start} (message.ast->range server file let*) :severity message.severity.WARN
{: end} (message.ast->range server file binding)] :code :empty-let
{:range {: start : end} :fix #{:title "Replace (let [] ...) with (do ...)"
:newText "do"})]}}))) :changes [(let [{: start} (message.ast->range server file let*)
{: end} (message.ast->range server file binding)]
{:range {: start : end}
:newText "do"})]}})))})
(λ add-lint-diagnostics [server file] (λ add-lint-diagnostics [server file]
"fill up the file.diagnostics table with linting things" (each [_ lint (ipairs lints.file)]
(let [lints server.configuration.lints (when (. server.configuration.lints lint.name)
diagnostics file.diagnostics] (lint.impl server file)))
(each [symbol definition (pairs file.definitions)]
(when (. file.lexical symbol)
(each [_ lint (ipairs lints.definition)]
(when (. server.configuration.lints lint.name)
(table.insert file.diagnostics (lint.impl server file symbol definition))))))
(each [symbol (pairs file.references)]
(when (. file.lexical symbol)
(each [_ lint (ipairs lints.reference)]
(when (. server.configuration.lints lint.name)
(table.insert file.diagnostics (lint.impl server file symbol))))))
(each [[head &as ast] (pairs file.calls)]
(when (and (. file.lexical ast) (not= nil head))
(each [_ lint (ipairs (if (special? head)
lints.special-call
lints.function-call))]
(when (and (. server.configuration.lints lint.name)
(or (not lint.target) (sym? head lint.target)))
(table.insert file.diagnostics (lint.impl server file head ast))))))
(each [[head &as ast] macroexpanded (pairs file.macro-calls)]
(when (. file.lexical ast)
(each [_ lint (ipairs lints.macro-call)]
(when (and (. server.configuration.lints lint.name)
(or (not lint.target) (sym? head lint.target)))
(table.insert file.diagnostics (lint.impl server file ast macroexpanded)))))))
;; definition lints {: add-lint-diagnostics
(each [symbol definition (pairs file.definitions)] :list all-lints}
(when lints.unused-definition
(table.insert diagnostics (unused-definition server file symbol definition)))
(when lints.var-never-set
(table.insert diagnostics (var-never-set server file symbol definition))))
;; call lints
;; all non-macro calls. This only covers specials and function calls.
(each [[head &as call] (pairs file.calls)]
(when head
(when (or lints.bad-unpack lints.inline-unpack)
(table.insert diagnostics (bad-unpack server file head call)))
(when lints.unnecessary-method
(table.insert diagnostics (unnecessary-method server file head call)))
(when lints.unnecessary-do
(table.insert diagnostics (unnecessary-do-values server file head call)))
(when lints.unnecessary-tset
(table.insert diagnostics (unnecessary-tset server file head call)))
(when lints.redundant-do
(table.insert diagnostics (redundant-do server file head call)))
(when lints.op-with-no-arguments
(table.insert diagnostics (op-with-no-arguments server file head call)))
(when lints.no-decreasing-comparison
(table.insert diagnostics (no-decreasing-comparison server file head call)))
(when lints.empty-let
(table.insert diagnostics (empty-let server file head call)))
;; argument lints
;; every argument to a special or a function call
;; TODO: This may be changed to run for function calls, but not special calls.
;; I'll wait till we have more lints in here to see if it needs to change.
(for [index 2 (length call)]
(let [arg (. call index)]
(when lints.multival-in-middle-of-call
(table.insert diagnostics
(multival-in-middle-of-call server file head call
arg index)))))))
(each [ast (pairs file.lexical)]
(when lints.match-should-case
(table.insert diagnostics (match-should-case server file ast))))
(when lints.unknown-module-field
(unknown-module-field server file))))
{: add-lint-diagnostics}