From fdd67292beae69c41dc0d6963e89d65efd6337fc Mon Sep 17 00:00:00 2001 From: Jeroen Engels Date: Sat, 20 Jun 2020 14:30:09 +0200 Subject: [PATCH] Add ability to run modules rules --- src/Review/Rule.elm | 33 +++-- src/Review/Rule3.elm | 308 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 326 insertions(+), 15 deletions(-) diff --git a/src/Review/Rule.elm b/src/Review/Rule.elm index 94c99cdc..20f1cf56 100644 --- a/src/Review/Rule.elm +++ b/src/Review/Rule.elm @@ -15,7 +15,7 @@ module Review.Rule exposing , ignoreErrorsForDirectories, ignoreErrorsForFiles , review , Required, Forbidden - , CacheEntry, CacheEntryFor, ProjectRuleCache, accessInternalError, accumulateWithListOfVisitors, makeFinalEvaluationForProject, setRuleName + , CacheEntry, CacheEntryFor, ModuleRuleResultCache, ProjectRuleCache, Visitor, accessInternalError, accumulateList, accumulateWithListOfVisitors, makeFinalEvaluation, makeFinalEvaluationForProject, runModuleRule, setFilePathIfUnset, setRuleName, visitDeclaration, visitImport ) {-| This module contains functions that are used for writing rules. @@ -782,7 +782,14 @@ computeErrors ((ModuleRuleSchema schema) as moduleVisitor) initialContext module |> accumulateWithListOfVisitors schema.commentsVisitors module_.ast.comments |> accumulateList (visitImport schema.importVisitors) module_.ast.imports |> accumulateWithListOfVisitors schema.declarationListVisitors module_.ast.declarations - |> accumulateList (visitDeclaration moduleVisitor) module_.ast.declarations + |> accumulateList + (visitDeclaration + schema.declarationVisitorsOnEnter + schema.declarationVisitorsOnExit + schema.expressionVisitorsOnEnter + schema.expressionVisitorsOnExit + ) + module_.ast.declarations |> makeFinalEvaluation schema.finalEvaluationFns |> List.map (setRuleName schema.name >> setFilePathIfUnset module_) |> List.reverse @@ -1804,7 +1811,14 @@ visitModuleForProjectRule ((ModuleRuleSchema schema) as moduleVisitor) initialCo |> accumulateWithListOfVisitors schema.commentsVisitors module_.ast.comments |> accumulateList (visitImport schema.importVisitors) module_.ast.imports |> accumulateWithListOfVisitors schema.declarationListVisitors module_.ast.declarations - |> accumulateList (visitDeclaration moduleVisitor) module_.ast.declarations + |> accumulateList + (visitDeclaration + schema.declarationVisitorsOnEnter + schema.declarationVisitorsOnExit + schema.expressionVisitorsOnEnter + schema.expressionVisitorsOnExit + ) + module_.ast.declarations |> (\( errors, moduleContext ) -> ( makeFinalEvaluation schema.finalEvaluationFns ( errors, moduleContext ), moduleContext )) @@ -3454,15 +3468,18 @@ visitImport importVisitors node moduleContext = visitDeclaration : - ModuleRuleSchema schemaState moduleContext + List (Visitor Declaration moduleContext) + -> List (Visitor Declaration moduleContext) + -> List (Visitor Expression moduleContext) + -> List (Visitor Expression moduleContext) -> Node Declaration -> moduleContext -> ( List (Error {}), moduleContext ) -visitDeclaration (ModuleRuleSchema schema) node moduleContext = +visitDeclaration declarationVisitorsOnEnter declarationVisitorsOnExit expressionVisitorsOnEnter expressionVisitorsOnExit node moduleContext = ( [], moduleContext ) - |> visitNodeWithListOfVisitors schema.declarationVisitorsOnEnter node - |> accumulateList (visitExpression schema.expressionVisitorsOnEnter schema.expressionVisitorsOnExit) (expressionsInDeclaration node) - |> visitNodeWithListOfVisitors schema.declarationVisitorsOnExit node + |> visitNodeWithListOfVisitors declarationVisitorsOnEnter node + |> accumulateList (visitExpression expressionVisitorsOnEnter expressionVisitorsOnExit) (expressionsInDeclaration node) + |> visitNodeWithListOfVisitors declarationVisitorsOnExit node visitNodeWithListOfVisitors : diff --git a/src/Review/Rule3.elm b/src/Review/Rule3.elm index d6fe346f..8836dda8 100644 --- a/src/Review/Rule3.elm +++ b/src/Review/Rule3.elm @@ -1,14 +1,21 @@ -module Review.Rule3 exposing (ProjectRuleSchema, fromProjectRuleSchema, newProjectRuleSchema, withDependenciesVisitor, withElmJsonProjectVisitor, withFinalProjectEvaluation, withReadmeProjectVisitor) +module Review.Rule3 exposing (ModuleVisitor, ProjectRuleSchema, fromModuleRuleSchema_New, fromProjectRuleSchema, newModuleRuleSchema_New, newProjectRuleSchema, withCommentsVisitor_New, withDeclarationEnterVisitor_New, withDeclarationExitVisitor_New, withDeclarationListVisitor_New, withDeclarationVisitor_New, withDependenciesVisitor, withElmJsonProjectVisitor, withExpressionEnterVisitor_New, withExpressionExitVisitor_New, withExpressionVisitor_New, withFinalModuleEvaluation_New, withFinalProjectEvaluation, withImportVisitor_New, withModuleDefinitionVisitor_New, withReadmeProjectVisitor, withSimpleCommentsVisitor_New, withSimpleDeclarationVisitor_New, withSimpleExpressionVisitor_New, withSimpleImportVisitor_New, withSimpleModuleDefinitionVisitor_New) import Dict exposing (Dict) import Elm.Project +import Elm.Syntax.Declaration exposing (Declaration) +import Elm.Syntax.Expression exposing (Expression) +import Elm.Syntax.Import exposing (Import) +import Elm.Syntax.Module exposing (Module) import Elm.Syntax.ModuleName exposing (ModuleName) -import Review.Context as Context +import Elm.Syntax.Node as Node exposing (Node) +import Elm.Syntax.Range as Range +import Review.Context as Context exposing (Context) import Review.Error exposing (InternalError) import Review.Exceptions as Exceptions exposing (Exceptions) -import Review.Project exposing (Project) +import Review.Metadata as Metadata +import Review.Project exposing (Project, ProjectModule) import Review.Project.Dependency -import Review.Rule exposing (CacheEntryFor, ElmJsonKey(..), Error(..), ProjectRuleCache, ReadmeKey(..), Rule(..), accessInternalError, accumulateWithListOfVisitors, makeFinalEvaluationForProject, setRuleName) +import Review.Rule exposing (CacheEntryFor, Direction(..), ElmJsonKey(..), Error(..), Forbidden, ModuleRuleResultCache, ProjectRuleCache, ReadmeKey(..), Required, Rule(..), Visitor, accessInternalError, accumulateList, accumulateWithListOfVisitors, makeFinalEvaluation, makeFinalEvaluationForProject, setFilePathIfUnset, setRuleName, visitDeclaration, visitImport) import Vendor.Graph as Graph @@ -18,7 +25,7 @@ type ProjectRuleSchema schemaState projectContext moduleContext , initialProjectContext : projectContext -- TODO add moduleVisitor or implement rule logic - --, moduleVisitor : ModuleVisitorState projectContext moduleContext + , moduleVisitor : ModuleVisitorState_New projectContext moduleContext , elmJsonVisitors : List (Maybe { elmJsonKey : ElmJsonKey, project : Elm.Project.Project } -> projectContext -> ( List (Error {}), projectContext )) , readmeVisitors : List (Maybe { readmeKey : ReadmeKey, content : String } -> projectContext -> ( List (Error {}), projectContext )) , dependenciesVisitors : List (Dict String Review.Project.Dependency.Dependency -> projectContext -> ( List (Error {}), projectContext )) @@ -34,8 +41,7 @@ newProjectRuleSchema name initialProjectContext = ProjectRuleSchema { name = name , initialProjectContext = initialProjectContext - - --, moduleVisitor : ModuleVisitorState projectContext moduleContext + , moduleVisitor = NoModuleVisitor_New , elmJsonVisitors = [] , readmeVisitors = [] , dependenciesVisitors = [] @@ -45,6 +51,202 @@ newProjectRuleSchema name initialProjectContext = } +type ModuleVisitorState_New projectContext moduleContext + = NoModuleVisitor_New + | HasVisitors_New (List (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { hasAtLeastOneVisitor : () } projectContext moduleContext)) + | IsPrepared_New + { visitors : List (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { hasAtLeastOneVisitor : () } projectContext moduleContext) + + --, moduleContext : ModuleContextFunctions projectContext moduleContext + } + + +type + ModuleVisitor schemaState projectContext moduleContext + -- TODO Jeroen check if projectContext is necessary + = ModuleVisitor + { name : String + , moduleContextCreator : Context projectContext moduleContext + , moduleDefinitionVisitors : List (Visitor Module moduleContext) + , commentsVisitors : List (List (Node String) -> moduleContext -> ( List (Error {}), moduleContext )) + , importVisitors : List (Visitor Import moduleContext) + , declarationListVisitors : List (List (Node Declaration) -> moduleContext -> ( List (Error {}), moduleContext )) + , declarationVisitorsOnEnter : List (Visitor Declaration moduleContext) + , declarationVisitorsOnExit : List (Visitor Declaration moduleContext) + , expressionVisitorsOnEnter : List (Visitor Expression moduleContext) + , expressionVisitorsOnExit : List (Visitor Expression moduleContext) + , finalEvaluationFns : List (moduleContext -> List (Error {})) + } + + +emptyModuleVisitor : String -> moduleContext -> ModuleVisitor { moduleContext : Required } () moduleContext +emptyModuleVisitor name moduleContext = + ModuleVisitor + { name = name + , moduleContextCreator = Context.init (always moduleContext) + , moduleDefinitionVisitors = [] + , commentsVisitors = [] + , importVisitors = [] + , declarationListVisitors = [] + , declarationVisitorsOnEnter = [] + , declarationVisitorsOnExit = [] + , expressionVisitorsOnEnter = [] + , expressionVisitorsOnExit = [] + , finalEvaluationFns = [] + } + + +withModuleVisitor : + (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { hasAtLeastOneVisitor : () } projectContext moduleContext) + -> ProjectRuleSchema schemaState projectContext moduleContext + -> ProjectRuleSchema { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withModuleVisitor visitor (ProjectRuleSchema schema) = + let + previousModuleVisitors : List (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { hasAtLeastOneVisitor : () } projectContext moduleContext) + previousModuleVisitors = + case schema.moduleVisitor of + NoModuleVisitor_New -> + [] + + HasVisitors_New list -> + list + + IsPrepared_New _ -> + [] + in + ProjectRuleSchema + { schema + | moduleVisitor = + HasVisitors_New (removeExtensibleRecordTypeVariable_New visitor :: previousModuleVisitors) + } + + +newModuleRuleSchema_New : String -> moduleContext -> ModuleVisitor { moduleContext : Required } () moduleContext +newModuleRuleSchema_New name moduleContext = + emptyModuleVisitor name moduleContext + + +withModuleContext : Context () moduleContext -> ModuleVisitor { schema | moduleContext : Required } () moduleContext -> ModuleVisitor { schema | moduleContext : Forbidden } () moduleContext +withModuleContext moduleContextCreator (ModuleVisitor moduleVisitor) = + ModuleVisitor { moduleVisitor | moduleContextCreator = moduleContextCreator } + + +{-| Create a [`Rule`](#Rule) from a configured [`ModuleRuleSchema`](#ModuleRuleSchema). +-} +fromModuleRuleSchema_New : ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } () moduleContext -> Rule +fromModuleRuleSchema_New ((ModuleVisitor { name }) as schema) = + runModuleRule_New + (reverseVisitors_New schema) + Nothing + |> Rule name Exceptions.init + + +reverseVisitors_New : ModuleVisitor schemaState () moduleContext -> ModuleVisitor schemaState () moduleContext +reverseVisitors_New (ModuleVisitor schema) = + ModuleVisitor + { name = schema.name + , moduleContextCreator = schema.moduleContextCreator + , moduleDefinitionVisitors = List.reverse schema.moduleDefinitionVisitors + , commentsVisitors = List.reverse schema.commentsVisitors + , importVisitors = List.reverse schema.importVisitors + , declarationListVisitors = List.reverse schema.declarationListVisitors + , declarationVisitorsOnEnter = List.reverse schema.declarationVisitorsOnEnter + , declarationVisitorsOnExit = schema.declarationVisitorsOnExit + , expressionVisitorsOnEnter = List.reverse schema.expressionVisitorsOnEnter + , expressionVisitorsOnExit = schema.expressionVisitorsOnExit + , finalEvaluationFns = List.reverse schema.finalEvaluationFns + } + + +runModuleRule_New : ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } () moduleContext -> Maybe ModuleRuleResultCache -> Exceptions -> Project -> List (Graph.NodeContext ModuleName ()) -> ( List (Error {}), Rule ) +runModuleRule_New ((ModuleVisitor schema) as moduleRuleSchema) maybePreviousCache exceptions project _ = + let + previousModuleResults : ModuleRuleResultCache + previousModuleResults = + Maybe.withDefault Dict.empty maybePreviousCache + + modulesToAnalyze : List ProjectModule + modulesToAnalyze = + project + |> Review.Project.modules + |> Exceptions.apply exceptions .path + + availableData : Context.AvailableData + availableData = + { metadata = Metadata.create { moduleNameNode = Node.Node Range.emptyRange [] } + } + + moduleResults : ModuleRuleResultCache + moduleResults = + List.foldl + (\module_ cache -> + if (Dict.get module_.path cache |> Maybe.map .source) == Just module_.source then + -- Module is unchanged, take what was in the cache already + cache + + else + Dict.insert module_.path + { source = module_.source + , errors = computeErrors_New moduleRuleSchema availableData module_ + } + cache + ) + previousModuleResults + modulesToAnalyze + + errors : List (Error {}) + errors = + moduleResults + |> Dict.values + |> List.concatMap .errors + in + ( errors + , runModuleRule_New + moduleRuleSchema + (Just moduleResults) + |> Rule schema.name exceptions + ) + + +computeErrors_New : ModuleVisitor schemaState () moduleContext -> Context.AvailableData -> ProjectModule -> List (Error {}) +computeErrors_New ((ModuleVisitor schema) as moduleVisitor) availableData module_ = + let + initialContext : moduleContext + initialContext = + Context.apply availableData () schema.moduleContextCreator + in + ( [], initialContext ) + |> accumulateWithListOfVisitors schema.moduleDefinitionVisitors module_.ast.moduleDefinition + |> accumulateWithListOfVisitors schema.commentsVisitors module_.ast.comments + |> accumulateList (visitImport schema.importVisitors) module_.ast.imports + |> accumulateWithListOfVisitors schema.declarationListVisitors module_.ast.declarations + |> accumulateList + (visitDeclaration + schema.declarationVisitorsOnEnter + schema.declarationVisitorsOnExit + schema.expressionVisitorsOnEnter + schema.expressionVisitorsOnExit + ) + module_.ast.declarations + |> makeFinalEvaluation schema.finalEvaluationFns + |> List.map (setRuleName schema.name >> setFilePathIfUnset module_) + |> List.reverse + + +{-| This function that is supplied by the user will be stored in the `ProjectRuleSchema`, +but it contains an extensible record. This means that `ProjectRuleSchema` will +need an additional type variable for no useful value. Because we have full control +over the `ModuleRuleSchema` in this module, we can change the phantom type to be +whatever we want it to be, and we'll change it something that makes sense but +without the extensible record type variable. +-} +removeExtensibleRecordTypeVariable_New : + (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { a | hasAtLeastOneVisitor : () } projectContext moduleContext) + -> (ModuleVisitor {} projectContext moduleContext -> ModuleVisitor { hasAtLeastOneVisitor : () } projectContext moduleContext) +removeExtensibleRecordTypeVariable_New function = + function >> (\(ModuleVisitor param) -> ModuleVisitor param) + + withElmJsonProjectVisitor : (Maybe { elmJsonKey : ElmJsonKey, project : Elm.Project.Project } -> projectContext -> ( List (Error {}), projectContext )) -> ProjectRuleSchema schemaState projectContext moduleContext @@ -476,3 +678,95 @@ errorsFromCache cache = -- |> List.concatMap (\cacheEntry -> cacheEntry.errors) , cache.finalEvaluationErrors ] + + +withSimpleModuleDefinitionVisitor_New : (Node Module -> List (Error {})) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withSimpleModuleDefinitionVisitor_New visitor schema = + withModuleDefinitionVisitor_New (\node moduleContext -> ( visitor node, moduleContext )) schema + + +withModuleDefinitionVisitor_New : (Node Module -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withModuleDefinitionVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | moduleDefinitionVisitors = visitor :: schema.moduleDefinitionVisitors } + + +withSimpleCommentsVisitor_New : (List (Node String) -> List (Error {})) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withSimpleCommentsVisitor_New visitor schema = + withCommentsVisitor_New (\node moduleContext -> ( visitor node, moduleContext )) schema + + +withCommentsVisitor_New : (List (Node String) -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withCommentsVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | commentsVisitors = visitor :: schema.commentsVisitors } + + +withSimpleImportVisitor_New : (Node Import -> List (Error {})) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withSimpleImportVisitor_New visitor schema = + withImportVisitor_New (\node moduleContext -> ( visitor node, moduleContext )) schema + + +withImportVisitor_New : (Node Import -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withImportVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | importVisitors = visitor :: schema.importVisitors } + + +withSimpleDeclarationVisitor_New : (Node Declaration -> List (Error {})) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withSimpleDeclarationVisitor_New visitor schema = + withDeclarationEnterVisitor_New + (\node moduleContext -> ( visitor node, moduleContext )) + schema + + +withDeclarationVisitor_New : (Node Declaration -> Direction -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withDeclarationVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor + { schema + | declarationVisitorsOnEnter = (\node ctx -> visitor node OnEnter ctx) :: schema.declarationVisitorsOnEnter + , declarationVisitorsOnExit = (\node ctx -> visitor node OnExit ctx) :: schema.declarationVisitorsOnExit + } + + +withDeclarationEnterVisitor_New : (Node Declaration -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withDeclarationEnterVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | declarationVisitorsOnEnter = visitor :: schema.declarationVisitorsOnEnter } + + +withDeclarationExitVisitor_New : (Node Declaration -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withDeclarationExitVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | declarationVisitorsOnExit = visitor :: schema.declarationVisitorsOnExit } + + +withDeclarationListVisitor_New : (List (Node Declaration) -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withDeclarationListVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | declarationListVisitors = visitor :: schema.declarationListVisitors } + + +withSimpleExpressionVisitor_New : (Node Expression -> List (Error {})) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withSimpleExpressionVisitor_New visitor schema = + withExpressionEnterVisitor_New + (\node moduleContext -> ( visitor node, moduleContext )) + schema + + +withExpressionVisitor_New : (Node Expression -> Direction -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withExpressionVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor + { schema + | expressionVisitorsOnEnter = (\node ctx -> visitor node OnEnter ctx) :: schema.expressionVisitorsOnEnter + , expressionVisitorsOnExit = (\node ctx -> visitor node OnExit ctx) :: schema.expressionVisitorsOnExit + } + + +withExpressionEnterVisitor_New : (Node Expression -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withExpressionEnterVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | expressionVisitorsOnEnter = visitor :: schema.expressionVisitorsOnEnter } + + +withExpressionExitVisitor_New : (Node Expression -> moduleContext -> ( List (Error {}), moduleContext )) -> ModuleVisitor schemaState projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withExpressionExitVisitor_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | expressionVisitorsOnExit = visitor :: schema.expressionVisitorsOnExit } + + +withFinalModuleEvaluation_New : (moduleContext -> List (Error {})) -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext -> ModuleVisitor { schemaState | hasAtLeastOneVisitor : () } projectContext moduleContext +withFinalModuleEvaluation_New visitor (ModuleVisitor schema) = + ModuleVisitor { schema | finalEvaluationFns = visitor :: schema.finalEvaluationFns }