NoMissingTypeConstructor elm-review rule
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 |
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