Last active
January 28, 2021 08:49
-
-
Save jfmengels/92614e7ff4cf91a9c573c90f0d95a4fb to your computer and use it in GitHub Desktop.
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
-- ELM-REVIEW ERROR ------------------------------------------ src/Route.elm | |
NoMissingTypeConstructor: `allRoutes` does not contain all the type constructors for `Route` | |
11| allRoutes : List Route | |
12| allRoutes = | |
^^^^^^^^^ | |
13| [ HomePage | |
We expect `allRoutes` to contain all the type constructors for `Route`. | |
In this case, you are missing the following constructors: | |
- SomePage |
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.Node as Node exposing (Node) | |
import Elm.Syntax.Type exposing (Type) | |
import Elm.Syntax.TypeAnnotation as TypeAnnotation exposing (TypeAnnotation) | |
import Review.Rule as Rule exposing (Error, Rule) | |
import Set exposing (Set) | |
rule : Rule | |
rule = | |
Rule.newSchema "NoMissingTypeConstructor" | |
|> Rule.withInitialContext initialContext | |
|> Rule.withDeclarationListVisitor declarationListVisitor | |
|> Rule.withDeclarationVisitor declarationVisitor | |
|> Rule.fromSchema | |
type alias Context = | |
{ customTypes : Dict String (Set String) | |
} | |
initialContext : Context | |
initialContext = | |
{ customTypes = Dict.empty | |
} | |
-- DECLARATION LIST VISITOR | |
declarationListVisitor : List (Node Declaration) -> Context -> ( List Error, Context ) | |
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 = | |
declarations | |
|> List.filterMap getCustomType | |
|> List.map (\type_ -> ( Node.value type_.name, typeConstructors type_ )) | |
|> Dict.fromList | |
} | |
) | |
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 -> Rule.Direction -> Context -> ( List Error, Context ) | |
declarationVisitor declaration direction context = | |
{- Here, we are interested in the declarations of the form | |
allXyz : List Xyz | |
allXyz = [ ... ] | |
-} | |
case ( direction, Node.value declaration ) of | |
( Rule.OnEnter, 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 of | |
Just typeName -> | |
-- At this point, we established we are in the definition | |
-- of a definition like the one mentioned above. | |
case Dict.get typeName context.customTypes 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 : TypeAnnotation -> Maybe String | |
getListOfTypeAnnotation typeAnnotation = | |
case typeAnnotation of | |
TypeAnnotation.Typed typeNode (parameterNode :: []) -> | |
case ( Node.value typeNode, Node.value parameterNode ) of | |
( ( [], "List" ), TypeAnnotation.Typed parameter _ ) -> | |
case Node.value parameter of | |
( [], typeName ) -> | |
Just typeName | |
_ -> | |
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 Routes exposing (Route(..), allRoutes) | |
type Route | |
= HomePage | |
| AboutPage | |
| SettingsPage | |
| SomePage | |
allRoutes : List Route | |
allRoutes = | |
[ HomePage | |
, AboutPage | |
, SettingsPage | |
-- Missing SomePage | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
New and more complete version over at https://gist.github.com/jfmengels/e1fd40af3d0e7bde707c0241bf46920f