mirror of
https://github.com/jfmengels/elm-review.git
synced 2024-08-16 19:40:22 +03:00
Backport rules from packages
This commit is contained in:
parent
0d55d0b858
commit
73262f6f47
@ -10,6 +10,7 @@ import Dict exposing (Dict)
|
|||||||
import Elm.License
|
import Elm.License
|
||||||
import Elm.Project
|
import Elm.Project
|
||||||
import Elm.Syntax.Range exposing (Range)
|
import Elm.Syntax.Range exposing (Range)
|
||||||
|
import Json.Encode as Encode
|
||||||
import Review.Project.Dependency as Dependency exposing (Dependency)
|
import Review.Project.Dependency as Dependency exposing (Dependency)
|
||||||
import Review.Rule as Rule exposing (Error, Rule)
|
import Review.Rule as Rule exposing (Error, Rule)
|
||||||
import Set exposing (Set)
|
import Set exposing (Set)
|
||||||
@ -25,43 +26,68 @@ import Set exposing (Set)
|
|||||||
]
|
]
|
||||||
|
|
||||||
If the license of a dependency is in the `allowed` list, the dependency will not be reported.
|
If the license of a dependency is in the `allowed` list, the dependency will not be reported.
|
||||||
If it's in the `forbidden`, the dependency will be reported as an error.
|
If it's in the `forbidden` list, the dependency will be reported as an error.
|
||||||
If it's in neither, the dependency will be reported but with a different message asking you
|
If it's in neither, the dependency will be reported but with a different message asking you
|
||||||
to add the license to either list.
|
to add the license to either list.
|
||||||
|
|
||||||
|
|
||||||
|
## Usage as an insight rule
|
||||||
|
|
||||||
|
If instead of enforcing a restriction on the licenses, you wish to have an overview of the licenses used in your project,
|
||||||
|
you can run the rule as an insight rule (using `elm-review --report=json --extract`), which would yield an output like
|
||||||
|
the following:
|
||||||
|
|
||||||
|
```json
|
||||||
|
{
|
||||||
|
"NoRedInk/elm-json-decode-pipeline": "BSD-3-Clause",
|
||||||
|
"elm-explorations/markdown": "BSD-3-Clause",
|
||||||
|
"elm-explorations/test": "BSD-3-Clause",
|
||||||
|
"elm/browser": "BSD-3-Clause",
|
||||||
|
"elm/core": "BSD-3-Clause",
|
||||||
|
"elm/html": "BSD-3-Clause",
|
||||||
|
"elm/http": "BSD-3-Clause",
|
||||||
|
"elm/json": "BSD-3-Clause",
|
||||||
|
"elm/parser": "BSD-3-Clause",
|
||||||
|
"elm/random": "BSD-3-Clause",
|
||||||
|
"elm/time": "BSD-3-Clause",
|
||||||
|
"elm/url": "BSD-3-Clause",
|
||||||
|
"elm/virtual-dom": "BSD-3-Clause",
|
||||||
|
"rtfeldman/elm-iso8601-date-strings": "BSD-3-Clause"
|
||||||
|
}
|
||||||
|
```
|
||||||
|
|
||||||
-}
|
-}
|
||||||
rule : { allowed : List String, forbidden : List String } -> Rule
|
rule : { allowed : List String, forbidden : List String } -> Rule
|
||||||
rule configuration =
|
rule configuration =
|
||||||
Rule.newProjectRuleSchema "NoUnapprovedLicense" initialProjectContext
|
Rule.newProjectRuleSchema "NoUnapprovedLicense" initialProjectContext
|
||||||
|> Rule.withElmJsonProjectVisitor elmJsonVisitor
|
|> Rule.withElmJsonProjectVisitor elmJsonVisitor
|
||||||
|> Rule.withDependenciesProjectVisitor dependenciesVisitor
|
|> Rule.withDependenciesProjectVisitor dependenciesVisitor
|
||||||
|> Rule.withFinalProjectEvaluation (finalEvaluationForProject configuration)
|
|> Rule.withFinalProjectEvaluation
|
||||||
|
(finalEvaluationForProject
|
||||||
|
{ allowed = Set.fromList configuration.allowed
|
||||||
|
, forbidden = Set.fromList configuration.forbidden
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Rule.withDataExtractor dataExtractor
|
||||||
|> Rule.fromProjectRuleSchema
|
|> Rule.fromProjectRuleSchema
|
||||||
|
|
||||||
|
|
||||||
type alias Configuration =
|
|
||||||
{ allowed : List String
|
|
||||||
, forbidden : List String
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
dependenciesVisitor : Dict String Dependency -> ProjectContext -> ( List nothing, ProjectContext )
|
dependenciesVisitor : Dict String Dependency -> ProjectContext -> ( List nothing, ProjectContext )
|
||||||
dependenciesVisitor dependencies projectContext =
|
dependenciesVisitor dependencies projectContext =
|
||||||
let
|
let
|
||||||
licenses : Dict String String
|
licenses : Dict String String
|
||||||
licenses =
|
licenses =
|
||||||
dependencies
|
Dict.foldl
|
||||||
|> Dict.toList
|
(\packageName dependency acc ->
|
||||||
|> List.filterMap
|
case Dependency.elmJson dependency of
|
||||||
(\( packageName, dependency ) ->
|
Elm.Project.Package { license } ->
|
||||||
case Dependency.elmJson dependency of
|
Dict.insert packageName (Elm.License.toString license) acc
|
||||||
Elm.Project.Package { license } ->
|
|
||||||
Just ( packageName, Elm.License.toString license )
|
|
||||||
|
|
||||||
Elm.Project.Application _ ->
|
Elm.Project.Application _ ->
|
||||||
Nothing
|
acc
|
||||||
)
|
)
|
||||||
|> Dict.fromList
|
Dict.empty
|
||||||
|
dependencies
|
||||||
in
|
in
|
||||||
( [], { projectContext | licenses = licenses } )
|
( [], { projectContext | licenses = licenses } )
|
||||||
|
|
||||||
@ -101,76 +127,73 @@ initialProjectContext =
|
|||||||
-- FINAL EVALUATION
|
-- FINAL EVALUATION
|
||||||
|
|
||||||
|
|
||||||
finalEvaluationForProject : Configuration -> ProjectContext -> List (Error { useErrorForModule : () })
|
finalEvaluationForProject : { allowed : Set String, forbidden : Set String } -> ProjectContext -> List (Error { useErrorForModule : () })
|
||||||
finalEvaluationForProject configuration projectContext =
|
finalEvaluationForProject { allowed, forbidden } projectContext =
|
||||||
case projectContext.elmJsonKey of
|
case projectContext.elmJsonKey of
|
||||||
Just elmJsonKey ->
|
Just elmJsonKey ->
|
||||||
let
|
Dict.foldl
|
||||||
allowed : Set String
|
(\name license acc ->
|
||||||
allowed =
|
if Set.member license allowed then
|
||||||
Set.fromList configuration.allowed
|
acc
|
||||||
|
|
||||||
forbidden : Set String
|
else if Set.member license forbidden then
|
||||||
forbidden =
|
Rule.errorForElmJson elmJsonKey
|
||||||
Set.fromList configuration.forbidden
|
(\elmJson ->
|
||||||
|
{ message = "Forbidden license `" ++ license ++ "` for dependency `" ++ name ++ "`"
|
||||||
|
, details = [ "This license has been marked as forbidden and you should therefore not use this package." ]
|
||||||
|
, range = findPackageNameInElmJson name elmJson
|
||||||
|
}
|
||||||
|
)
|
||||||
|
:: acc
|
||||||
|
|
||||||
unknownOrForbiddenLicenses : Dict String String
|
else
|
||||||
unknownOrForbiddenLicenses =
|
Rule.errorForElmJson elmJsonKey
|
||||||
projectContext.licenses
|
(\elmJson ->
|
||||||
|> Dict.filter (\_ license -> not <| Set.member license allowed)
|
{ message = "Unknown license `" ++ license ++ "` for dependency `" ++ name ++ "`"
|
||||||
in
|
, details =
|
||||||
unknownOrForbiddenLicenses
|
[ "Talk to your legal team and see if this license is allowed. If it is allowed, add it to the list of allowed licenses. Otherwise, add it to the list of forbidden licenses and remove this dependency."
|
||||||
|> Dict.toList
|
, "More info about licenses at https://spdx.org/licenses."
|
||||||
|> List.map
|
]
|
||||||
(\( name, license ) ->
|
, range = findPackageNameInElmJson name elmJson
|
||||||
if Set.member license forbidden then
|
}
|
||||||
Rule.errorForElmJson elmJsonKey
|
)
|
||||||
(\elmJson ->
|
:: acc
|
||||||
{ message = "Forbidden license `" ++ license ++ "` for dependency `" ++ name ++ "`"
|
)
|
||||||
, details = [ "This license has been marked as forbidden and you should therefore not use this package." ]
|
[]
|
||||||
, range = findPackageNameInElmJson name elmJson
|
projectContext.licenses
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
else
|
|
||||||
Rule.errorForElmJson elmJsonKey
|
|
||||||
(\elmJson ->
|
|
||||||
{ message = "Unknown license `" ++ license ++ "` for dependency `" ++ name ++ "`"
|
|
||||||
, details =
|
|
||||||
[ "Talk to your legal team and see if this license is allowed. If it is allowed, add it to the list of allowed licenses. Otherwise, add it to the list of forbidden licenses and remove this dependency."
|
|
||||||
, "More info about licenses at https://spdx.org/licenses."
|
|
||||||
]
|
|
||||||
, range = findPackageNameInElmJson name elmJson
|
|
||||||
}
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
Nothing ->
|
Nothing ->
|
||||||
[]
|
[]
|
||||||
|
|
||||||
|
|
||||||
|
dataExtractor : ProjectContext -> Encode.Value
|
||||||
|
dataExtractor projectContext =
|
||||||
|
Encode.dict identity Encode.string projectContext.licenses
|
||||||
|
|
||||||
|
|
||||||
findPackageNameInElmJson : String -> String -> Range
|
findPackageNameInElmJson : String -> String -> Range
|
||||||
findPackageNameInElmJson packageName elmJson =
|
findPackageNameInElmJson packageName elmJson =
|
||||||
elmJson
|
findPackageNameInElmJsonHelp packageName (String.lines elmJson) 0
|
||||||
|> String.lines
|
|
||||||
|> List.indexedMap Tuple.pair
|
|
||||||
|> List.filterMap
|
|
||||||
(\( row, line ) ->
|
|
||||||
case String.indexes ("\"" ++ packageName ++ "\"") line of
|
|
||||||
[] ->
|
|
||||||
Nothing
|
|
||||||
|
|
||||||
column :: _ ->
|
|
||||||
Just
|
findPackageNameInElmJsonHelp : String -> List String -> Int -> Range
|
||||||
{ start =
|
findPackageNameInElmJsonHelp packageName lines row =
|
||||||
{ row = row + 1
|
case lines of
|
||||||
, column = column + 2
|
[] ->
|
||||||
}
|
{ start = { row = 1, column = 1 }, end = { row = 10000, column = 1 } }
|
||||||
, end =
|
|
||||||
{ row = row + 1
|
line :: rest ->
|
||||||
, column = column + String.length packageName + 2
|
case String.indexes ("\"" ++ packageName ++ "\"") line of
|
||||||
}
|
[] ->
|
||||||
}
|
findPackageNameInElmJsonHelp packageName rest (row + 1)
|
||||||
)
|
|
||||||
|> List.head
|
column :: _ ->
|
||||||
|> Maybe.withDefault { start = { row = 1, column = 1 }, end = { row = 10000, column = 1 } }
|
{ start =
|
||||||
|
{ row = row + 1
|
||||||
|
, column = column + 2
|
||||||
|
}
|
||||||
|
, end =
|
||||||
|
{ row = row + 1
|
||||||
|
, column = column + String.length packageName + 2
|
||||||
|
}
|
||||||
|
}
|
||||||
|
@ -113,35 +113,53 @@ all =
|
|||||||
\() ->
|
\() ->
|
||||||
sourceCode
|
sourceCode
|
||||||
|> Review.Test.run (rule { allowed = [], forbidden = [] })
|
|> Review.Test.run (rule { allowed = [], forbidden = [] })
|
||||||
|> Review.Test.expectNoErrors
|
|> Review.Test.expectDataExtract """
|
||||||
|
{
|
||||||
|
"elm/core": "BSD-3-Clause"
|
||||||
|
}"""
|
||||||
, test "should not report anything if all dependencies have a license that is allowed" <|
|
, test "should not report anything if all dependencies have a license that is allowed" <|
|
||||||
\() ->
|
\() ->
|
||||||
sourceCode
|
sourceCode
|
||||||
|> Review.Test.runWithProjectData (createProject "MIT") (rule { allowed = [ "MIT" ], forbidden = [] })
|
|> Review.Test.runWithProjectData (createProject "MIT") (rule { allowed = [ "MIT" ], forbidden = [] })
|
||||||
|> Review.Test.expectNoErrors
|
|> Review.Test.expectDataExtract """
|
||||||
|
{
|
||||||
|
"author/dependency": "MIT"
|
||||||
|
}"""
|
||||||
, test "should report an error if a dependency has an unknown license" <|
|
, test "should report an error if a dependency has an unknown license" <|
|
||||||
\() ->
|
\() ->
|
||||||
sourceCode
|
sourceCode
|
||||||
|> Review.Test.runWithProjectData (createProject "BSD-3-Clause") (rule { allowed = [ "MIT" ], forbidden = [] })
|
|> Review.Test.runWithProjectData (createProject "BSD-3-Clause") (rule { allowed = [ "MIT" ], forbidden = [] })
|
||||||
|> Review.Test.expectErrorsForElmJson
|
|> Review.Test.expect
|
||||||
[ Review.Test.error
|
[ Review.Test.elmJsonErrors
|
||||||
{ message = "Unknown license `BSD-3-Clause` for dependency `author/dependency`"
|
[ Review.Test.error
|
||||||
, details =
|
{ message = "Unknown license `BSD-3-Clause` for dependency `author/dependency`"
|
||||||
[ "Talk to your legal team and see if this license is allowed. If it is allowed, add it to the list of allowed licenses. Otherwise, add it to the list of forbidden licenses and remove this dependency."
|
, details =
|
||||||
, "More info about licenses at https://spdx.org/licenses."
|
[ "Talk to your legal team and see if this license is allowed. If it is allowed, add it to the list of allowed licenses. Otherwise, add it to the list of forbidden licenses and remove this dependency."
|
||||||
]
|
, "More info about licenses at https://spdx.org/licenses."
|
||||||
, under = "author/dependency"
|
]
|
||||||
}
|
, under = "author/dependency"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
, Review.Test.dataExtract """
|
||||||
|
{
|
||||||
|
"author/dependency": "BSD-3-Clause"
|
||||||
|
}"""
|
||||||
]
|
]
|
||||||
, test "should report an error if a dependency has a forbidden license" <|
|
, test "should report an error if a dependency has a forbidden license" <|
|
||||||
\() ->
|
\() ->
|
||||||
sourceCode
|
sourceCode
|
||||||
|> Review.Test.runWithProjectData (createProject "BSD-3-Clause") (rule { allowed = [ "MIT" ], forbidden = [ "BSD-3-Clause" ] })
|
|> Review.Test.runWithProjectData (createProject "BSD-3-Clause") (rule { allowed = [ "MIT" ], forbidden = [ "BSD-3-Clause" ] })
|
||||||
|> Review.Test.expectErrorsForElmJson
|
|> Review.Test.expect
|
||||||
[ Review.Test.error
|
[ Review.Test.elmJsonErrors
|
||||||
{ message = "Forbidden license `BSD-3-Clause` for dependency `author/dependency`"
|
[ Review.Test.error
|
||||||
, details = [ "This license has been marked as forbidden and you should therefore not use this package." ]
|
{ message = "Forbidden license `BSD-3-Clause` for dependency `author/dependency`"
|
||||||
, under = "author/dependency"
|
, details = [ "This license has been marked as forbidden and you should therefore not use this package." ]
|
||||||
}
|
, under = "author/dependency"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
, Review.Test.dataExtract """
|
||||||
|
{
|
||||||
|
"author/dependency": "BSD-3-Clause"
|
||||||
|
}"""
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -66,7 +66,7 @@ This function won't be reported because it has not been tagged.
|
|||||||
|
|
||||||
-- With opt-in configuration
|
-- With opt-in configuration
|
||||||
config =
|
config =
|
||||||
[ NoUnoptimizedRecursion.rule (NoUnoptimizedRecursion.optInWithComment "CHECK TCO")
|
[ NoUnoptimizedRecursion.rule (NoUnoptimizedRecursion.optInWithComment "ENSURE TCO")
|
||||||
]
|
]
|
||||||
|
|
||||||
fun n =
|
fun n =
|
||||||
@ -272,13 +272,13 @@ optOutWithComment comment =
|
|||||||
{-| Reports only the functions tagged with a comment.
|
{-| Reports only the functions tagged with a comment.
|
||||||
|
|
||||||
config =
|
config =
|
||||||
[ NoUnoptimizedRecursion.rule (NoUnoptimizedRecursion.optInWithComment "CHECK TCO")
|
[ NoUnoptimizedRecursion.rule (NoUnoptimizedRecursion.optInWithComment "ENSURE TCO")
|
||||||
]
|
]
|
||||||
|
|
||||||
With the configuration above, the following function would be reported.
|
With the configuration above, the following function would be reported.
|
||||||
|
|
||||||
fun n =
|
fun n =
|
||||||
-- CHECK TCO
|
-- ENSURE TCO
|
||||||
if condition n then
|
if condition n then
|
||||||
fun n * n
|
fun n * n
|
||||||
|
|
||||||
@ -291,19 +291,28 @@ optInWithComment comment =
|
|||||||
OptIn comment
|
OptIn comment
|
||||||
|
|
||||||
|
|
||||||
shouldReportFunction : Configuration -> Context -> Range -> Bool
|
hasNoArguments : Expression.FunctionImplementation -> Bool
|
||||||
shouldReportFunction configuration context range =
|
hasNoArguments declaration =
|
||||||
let
|
List.isEmpty declaration.arguments
|
||||||
foundComment : Bool
|
|
||||||
foundComment =
|
|
||||||
Set.member (range.start.row + 1) context.comments
|
|
||||||
in
|
|
||||||
case configuration of
|
|
||||||
OptOut _ ->
|
|
||||||
not foundComment
|
|
||||||
|
|
||||||
OptIn _ ->
|
|
||||||
foundComment
|
shouldReportFunction : Configuration -> Context -> Node Expression.FunctionImplementation -> Bool
|
||||||
|
shouldReportFunction configuration context (Node range declaration) =
|
||||||
|
if hasNoArguments declaration then
|
||||||
|
False
|
||||||
|
|
||||||
|
else
|
||||||
|
let
|
||||||
|
foundComment : Bool
|
||||||
|
foundComment =
|
||||||
|
Set.member (range.start.row + 1) context.comments
|
||||||
|
in
|
||||||
|
case configuration of
|
||||||
|
OptOut _ ->
|
||||||
|
not foundComment
|
||||||
|
|
||||||
|
OptIn _ ->
|
||||||
|
foundComment
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -361,10 +370,16 @@ commentsVisitor configuration comments context =
|
|||||||
( []
|
( []
|
||||||
, { context
|
, { context
|
||||||
| comments =
|
| comments =
|
||||||
comments
|
List.foldl
|
||||||
|> List.filter (Node.value >> String.contains commentTag)
|
(\(Node range value) acc ->
|
||||||
|> List.map (Node.range >> .start >> .row)
|
if String.contains commentTag value then
|
||||||
|> Set.fromList
|
Set.insert range.start.row acc
|
||||||
|
|
||||||
|
else
|
||||||
|
acc
|
||||||
|
)
|
||||||
|
Set.empty
|
||||||
|
comments
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
@ -375,16 +390,7 @@ declarationVisitor configuration node context =
|
|||||||
Declaration.FunctionDeclaration function ->
|
Declaration.FunctionDeclaration function ->
|
||||||
( []
|
( []
|
||||||
, { currentFunctionName =
|
, { currentFunctionName =
|
||||||
let
|
if shouldReportFunction configuration context function.declaration then
|
||||||
hasArguments : Bool
|
|
||||||
hasArguments =
|
|
||||||
function.declaration
|
|
||||||
|> Node.value
|
|
||||||
|> .arguments
|
|
||||||
|> List.isEmpty
|
|
||||||
|> not
|
|
||||||
in
|
|
||||||
if hasArguments && shouldReportFunction configuration context (Node.range function.declaration) then
|
|
||||||
function.declaration
|
function.declaration
|
||||||
|> Node.value
|
|> Node.value
|
||||||
|> .name
|
|> .name
|
||||||
@ -503,53 +509,7 @@ addAllowedLocation configuration node context =
|
|||||||
}
|
}
|
||||||
|
|
||||||
Expression.LetExpression { declarations, expression } ->
|
Expression.LetExpression { declarations, expression } ->
|
||||||
let
|
addAllowedLocationForLetExpression configuration context declarations expression
|
||||||
newScopes : List ( Range, String )
|
|
||||||
newScopes =
|
|
||||||
List.filterMap
|
|
||||||
(\decl ->
|
|
||||||
case Node.value decl of
|
|
||||||
Expression.LetFunction function ->
|
|
||||||
let
|
|
||||||
functionDeclaration : Expression.FunctionImplementation
|
|
||||||
functionDeclaration =
|
|
||||||
Node.value function.declaration
|
|
||||||
|
|
||||||
hasArguments : Bool
|
|
||||||
hasArguments =
|
|
||||||
function.declaration
|
|
||||||
|> Node.value
|
|
||||||
|> .arguments
|
|
||||||
|> List.isEmpty
|
|
||||||
|> not
|
|
||||||
in
|
|
||||||
Just
|
|
||||||
( Node.range functionDeclaration.expression
|
|
||||||
, if hasArguments && shouldReportFunction configuration context (Node.range function.declaration) then
|
|
||||||
Node.value functionDeclaration.name
|
|
||||||
|
|
||||||
else
|
|
||||||
""
|
|
||||||
)
|
|
||||||
|
|
||||||
Expression.LetDestructuring _ _ ->
|
|
||||||
Nothing
|
|
||||||
)
|
|
||||||
declarations
|
|
||||||
in
|
|
||||||
{ context
|
|
||||||
| newScopesForLet = newScopes
|
|
||||||
|
|
||||||
{- The following translates to TCO code
|
|
||||||
|
|
||||||
let
|
|
||||||
fun x =
|
|
||||||
fun x
|
|
||||||
in
|
|
||||||
fun 1
|
|
||||||
-}
|
|
||||||
, tcoLocations = Node.range expression :: context.tcoLocations
|
|
||||||
}
|
|
||||||
|
|
||||||
Expression.ParenthesizedExpression expr ->
|
Expression.ParenthesizedExpression expr ->
|
||||||
{- The following translates to TCO code
|
{- The following translates to TCO code
|
||||||
@ -561,12 +521,12 @@ addAllowedLocation configuration node context =
|
|||||||
|
|
||||||
Expression.CaseExpression { cases } ->
|
Expression.CaseExpression { cases } ->
|
||||||
let
|
let
|
||||||
caseBodies : List Range
|
tcoLocations : List Range
|
||||||
caseBodies =
|
tcoLocations =
|
||||||
List.map (Tuple.second >> Node.range) cases
|
List.foldl (\( _, Node range _ ) acc -> range :: acc) context.tcoLocations cases
|
||||||
in
|
in
|
||||||
{ context
|
{ context
|
||||||
| tcoLocations = caseBodies ++ context.tcoLocations
|
| tcoLocations = tcoLocations
|
||||||
, deOptimizationRange = Just (Node.range node)
|
, deOptimizationRange = Just (Node.range node)
|
||||||
, deOptimizationReason = [ "Among other possible reasons, the recursive call should not appear in the pattern to evaluate for a case expression." ]
|
, deOptimizationReason = [ "Among other possible reasons, the recursive call should not appear in the pattern to evaluate for a case expression." ]
|
||||||
}
|
}
|
||||||
@ -656,6 +616,49 @@ expressionExitVisitor node context =
|
|||||||
( [], removeDeOptimizationRangeIfNeeded node context )
|
( [], removeDeOptimizationRangeIfNeeded node context )
|
||||||
|
|
||||||
|
|
||||||
|
addAllowedLocationForLetExpression : Configuration -> Context -> List (Node Expression.LetDeclaration) -> Node a -> Context
|
||||||
|
addAllowedLocationForLetExpression configuration context declarations expression =
|
||||||
|
let
|
||||||
|
newScopes : List ( Range, String )
|
||||||
|
newScopes =
|
||||||
|
List.filterMap
|
||||||
|
(\decl ->
|
||||||
|
case Node.value decl of
|
||||||
|
Expression.LetFunction function ->
|
||||||
|
let
|
||||||
|
functionDeclaration : Expression.FunctionImplementation
|
||||||
|
functionDeclaration =
|
||||||
|
Node.value function.declaration
|
||||||
|
in
|
||||||
|
Just
|
||||||
|
( Node.range functionDeclaration.expression
|
||||||
|
, if shouldReportFunction configuration context function.declaration then
|
||||||
|
Node.value functionDeclaration.name
|
||||||
|
|
||||||
|
else
|
||||||
|
""
|
||||||
|
)
|
||||||
|
|
||||||
|
Expression.LetDestructuring _ _ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
declarations
|
||||||
|
in
|
||||||
|
{ context
|
||||||
|
| newScopesForLet = newScopes
|
||||||
|
|
||||||
|
{- The following translates to TCO code
|
||||||
|
|
||||||
|
let
|
||||||
|
fun x =
|
||||||
|
fun x
|
||||||
|
in
|
||||||
|
fun 1
|
||||||
|
-}
|
||||||
|
, tcoLocations = Node.range expression :: context.tcoLocations
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
removeDeOptimizationRangeIfNeeded : Node Expression -> Context -> Context
|
removeDeOptimizationRangeIfNeeded : Node Expression -> Context -> Context
|
||||||
removeDeOptimizationRangeIfNeeded node context =
|
removeDeOptimizationRangeIfNeeded node context =
|
||||||
if Just (Node.range node) == context.deOptimizationRange then
|
if Just (Node.range node) == context.deOptimizationRange then
|
||||||
|
@ -149,7 +149,6 @@ moduleVisitor schema =
|
|||||||
|> Rule.withExpressionEnterVisitor (\node context -> ( [], expressionVisitor node context ))
|
|> Rule.withExpressionEnterVisitor (\node context -> ( [], expressionVisitor node context ))
|
||||||
|> Rule.withCaseBranchEnterVisitor (\caseBlock casePattern context -> ( [], caseBranchEnterVisitor caseBlock casePattern context ))
|
|> Rule.withCaseBranchEnterVisitor (\caseBlock casePattern context -> ( [], caseBranchEnterVisitor caseBlock casePattern context ))
|
||||||
|> Rule.withCaseBranchExitVisitor (\caseBlock casePattern context -> ( [], caseBranchExitVisitor caseBlock casePattern context ))
|
|> Rule.withCaseBranchExitVisitor (\caseBlock casePattern context -> ( [], caseBranchExitVisitor caseBlock casePattern context ))
|
||||||
|> Rule.withFinalModuleEvaluation finalModuleEvaluation
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -197,7 +196,6 @@ type alias ProjectContext =
|
|||||||
type alias ModuleContext =
|
type alias ModuleContext =
|
||||||
{ lookupTable : ModuleNameLookupTable
|
{ lookupTable : ModuleNameLookupTable
|
||||||
, exposedCustomTypesWithConstructors : Set CustomTypeName
|
, exposedCustomTypesWithConstructors : Set CustomTypeName
|
||||||
, exposedCustomTypesWithoutConstructors : Set CustomTypeName
|
|
||||||
, isExposed : Bool
|
, isExposed : Bool
|
||||||
, exposesEverything : Bool
|
, exposesEverything : Bool
|
||||||
, exposedConstructors : Dict ModuleNameAsString ExposedConstructors
|
, exposedConstructors : Dict ModuleNameAsString ExposedConstructors
|
||||||
@ -238,7 +236,6 @@ fromProjectToModule =
|
|||||||
(\lookupTable moduleName projectContext ->
|
(\lookupTable moduleName projectContext ->
|
||||||
{ lookupTable = lookupTable
|
{ lookupTable = lookupTable
|
||||||
, exposedCustomTypesWithConstructors = Set.empty
|
, exposedCustomTypesWithConstructors = Set.empty
|
||||||
, exposedCustomTypesWithoutConstructors = Set.empty
|
|
||||||
, isExposed = Set.member (String.join "." moduleName) projectContext.exposedModules
|
, isExposed = Set.member (String.join "." moduleName) projectContext.exposedModules
|
||||||
, exposedConstructors = projectContext.declaredConstructors
|
, exposedConstructors = projectContext.declaredConstructors
|
||||||
, exposesEverything = False
|
, exposesEverything = False
|
||||||
@ -291,11 +288,7 @@ fromModuleToProject =
|
|||||||
{ moduleKey = moduleKey
|
{ moduleKey = moduleKey
|
||||||
, customTypes =
|
, customTypes =
|
||||||
moduleContext.declaredTypesWithConstructors
|
moduleContext.declaredTypesWithConstructors
|
||||||
|> Dict.filter
|
|> Dict.filter (\typeName _ -> not <| Set.member typeName moduleContext.exposedCustomTypesWithConstructors)
|
||||||
(\typeName _ ->
|
|
||||||
not (Set.member typeName moduleContext.exposedCustomTypesWithConstructors)
|
|
||||||
&& not (Set.member typeName moduleContext.exposedCustomTypesWithoutConstructors)
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
@ -304,13 +297,7 @@ fromModuleToProject =
|
|||||||
moduleNameAsString
|
moduleNameAsString
|
||||||
(ExposedConstructors
|
(ExposedConstructors
|
||||||
{ moduleKey = moduleKey
|
{ moduleKey = moduleKey
|
||||||
, customTypes =
|
, customTypes = moduleContext.declaredTypesWithConstructors
|
||||||
moduleContext.declaredTypesWithConstructors
|
|
||||||
|> Dict.filter
|
|
||||||
(\typeName _ ->
|
|
||||||
Set.member typeName moduleContext.exposedCustomTypesWithConstructors
|
|
||||||
|| Set.member typeName moduleContext.exposedCustomTypesWithoutConstructors
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
, usedConstructors =
|
, usedConstructors =
|
||||||
@ -470,26 +457,21 @@ moduleDefinitionVisitor moduleNode context =
|
|||||||
|
|
||||||
Exposing.Explicit list ->
|
Exposing.Explicit list ->
|
||||||
let
|
let
|
||||||
( exposedCustomTypesWithConstructors, exposedCustomTypesWithoutConstructors ) =
|
exposedCustomTypesWithConstructors : Set String
|
||||||
|
exposedCustomTypesWithConstructors =
|
||||||
List.foldl
|
List.foldl
|
||||||
(\node (( withConstructors, withoutConstructors ) as acc) ->
|
(\node acc ->
|
||||||
case Node.value node of
|
case Node.value node of
|
||||||
Exposing.TypeExpose { name } ->
|
Exposing.TypeExpose { name } ->
|
||||||
( Set.insert name withConstructors, withoutConstructors )
|
Set.insert name acc
|
||||||
|
|
||||||
Exposing.TypeOrAliasExpose name ->
|
|
||||||
( withConstructors, Set.insert name withoutConstructors )
|
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
acc
|
acc
|
||||||
)
|
)
|
||||||
( context.exposedCustomTypesWithConstructors, context.exposedCustomTypesWithoutConstructors )
|
context.exposedCustomTypesWithConstructors
|
||||||
list
|
list
|
||||||
in
|
in
|
||||||
{ context
|
{ context | exposedCustomTypesWithConstructors = exposedCustomTypesWithConstructors }
|
||||||
| exposedCustomTypesWithConstructors = exposedCustomTypesWithConstructors
|
|
||||||
, exposedCustomTypesWithoutConstructors = exposedCustomTypesWithoutConstructors
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1090,44 +1072,6 @@ isCapitalized name =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- FINAL MODULE EVALUATION
|
|
||||||
|
|
||||||
|
|
||||||
finalModuleEvaluation : ModuleContext -> List (Error {})
|
|
||||||
finalModuleEvaluation moduleContext =
|
|
||||||
let
|
|
||||||
customTypes : Dict CustomTypeName (Dict ConstructorName ConstructorInformation)
|
|
||||||
customTypes =
|
|
||||||
if moduleContext.isExposed then
|
|
||||||
moduleContext.declaredTypesWithConstructors
|
|
||||||
|> Dict.filter
|
|
||||||
(\typeName _ ->
|
|
||||||
Set.member typeName moduleContext.exposedCustomTypesWithoutConstructors
|
|
||||||
)
|
|
||||||
|
|
||||||
else
|
|
||||||
moduleContext.declaredTypesWithConstructors
|
|
||||||
|> Dict.filter
|
|
||||||
(\typeName _ ->
|
|
||||||
not (Set.member typeName moduleContext.exposedCustomTypesWithConstructors)
|
|
||||||
&& not (Set.member typeName moduleContext.exposedCustomTypesWithoutConstructors)
|
|
||||||
)
|
|
||||||
|
|
||||||
getFixes : ConstructorName -> List Fix
|
|
||||||
getFixes name =
|
|
||||||
Dict.get name moduleContext.fixesForRemovingConstructor |> Maybe.withDefault []
|
|
||||||
in
|
|
||||||
errorsForCustomTypes
|
|
||||||
moduleContext
|
|
||||||
Rule.errorWithFix
|
|
||||||
getFixes
|
|
||||||
(Dict.get "" moduleContext.usedFunctionsOrValues |> Maybe.withDefault Set.empty)
|
|
||||||
""
|
|
||||||
customTypes
|
|
||||||
[]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- FINAL PROJECT EVALUATION
|
-- FINAL PROJECT EVALUATION
|
||||||
|
|
||||||
|
|
||||||
@ -1136,76 +1080,41 @@ finalProjectEvaluation projectContext =
|
|||||||
Dict.foldl
|
Dict.foldl
|
||||||
(\moduleName (ExposedConstructors { moduleKey, customTypes }) acc ->
|
(\moduleName (ExposedConstructors { moduleKey, customTypes }) acc ->
|
||||||
let
|
let
|
||||||
getFixes : ConstructorName -> List Fix
|
|
||||||
getFixes name =
|
|
||||||
Dict.get ( moduleName, name ) projectContext.fixesForRemovingConstructor |> Maybe.withDefault []
|
|
||||||
|
|
||||||
usedConstructors : Set ConstructorName
|
usedConstructors : Set ConstructorName
|
||||||
usedConstructors =
|
usedConstructors =
|
||||||
Dict.get moduleName projectContext.usedConstructors
|
Dict.get moduleName projectContext.usedConstructors
|
||||||
|> Maybe.withDefault Set.empty
|
|> Maybe.withDefault Set.empty
|
||||||
in
|
in
|
||||||
errorsForCustomTypes
|
errorsForCustomTypes projectContext usedConstructors moduleName moduleKey customTypes acc
|
||||||
projectContext
|
|
||||||
(Rule.errorForModuleWithFix moduleKey)
|
|
||||||
getFixes
|
|
||||||
usedConstructors
|
|
||||||
moduleName
|
|
||||||
customTypes
|
|
||||||
acc
|
|
||||||
)
|
)
|
||||||
[]
|
[]
|
||||||
projectContext.declaredConstructors
|
projectContext.declaredConstructors
|
||||||
|
|
||||||
|
|
||||||
type alias DataForReportingConstructors a =
|
errorsForCustomTypes : ProjectContext -> Set String -> String -> Rule.ModuleKey -> Dict CustomTypeName (Dict ConstructorName ConstructorInformation) -> List (Error scope) -> List (Error scope)
|
||||||
{ a
|
errorsForCustomTypes projectContext usedConstructors moduleName moduleKey customTypes acc =
|
||||||
| wasUsedInLocationThatNeedsItself : Set ( ModuleNameAsString, String )
|
|
||||||
, wasUsedInComparisons : Set ( ModuleNameAsString, String )
|
|
||||||
, wasUsedInOtherModules : Set ( ModuleNameAsString, String )
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
errorsForCustomTypes :
|
|
||||||
DataForReportingConstructors a
|
|
||||||
-> ({ message : String, details : List String } -> Range -> List Fix -> Error scope)
|
|
||||||
-> (ConstructorName -> List Fix)
|
|
||||||
-> Set String
|
|
||||||
-> String
|
|
||||||
-> Dict CustomTypeName (Dict ConstructorName ConstructorInformation)
|
|
||||||
-> List (Error scope)
|
|
||||||
-> List (Error scope)
|
|
||||||
errorsForCustomTypes projectContext createError getFixes usedConstructors moduleName customTypes acc =
|
|
||||||
Dict.foldl
|
Dict.foldl
|
||||||
(\_ constructors subAcc ->
|
(\_ constructors subAcc ->
|
||||||
errorsForConstructors projectContext createError getFixes usedConstructors moduleName constructors subAcc
|
errorsForConstructors projectContext usedConstructors moduleName moduleKey constructors subAcc
|
||||||
)
|
)
|
||||||
acc
|
acc
|
||||||
customTypes
|
customTypes
|
||||||
|
|
||||||
|
|
||||||
errorsForConstructors :
|
errorsForConstructors : ProjectContext -> Set String -> String -> Rule.ModuleKey -> Dict ConstructorName ConstructorInformation -> List (Error scope) -> List (Error scope)
|
||||||
DataForReportingConstructors a
|
errorsForConstructors projectContext usedConstructors moduleName moduleKey constructors acc =
|
||||||
-> ({ message : String, details : List String } -> Range -> List Fix -> Error scope)
|
|
||||||
-> (ConstructorName -> List Fix)
|
|
||||||
-> Set String
|
|
||||||
-> String
|
|
||||||
-> Dict ConstructorName ConstructorInformation
|
|
||||||
-> List (Error scope)
|
|
||||||
-> List (Error scope)
|
|
||||||
errorsForConstructors projectContext createError getFixes usedConstructors moduleName constructors acc =
|
|
||||||
Dict.foldl
|
Dict.foldl
|
||||||
(\constructorName constructorInformation subAcc ->
|
(\constructorName constructorInformation subAcc ->
|
||||||
if Set.member constructorName usedConstructors then
|
if Set.member constructorName usedConstructors then
|
||||||
subAcc
|
subAcc
|
||||||
|
|
||||||
else
|
else
|
||||||
reportError
|
errorForModule
|
||||||
createError
|
moduleKey
|
||||||
{ wasUsedInLocationThatNeedsItself = Set.member ( moduleName, constructorName ) projectContext.wasUsedInLocationThatNeedsItself
|
{ wasUsedInLocationThatNeedsItself = Set.member ( moduleName, constructorInformation.name ) projectContext.wasUsedInLocationThatNeedsItself
|
||||||
, wasUsedInComparisons = Set.member ( moduleName, constructorName ) projectContext.wasUsedInComparisons
|
, wasUsedInComparisons = Set.member ( moduleName, constructorInformation.name ) projectContext.wasUsedInComparisons
|
||||||
, isUsedInOtherModules = Set.member ( moduleName, constructorName ) projectContext.wasUsedInOtherModules
|
, isUsedInOtherModules = Set.member ( moduleName, constructorInformation.name ) projectContext.wasUsedInOtherModules
|
||||||
, fixesForRemovingConstructor = getFixes constructorName
|
, fixesForRemovingConstructor = Dict.get ( moduleName, constructorInformation.name ) projectContext.fixesForRemovingConstructor |> Maybe.withDefault []
|
||||||
}
|
}
|
||||||
constructorInformation
|
constructorInformation
|
||||||
:: subAcc
|
:: subAcc
|
||||||
@ -1236,8 +1145,8 @@ defaultDetails =
|
|||||||
"This type constructor is never used. It might be handled everywhere it might appear, but there is no location where this value actually gets created."
|
"This type constructor is never used. It might be handled everywhere it might appear, but there is no location where this value actually gets created."
|
||||||
|
|
||||||
|
|
||||||
reportError :
|
errorForModule :
|
||||||
({ message : String, details : List String } -> Range -> List Fix -> Error scope)
|
Rule.ModuleKey
|
||||||
->
|
->
|
||||||
{ wasUsedInLocationThatNeedsItself : Bool
|
{ wasUsedInLocationThatNeedsItself : Bool
|
||||||
, wasUsedInComparisons : Bool
|
, wasUsedInComparisons : Bool
|
||||||
@ -1246,8 +1155,9 @@ reportError :
|
|||||||
}
|
}
|
||||||
-> ConstructorInformation
|
-> ConstructorInformation
|
||||||
-> Error scope
|
-> Error scope
|
||||||
reportError createError params constructorInformation =
|
errorForModule moduleKey params constructorInformation =
|
||||||
createError
|
Rule.errorForModuleWithFix
|
||||||
|
moduleKey
|
||||||
(errorInformation
|
(errorInformation
|
||||||
{ wasUsedInLocationThatNeedsItself = params.wasUsedInLocationThatNeedsItself
|
{ wasUsedInLocationThatNeedsItself = params.wasUsedInLocationThatNeedsItself
|
||||||
, wasUsedInComparisons = params.wasUsedInComparisons
|
, wasUsedInComparisons = params.wasUsedInComparisons
|
||||||
|
@ -924,6 +924,18 @@ module MyModule exposing (..)
|
|||||||
type Foo = Bar
|
type Foo = Bar
|
||||||
"""
|
"""
|
||||||
]
|
]
|
||||||
|
, test "should not report used type constructors when an application module is exposing all but it's used elsewhere" <|
|
||||||
|
\() ->
|
||||||
|
[ """
|
||||||
|
module MyModule exposing (..)
|
||||||
|
type Foo = Bar | Baz
|
||||||
|
""", """
|
||||||
|
module Main exposing (main)
|
||||||
|
import MyModule
|
||||||
|
main = [MyModule.Bar, MyModule.Baz]
|
||||||
|
""" ]
|
||||||
|
|> Review.Test.runOnModulesWithProjectData applicationProject (rule [])
|
||||||
|
|> Review.Test.expectNoErrors
|
||||||
, test "should not report unused type constructors when package module is exposing the constructors of that type and module is exposed" <|
|
, test "should not report unused type constructors when package module is exposing the constructors of that type and module is exposed" <|
|
||||||
\() ->
|
\() ->
|
||||||
"""
|
"""
|
||||||
|
Loading…
Reference in New Issue
Block a user