Last active
September 27, 2021 17:55
-
-
Save jfmengels/e1fd40af3d0e7bde707c0241bf46920f to your computer and use it in GitHub Desktop.
NoMissingTypeConstructor elm-review rule
This file contains 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
module NoMissingTypeConstructor exposing (rule) | |
import Dict exposing (Dict) | |
import Elm.Syntax.Declaration as Declaration exposing (Declaration) | |
import Elm.Syntax.Expression as Expression exposing (Expression) | |
import Elm.Syntax.ModuleName exposing (ModuleName) | |
import Elm.Syntax.Node as Node exposing (Node) | |
import Elm.Syntax.Type exposing (Type) | |
import Elm.Syntax.TypeAnnotation as TypeAnnotation exposing (TypeAnnotation) | |
import Review.ModuleNameLookupTable as ModuleNameLookupTable exposing (ModuleNameLookupTable) | |
import Review.Rule as Rule exposing (Error, Rule) | |
import Set exposing (Set) | |
rule : Rule | |
rule = | |
Rule.newProjectRuleSchema "NoMissingTypeConstructor" initialProjectContext | |
|> Rule.withModuleVisitor moduleVisitor | |
|> Rule.withModuleContextUsingContextCreator | |
{ fromProjectToModule = fromProjectToModule | |
, fromModuleToProject = fromModuleToProject | |
, foldProjectContexts = foldProjectContexts | |
} | |
|> Rule.withContextFromImportedModules | |
|> Rule.fromProjectRuleSchema | |
type alias ProjectContext = | |
{ customTypes : Dict ModuleName (Dict String (Set String)) | |
} | |
type alias ModuleContext = | |
{ lookupTable : ModuleNameLookupTable | |
, customTypes : Dict ModuleName (Dict String (Set String)) | |
} | |
moduleVisitor : Rule.ModuleRuleSchema schemaState ModuleContext -> Rule.ModuleRuleSchema { schemaState | hasAtLeastOneVisitor : () } ModuleContext | |
moduleVisitor schema = | |
schema | |
|> Rule.withDeclarationListVisitor declarationListVisitor | |
|> Rule.withDeclarationEnterVisitor declarationVisitor | |
initialProjectContext : ProjectContext | |
initialProjectContext = | |
{ customTypes = Dict.empty | |
} | |
fromModuleToProject : Rule.ContextCreator ModuleContext ProjectContext | |
fromModuleToProject = | |
Rule.initContextCreator | |
(\metadata moduleContext -> | |
{ customTypes = | |
moduleContext.customTypes | |
|> Dict.get [] | |
|> Maybe.withDefault Dict.empty | |
|> Dict.singleton (Rule.moduleNameFromMetadata metadata) | |
} | |
) | |
|> Rule.withMetadata | |
fromProjectToModule : Rule.ContextCreator ProjectContext ModuleContext | |
fromProjectToModule = | |
Rule.initContextCreator | |
(\lookupTable projectContext -> | |
{ lookupTable = lookupTable | |
, customTypes = projectContext.customTypes | |
} | |
) | |
|> Rule.withModuleNameLookupTable | |
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext | |
foldProjectContexts newContext previousContext = | |
{ customTypes = Dict.union newContext.customTypes previousContext.customTypes | |
} | |
-- DECLARATION LIST VISITOR | |
declarationListVisitor : List (Node Declaration) -> ModuleContext -> ( List nothing, ModuleContext ) | |
declarationListVisitor declarations context = | |
-- Here we wish to find the custom types that were defined in the module, and store them in the context. | |
( [] | |
, { context | |
| customTypes = | |
Dict.insert [] | |
(declarations | |
|> List.filterMap getCustomType | |
|> List.map (\type_ -> ( Node.value type_.name, typeConstructors type_ )) | |
|> Dict.fromList | |
) | |
context.customTypes | |
} | |
) | |
typeConstructors : Type -> Set String | |
typeConstructors type_ = | |
type_.constructors | |
|> List.map (Node.value >> .name >> Node.value) | |
|> Set.fromList | |
getCustomType : Node Declaration -> Maybe Type | |
getCustomType node = | |
case Node.value node of | |
Declaration.CustomTypeDeclaration type_ -> | |
Just type_ | |
_ -> | |
Nothing | |
-- DECLARATION VISITOR | |
declarationVisitor : Node Declaration -> ModuleContext -> ( List (Error {}), ModuleContext ) | |
declarationVisitor declaration context = | |
{- Here, we are interested in the declarations of the form | |
allXyz : List Xyz | |
allXyz = [ ... ] | |
-} | |
case Node.value declaration of | |
Declaration.FunctionDeclaration function -> | |
let | |
functionName : Node String | |
functionName = | |
getFunctionName function | |
in | |
if String.startsWith "all" (Node.value functionName) then | |
case getTypeAnnotation function |> Maybe.andThen (getListOfTypeAnnotation context.lookupTable) of | |
Just ( moduleName, typeName ) -> | |
-- At this point, we established we are in the definition | |
-- of a definition like the one mentioned above. | |
case Dict.get moduleName context.customTypes |> Maybe.andThen (Dict.get typeName) of | |
Just constructors -> | |
let | |
usedConstructors : Set String | |
usedConstructors = | |
function.declaration | |
|> Node.value | |
|> .expression | |
|> availableConstructors | |
missingConstructors : Set String | |
missingConstructors = | |
Set.diff constructors usedConstructors | |
in | |
if Set.isEmpty missingConstructors then | |
( [] | |
, context | |
) | |
else | |
( [ Rule.error | |
{ message = "`" ++ Node.value functionName ++ "` does not contain all the type constructors for `" ++ typeName ++ "`" | |
, details = | |
[ "We expect `" ++ Node.value functionName ++ "` to contain all the type constructors for `" ++ typeName ++ "`." | |
, """In this case, you are missing the following constructors: | |
, """ | |
++ (missingConstructors |> Set.toList |> String.join "\n , ") | |
] | |
} | |
(Node.range functionName) | |
] | |
, context | |
) | |
Nothing -> | |
( [] | |
, context | |
) | |
Nothing -> | |
( [], context ) | |
else | |
( [], context ) | |
_ -> | |
( [], context ) | |
availableConstructors : Node Expression -> Set String | |
availableConstructors expr = | |
case Node.value expr of | |
Expression.ListExpr list -> | |
list | |
|> List.filterMap constructorName | |
|> Set.fromList | |
_ -> | |
Set.empty | |
constructorName : Node Expression -> Maybe String | |
constructorName expr = | |
case Node.value expr of | |
Expression.FunctionOrValue _ name -> | |
Just name | |
_ -> | |
Nothing | |
getFunctionName : Expression.Function -> Node String | |
getFunctionName function = | |
function.declaration | |
|> Node.value | |
|> .name | |
getTypeAnnotation : Expression.Function -> Maybe TypeAnnotation | |
getTypeAnnotation function = | |
function.signature | |
|> Maybe.map (Node.value >> .typeAnnotation >> Node.value) | |
getListOfTypeAnnotation : ModuleNameLookupTable -> TypeAnnotation -> Maybe ( ModuleName, String ) | |
getListOfTypeAnnotation lookupTable typeAnnotation = | |
case typeAnnotation of | |
TypeAnnotation.Typed typeNode (parameterNode :: []) -> | |
case ( Node.value typeNode, Node.value parameterNode ) of | |
( ( [], "List" ), TypeAnnotation.Typed parameter _ ) -> | |
case ModuleNameLookupTable.moduleNameFor lookupTable parameter of | |
Just moduleName -> | |
Just ( moduleName, Node.value parameter |> Tuple.second ) | |
Nothing -> | |
Nothing | |
_ -> | |
Nothing | |
_ -> | |
Nothing |
This file contains 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
module NoMissingTypeConstructorTest exposing (all) | |
import NoMissingTypeConstructor exposing (rule) | |
import Review.Test | |
import Test exposing (..) | |
all : Test | |
all = | |
describe "NoMissingTypeConstructor" | |
[ test "should report when a declaration named `all...` that is of type `List <CustomTypeName>` does not have all the type constructors in its value (1)" <| | |
\_ -> | |
"""module A exposing (..) | |
type Thing = A | B | C | D | E | |
allThings : List Thing | |
allThings = [ A, C, B ] | |
""" | |
|> Review.Test.run rule | |
|> Review.Test.expectErrors | |
[ Review.Test.error | |
{ message = "`allThings` does not contain all the type constructors for `Thing`" | |
, details = | |
[ "We expect `allThings` to contain all the type constructors for `Thing`." | |
, """In this case, you are missing the following constructors: | |
, D | |
, E""" | |
] | |
, under = "allThings" | |
} | |
|> Review.Test.atExactly { start = { row = 4, column = 1 }, end = { row = 4, column = 10 } } | |
] | |
, test "should report when a declaration named `all...` that is of type `List <CustomTypeName>` does not have all the type constructors in its value (2)" <| | |
\_ -> | |
"""module A exposing (..) | |
type Shenanigan = FirstThing | SecondThing | ThirdThing | |
allShenanigans : List Shenanigan | |
allShenanigans = [ FirstThing, ThirdThing ] | |
""" | |
|> Review.Test.run rule | |
|> Review.Test.expectErrors | |
[ Review.Test.error | |
{ message = "`allShenanigans` does not contain all the type constructors for `Shenanigan`" | |
, details = | |
[ "We expect `allShenanigans` to contain all the type constructors for `Shenanigan`." | |
, """In this case, you are missing the following constructors: | |
, SecondThing""" | |
] | |
, under = "allShenanigans" | |
} | |
|> Review.Test.atExactly { start = { row = 4, column = 1 }, end = { row = 4, column = 15 } } | |
] | |
, test "should report when a declaration named `all...` that is of type `List <CustomTypeName>` does not have all the type constructors in its value, where type is defined in a different module" <| | |
\_ -> | |
[ """module A exposing (..) | |
import CustomTypeHolder exposing (..) | |
allShenanigans : List Shenanigan | |
allShenanigans = [ FirstThing, ThirdThing ] | |
""", """module CustomTypeHolder exposing (..) | |
type Shenanigan = FirstThing | SecondThing | ThirdThing | |
""" ] | |
|> Review.Test.runOnModules rule | |
|> Review.Test.expectErrorsForModules | |
[ ( "A" | |
, [ Review.Test.error | |
{ message = "`allShenanigans` does not contain all the type constructors for `Shenanigan`" | |
, details = | |
[ "We expect `allShenanigans` to contain all the type constructors for `Shenanigan`." | |
, """In this case, you are missing the following constructors: | |
, SecondThing""" | |
] | |
, under = "allShenanigans" | |
} | |
|> Review.Test.atExactly { start = { row = 4, column = 1 }, end = { row = 4, column = 15 } } | |
] | |
) | |
] | |
, test "should nt report when a declaration named `all...` that is of type `List <CustomTypeName>` has all the type constructors in its value, where type is defined in a different module (unqualified import)" <| | |
\_ -> | |
[ """module A exposing (..) | |
import CustomTypeHolder exposing (..) | |
allShenanigans : List Shenanigan | |
allShenanigans = [ FirstThing, SecondThing, ThirdThing ] | |
""", """module CustomTypeHolder exposing (..) | |
type Shenanigan = FirstThing | SecondThing | ThirdThing | |
""" ] | |
|> Review.Test.runOnModules rule | |
|> Review.Test.expectNoErrors | |
, test "should nt report when a declaration named `all...` that is of type `List <CustomTypeName>` has all the type constructors in its value, where type is defined in a different module (qualified import)" <| | |
\_ -> | |
[ """module A exposing (..) | |
import CustomTypeHolder exposing (..) | |
allShenanigans : List Shenanigan | |
allShenanigans = [ CustomTypeHolder.FirstThing, CustomTypeHolder.SecondThing, CustomTypeHolder.ThirdThing ] | |
""", """module CustomTypeHolder exposing (..) | |
type Shenanigan = FirstThing | SecondThing | ThirdThing | |
""" ] | |
|> Review.Test.runOnModules rule | |
|> Review.Test.expectNoErrors | |
, test "should report when a declaration named `all...` that is of type `List <CustomTypeName>` has all the type constructors in its value" <| | |
\_ -> | |
"""module A exposing (..) | |
type Thing = A | B | C | D | E | |
allThings : List Thing | |
allThings = [ A, C, B, D, E ] | |
""" | |
|> Review.Test.run rule | |
|> Review.Test.expectNoErrors | |
, test "should not report when a declaration named `all...` is a list of an unknown custom type" <| | |
\_ -> | |
"""module A exposing (..) | |
type Thing = A | B | C | D | E | |
allThings : List OtherThing | |
allThings = [ A, C, B ] | |
""" | |
|> Review.Test.run rule | |
|> Review.Test.expectNoErrors | |
, test "should not report when a declaration is not named `all...`" <| | |
\_ -> | |
"""module A exposing (..) | |
type Thing = A | B | C | D | E | |
someOfTheThings : List Thing | |
someOfTheThings = [ A, C, B ] | |
""" | |
|> Review.Test.run rule | |
|> Review.Test.expectNoErrors | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment