Move over more functions

src/Review/Rule.elm

@@ -10,12 +10,12 @@ module Review.Rule exposing
     , withFinalModuleEvaluation
     , withElmJsonModuleVisitor, withReadmeModuleVisitor, withDependenciesModuleVisitor
     , ProjectRuleSchema, newProjectRuleSchema, fromProjectRuleSchema, withModuleVisitor, withModuleContext, withElmJsonProjectVisitor, withReadmeProjectVisitor, withDependenciesProjectVisitor, withFinalProjectEvaluation, withContextFromImportedModules
-    , Error(..), error, errorWithFix, ModuleKey(..), errorForModule, errorForModuleWithFix, ElmJsonKey(..), errorForElmJson, ReadmeKey(..), errorForReadme, errorForReadmeWithFix
+    , Error, error, errorWithFix, ModuleKey(..), errorForModule, errorForModuleWithFix, ElmJsonKey(..), errorForElmJson, ReadmeKey(..), errorForReadme, errorForReadmeWithFix
     , ReviewError, errorRuleName, errorMessage, errorDetails, errorRange, errorFixes, errorFilePath, errorTarget
     , ignoreErrorsForDirectories, ignoreErrorsForFiles
     , review
     , Required, Forbidden
-    , CacheEntry, CacheEntryFor, ModuleRuleResultCache, ModuleVisitorFunctions, ProjectRuleCache, TraversalType(..), Visitor, accessInternalError, accumulateList, accumulateWithListOfVisitors, computeModuleAndCacheResult, duplicateModuleNames, errorToReviewError, getModuleName, makeFinalEvaluation, makeFinalEvaluationForProject, moduleNameNode, parsingError, removeErrorPhantomType, runModuleRule, runRules, setFilePathIfUnset, setRuleName, visitDeclaration, visitImport, visitModuleForProjectRule
+    , TraversalType(..), Visitor, accessInternalError, duplicateModuleNames, errorToReviewError, mapInternalError, parsingError, removeErrorPhantomType, setFilePathIfUnset
     )
 
 {-| This module contains functions that are used for writing rules.
@@ -2976,9 +2976,7 @@ withFinalModuleEvaluation visitor (ModuleRuleSchema schema) =
 {-| Represents an error found by a [`Rule`](#Rule). These are created by the
 rules.
 -}
-type
-    Error scope
-    -- TODO Jeroen not supposed to expose everything
+type Error scope
     = UnspecifiedError InternalError
     | SpecifiedError InternalError
 
@@ -3705,52 +3703,3 @@ accumulate visitor ( previousErrors, previousContext ) =
             visitor previousContext
     in
     ( newErrors ++ previousErrors, newContext )
-
-
-
---type ModuleRuleSchema2 schemaState function moduleContext
---    = Schema2 (ModuleRuleSchemaInternal schemaState moduleContext) (Maybe (AvailableData -> function))
---
---
---type ModuleRuleSchemaInternal a b
---    = ModuleRuleSchemaInternal String
---
---
---new : String -> ModuleRuleSchema2 {} moduleContext moduleContext
---new name =
---    Schema2 (ModuleRuleSchemaInternal name) Nothing
---
---
---withInitialContext : initFunction -> ModuleRuleSchema2 schemaState initFunction moduleContext -> ModuleRuleSchema2 { schemaState | hasInitialContext : () } initFunction moduleContext
---withInitialContext initFunction (Schema2 (ModuleRuleSchemaInternal internal) _) =
---    Schema2 (ModuleRuleSchemaInternal internal) (Just initFunction)
---
---
---type alias AvailableData =
---    { lookupTable : LookupTable
---    }
---
---
---type Metadata
---    = Metadata
---
---
---type LookupTable
---    = LookupTable
---
---
---withLookupTable : ModuleRuleSchema2 schemaState initFunction moduleContext -> ModuleRuleSchema2 schemaState (LookupTable -> initFunction) moduleContext
---withLookupTable (Schema2 underlying initFunction) =
---    Schema2 underlying (\availableData -> initFunction availableData.lookupTable)
---
---
---rule : {
---    init : init
---    , visitors: ...
--- }
---
---init : Rule.Context Context
---init =
---    Context.succeed (\metadata scope -> {})
---        |> Context.withMetadata
---        |> Context.withScope

src/Review/Rule3.elm

@@ -50,8 +50,23 @@ import Review.Metadata as Metadata
 import Review.Project exposing (Project)
 import Review.Project.Dependency
 import Review.Project.Internal
-import Review.Rule exposing (CacheEntry, CacheEntryFor, Direction(..), ElmJsonKey(..), Error(..), Forbidden, ModuleKey(..), ModuleRuleResultCache, ModuleVisitorFunctions, ProjectRuleCache, ReadmeKey(..), Required, Rule(..), TraversalType(..), Visitor, duplicateModuleNames, errorToReviewError, parsingError, removeErrorPhantomType, runRules)
-import Review.Visitor exposing (Folder)
+import Review.Rule
+    exposing
+        ( Direction(..)
+        , ElmJsonKey(..)
+        , Error(..)
+        , Forbidden
+        , ModuleKey(..)
+        , ReadmeKey(..)
+        , Required
+        , Rule(..)
+        , TraversalType(..)
+        , duplicateModuleNames
+        , errorToReviewError
+        , parsingError
+        , removeErrorPhantomType
+        )
+import Review.Visitor exposing (Folder, Visitor)
 import Vendor.Graph as Graph
 
 
@@ -697,3 +712,17 @@ review rules project =
 
         modulesThatFailedToParse ->
             ( List.map parsingError modulesThatFailedToParse, rules )
+
+
+runRules : List Rule -> Project -> List (Graph.NodeContext ModuleName ()) -> ( List (Error {}), List Rule )
+runRules rules project nodeContexts =
+    List.foldl
+        (\(Rule { exceptions, ruleImplementation }) ( errors, previousRules ) ->
+            let
+                ( ruleErrors, ruleWithCache ) =
+                    ruleImplementation exceptions project nodeContexts
+            in
+            ( List.concat [ List.map removeErrorPhantomType ruleErrors, errors ], ruleWithCache :: previousRules )
+        )
+        ( [], [] )
+        rules

src/Review/Visitor.elm

@@ -4,17 +4,19 @@ module Review.Visitor exposing
     , RunnableModuleVisitor
     , RunnableProjectVisitor
     , TraversalAndFolder(..)
+    , Visitor
     , run
     )
 
 import Dict exposing (Dict)
 import Elm.Project
-import Elm.Syntax.Declaration exposing (Declaration)
-import Elm.Syntax.Expression exposing (Expression)
+import Elm.Syntax.Declaration as Declaration exposing (Declaration)
+import Elm.Syntax.Expression as Expression exposing (Expression, Function)
 import Elm.Syntax.Import exposing (Import)
-import Elm.Syntax.Module exposing (Module)
+import Elm.Syntax.Infix as Infix
+import Elm.Syntax.Module as Module exposing (Module)
 import Elm.Syntax.ModuleName exposing (ModuleName)
-import Elm.Syntax.Node exposing (Node)
+import Elm.Syntax.Node as Node exposing (Node)
 import Review.Context as Context exposing (Context)
 import Review.Exceptions as Exceptions exposing (Exceptions)
 import Review.Metadata as Metadata
@@ -23,30 +25,14 @@ import Review.Project.Dependency
 import Review.Project.Internal
 import Review.Rule
     exposing
-        ( CacheEntry
-        , CacheEntryFor
-        , ElmJsonKey(..)
+        ( ElmJsonKey(..)
         , Error
-        , Forbidden
         , ModuleKey(..)
-        , ModuleRuleResultCache
-        , ModuleVisitorFunctions
-        , ProjectRuleCache
         , ReadmeKey(..)
-        , Required
         , Rule(..)
-        , Visitor
         , accessInternalError
-        , accumulateList
-        , accumulateWithListOfVisitors
-        , computeModuleAndCacheResult
-        , getModuleName
-        , makeFinalEvaluation
-        , moduleNameNode
+        , mapInternalError
         , setFilePathIfUnset
-        , setRuleName
-        , visitDeclaration
-        , visitImport
         )
 import Set exposing (Set)
 import Vendor.Graph as Graph exposing (Graph)
@@ -62,6 +48,17 @@ type alias RuleInternals =
     }
 
 
+type alias RunnableProjectVisitor projectContext moduleContext =
+    { initialProjectContext : projectContext
+    , 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 ))
+    , moduleVisitor : Maybe ( RunnableModuleVisitor moduleContext, Context projectContext moduleContext )
+    , traversalAndFolder : TraversalAndFolder projectContext moduleContext
+    , finalEvaluationFns : List (projectContext -> List (Error {}))
+    }
+
+
 type alias RunnableModuleVisitor moduleContext =
     { moduleDefinitionVisitors : List (Visitor Module moduleContext)
     , commentsVisitors : List (List (Node String) -> moduleContext -> ( List (Error {}), moduleContext ))
@@ -75,15 +72,8 @@ type alias RunnableModuleVisitor moduleContext =
     }
 
 
-type alias RunnableProjectVisitor projectContext moduleContext =
-    { initialProjectContext : projectContext
-    , 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 ))
-    , moduleVisitor : Maybe ( RunnableModuleVisitor moduleContext, Context projectContext moduleContext )
-    , traversalAndFolder : TraversalAndFolder projectContext moduleContext
-    , finalEvaluationFns : List (projectContext -> List (Error {}))
-    }
+type alias Visitor nodeType context =
+    Node nodeType -> context -> ( List (Error {}), context )
 
 
 type TraversalAndFolder projectContext moduleContext
@@ -97,6 +87,29 @@ type alias Folder projectContext moduleContext =
     }
 
 
+type alias ProjectRuleCache projectContext =
+    { elmJson : CacheEntryFor (Maybe { path : String, raw : String, project : Elm.Project.Project }) projectContext
+    , readme : CacheEntryFor (Maybe { readmeKey : ReadmeKey, content : String }) projectContext
+    , dependencies : CacheEntryFor (Dict String Review.Project.Dependency.Dependency) projectContext
+    , moduleContexts : Dict String (CacheEntry projectContext)
+    , finalEvaluationErrors : List (Error {})
+    }
+
+
+type alias CacheEntry projectContext =
+    { source : String
+    , errors : List (Error {})
+    , context : projectContext
+    }
+
+
+type alias CacheEntryFor value projectContext =
+    { value : value
+    , errors : List (Error {})
+    , context : projectContext
+    }
+
+
 run : String -> RunnableProjectVisitor projectContext moduleContext -> Maybe (ProjectRuleCache projectContext) -> Exceptions -> Project -> List (Graph.NodeContext ModuleName ()) -> ( List (Error {}), Rule )
 run name projectVisitor maybePreviousCache exceptions project nodeContexts =
     let
@@ -187,6 +200,11 @@ run name projectVisitor maybePreviousCache exceptions project nodeContexts =
     )
 
 
+setRuleName : String -> Error scope -> Error scope
+setRuleName ruleName error_ =
+    mapInternalError (\err -> { err | ruleName = ruleName }) error_
+
+
 errorsFromCache : ProjectRuleCache projectContext -> List (Error {})
 errorsFromCache cache =
     List.concat
@@ -553,6 +571,190 @@ visitModuleForProjectRule schema initialContext module_ =
         |> (\( errors, moduleContext ) -> ( makeFinalEvaluation schema.finalEvaluationFns ( errors, moduleContext ), moduleContext ))
 
 
+visitImport :
+    List (Node Import -> moduleContext -> ( List (Error {}), moduleContext ))
+    -> Node Import
+    -> moduleContext
+    -> ( List (Error {}), moduleContext )
+visitImport importVisitors node moduleContext =
+    visitNodeWithListOfVisitors importVisitors node ( [], moduleContext )
+
+
+visitDeclaration :
+    List (Visitor Declaration moduleContext)
+    -> List (Visitor Declaration moduleContext)
+    -> List (Visitor Expression moduleContext)
+    -> List (Visitor Expression moduleContext)
+    -> Node Declaration
+    -> moduleContext
+    -> ( List (Error {}), moduleContext )
+visitDeclaration declarationVisitorsOnEnter declarationVisitorsOnExit expressionVisitorsOnEnter expressionVisitorsOnExit node moduleContext =
+    ( [], moduleContext )
+        |> visitNodeWithListOfVisitors declarationVisitorsOnEnter node
+        |> accumulateList (visitExpression expressionVisitorsOnEnter expressionVisitorsOnExit) (expressionsInDeclaration node)
+        |> visitNodeWithListOfVisitors declarationVisitorsOnExit node
+
+
+visitExpression :
+    List (Visitor Expression moduleContext)
+    -> List (Visitor Expression moduleContext)
+    -> Node Expression
+    -> moduleContext
+    -> ( List (Error {}), moduleContext )
+visitExpression onEnter onExit node moduleContext =
+    ( [], moduleContext )
+        |> visitNodeWithListOfVisitors onEnter node
+        |> accumulateList (visitExpression onEnter onExit) (expressionChildren node)
+        |> visitNodeWithListOfVisitors onExit node
+
+
+{-| Concatenate the errors of the previous step and of the last step.
+-}
+makeFinalEvaluation : List (context -> List (Error {})) -> ( List (Error {}), context ) -> List (Error {})
+makeFinalEvaluation finalEvaluationFns ( previousErrors, context ) =
+    List.concat
+        [ List.concatMap
+            (\visitor -> visitor context)
+            finalEvaluationFns
+        , previousErrors
+        ]
+
+
+expressionChildren : Node Expression -> List (Node Expression)
+expressionChildren node =
+    case Node.value node of
+        Expression.Application expressions ->
+            expressions
+
+        Expression.Literal _ ->
+            []
+
+        Expression.Integer _ ->
+            []
+
+        Expression.Floatable _ ->
+            []
+
+        Expression.UnitExpr ->
+            []
+
+        Expression.ListExpr elements ->
+            elements
+
+        Expression.FunctionOrValue _ _ ->
+            []
+
+        Expression.RecordExpr fields ->
+            List.map (Node.value >> (\( _, expr ) -> expr)) fields
+
+        Expression.RecordUpdateExpression _ setters ->
+            List.map (Node.value >> (\( _, expr ) -> expr)) setters
+
+        Expression.ParenthesizedExpression expr ->
+            [ expr ]
+
+        Expression.Operator _ ->
+            []
+
+        Expression.OperatorApplication _ direction left right ->
+            case direction of
+                Infix.Left ->
+                    [ left, right ]
+
+                Infix.Right ->
+                    [ right, left ]
+
+                Infix.Non ->
+                    [ left, right ]
+
+        Expression.IfBlock cond then_ else_ ->
+            [ cond, then_, else_ ]
+
+        Expression.LetExpression { expression, declarations } ->
+            List.map
+                (\declaration ->
+                    case Node.value declaration of
+                        Expression.LetFunction function ->
+                            functionToExpression function
+
+                        Expression.LetDestructuring _ expr ->
+                            expr
+                )
+                declarations
+                ++ [ expression ]
+
+        Expression.CaseExpression { expression, cases } ->
+            expression
+                :: List.map (\( _, caseExpression ) -> caseExpression) cases
+
+        Expression.LambdaExpression { expression } ->
+            [ expression ]
+
+        Expression.TupledExpression expressions ->
+            expressions
+
+        Expression.PrefixOperator _ ->
+            []
+
+        Expression.Hex _ ->
+            []
+
+        Expression.Negation expr ->
+            [ expr ]
+
+        Expression.CharLiteral _ ->
+            []
+
+        Expression.RecordAccess expr _ ->
+            [ expr ]
+
+        Expression.RecordAccessFunction _ ->
+            []
+
+        Expression.GLSLExpression _ ->
+            []
+
+
+expressionsInDeclaration : Node Declaration -> List (Node Expression)
+expressionsInDeclaration node =
+    case Node.value node of
+        Declaration.FunctionDeclaration function ->
+            [ functionToExpression function ]
+
+        Declaration.CustomTypeDeclaration _ ->
+            []
+
+        Declaration.AliasDeclaration _ ->
+            []
+
+        Declaration.Destructuring _ expr ->
+            [ expr ]
+
+        Declaration.PortDeclaration _ ->
+            []
+
+        Declaration.InfixDeclaration _ ->
+            []
+
+
+visitNodeWithListOfVisitors :
+    List (Visitor nodeType moduleContext)
+    -> Node nodeType
+    -> ( List (Error {}), moduleContext )
+    -> ( List (Error {}), moduleContext )
+visitNodeWithListOfVisitors visitors node initialErrorsAndContext =
+    List.foldl
+        (\visitor -> accumulate (visitor node))
+        initialErrorsAndContext
+        visitors
+
+
+functionToExpression : Function -> Node Expression
+functionToExpression function =
+    Node.value function.declaration
+        |> .expression
+
+
 
 -- FINAL EVALUATION
 
@@ -576,3 +778,54 @@ errorsFromFinalEvaluationForProject projectVisitor initialContext contextsPerMod
         List.concatMap
             (\finalEvaluationFn -> finalEvaluationFn finalContext)
             projectVisitor.finalEvaluationFns
+
+
+moduleNameNode : Node Module -> Node ModuleName
+moduleNameNode node =
+    case Node.value node of
+        Module.NormalModule data ->
+            data.moduleName
+
+        Module.PortModule data ->
+            data.moduleName
+
+        Module.EffectModule data ->
+            data.moduleName
+
+
+getModuleName : ProjectModule -> ModuleName
+getModuleName module_ =
+    module_.ast.moduleDefinition
+        |> Node.value
+        |> Module.moduleName
+
+
+accumulateWithListOfVisitors :
+    List (a -> context -> ( List (Error {}), context ))
+    -> a
+    -> ( List (Error {}), context )
+    -> ( List (Error {}), context )
+accumulateWithListOfVisitors visitors element initialErrorsAndContext =
+    List.foldl
+        (\visitor -> accumulate (visitor element))
+        initialErrorsAndContext
+        visitors
+
+
+accumulateList : (Node a -> context -> ( List (Error {}), context )) -> List (Node a) -> ( List (Error {}), context ) -> ( List (Error {}), context )
+accumulateList visitor nodes initialErrorsAndContext =
+    List.foldl
+        (\node -> accumulate (visitor node))
+        initialErrorsAndContext
+        nodes
+
+
+{-| Concatenate the errors of the previous step and of the last step, and take the last step's context.
+-}
+accumulate : (context -> ( List (Error {}), context )) -> ( List (Error {}), context ) -> ( List (Error {}), context )
+accumulate visitor ( previousErrors, previousContext ) =
+    let
+        ( newErrors, newContext ) =
+            visitor previousContext
+    in
+    ( newErrors ++ previousErrors, newContext )