Allow configuring custom CSS functions

tests/NoUnknownCssClasses.elm

@@ -1,6 +1,6 @@
 module NoUnknownCssClasses exposing
     ( rule
-    , defaults, withCssFiles, withHardcodedKnownClasses
+    , CssArgument(..), defaults, fromLiteral, withCssFiles, withCssUsingFunctions, withHardcodedKnownClasses
     )
 
 {-|
@@ -60,7 +60,7 @@ rule : Configuration -> Rule
 rule (Configuration configuration) =
     Rule.newProjectRuleSchema "NoUnknownCssClasses" (initialProjectContext configuration.knownClasses)
         |> Rule.withExtraFilesProjectVisitor configuration.cssFiles cssFilesVisitor
-        |> Rule.withModuleVisitor moduleVisitor
+        |> Rule.withModuleVisitor (moduleVisitor configuration.cssFunctions)
         |> Rule.withModuleContextUsingContextCreator
             { fromProjectToModule = fromProjectToModule
             , fromModuleToProject = fromModuleToProject
@@ -73,6 +73,7 @@ type Configuration
     = Configuration
         { knownClasses : Set String
         , cssFiles : List String
+        , cssFunctions : CssFunctions
         }
 
 
@@ -81,6 +82,7 @@ defaults =
     Configuration
         { knownClasses = Set.empty
         , cssFiles = []
+        , cssFunctions = baseCssFunctions
         }
 
 
@@ -94,6 +96,16 @@ withHardcodedKnownClasses list (Configuration configuration) =
     Configuration { configuration | knownClasses = List.foldl Set.insert configuration.knownClasses list }
 
 
+withCssUsingFunctions :
+    Dict
+        ( ModuleName, String )
+        ({ firstArgument : Node Expression, restOfArguments : List (Node Expression) } -> List CssArgument)
+    -> Configuration
+    -> Configuration
+withCssUsingFunctions newFunctions (Configuration configuration) =
+    Configuration { configuration | cssFunctions = Dict.union newFunctions configuration.cssFunctions }
+
+
 withCssFiles : List String -> Configuration -> Configuration
 withCssFiles list (Configuration configuration) =
     Configuration { configuration | cssFiles = list ++ configuration.cssFiles }
@@ -110,10 +122,10 @@ type alias ModuleContext =
     }
 
 
-moduleVisitor : Rule.ModuleRuleSchema schema ModuleContext -> Rule.ModuleRuleSchema { schema | hasAtLeastOneVisitor : () } ModuleContext
-moduleVisitor schema =
+moduleVisitor : CssFunctions -> Rule.ModuleRuleSchema schema ModuleContext -> Rule.ModuleRuleSchema { schema | hasAtLeastOneVisitor : () } ModuleContext
+moduleVisitor cssFunctions schema =
     schema
-        |> Rule.withExpressionEnterVisitor expressionVisitor
+        |> Rule.withExpressionEnterVisitor (expressionVisitor cssFunctions)
 
 
 initialProjectContext : Set String -> ProjectContext
@@ -148,21 +160,21 @@ foldProjectContexts new previous =
     }
 
 
-expressionVisitor : Node Expression -> ModuleContext -> ( List (Rule.Error {}), ModuleContext )
-expressionVisitor node context =
+expressionVisitor : CssFunctions -> Node Expression -> ModuleContext -> ( List (Rule.Error {}), ModuleContext )
+expressionVisitor cssFunctions node context =
     case Node.value node of
         Expression.Application ((Node fnRange (Expression.FunctionOrValue _ name)) :: firstArg :: restOfArguments) ->
-            ( reportClasses context fnRange name firstArg restOfArguments
+            ( reportClasses cssFunctions context fnRange name firstArg restOfArguments
             , context
             )
 
         Expression.OperatorApplication "|>" _ firstArg (Node fnRange (Expression.FunctionOrValue _ name)) ->
-            ( reportClasses context fnRange name firstArg []
+            ( reportClasses cssFunctions context fnRange name firstArg []
             , context
             )
 
         Expression.OperatorApplication "<|" _ (Node fnRange (Expression.FunctionOrValue _ name)) firstArg ->
-            ( reportClasses context fnRange name firstArg []
+            ( reportClasses cssFunctions context fnRange name firstArg []
             , context
             )
 
@@ -181,8 +193,8 @@ type alias CssFunctions =
         ({ firstArgument : Node Expression, restOfArguments : List (Node Expression) } -> List CssArgument)
 
 
-cssFunctions : CssFunctions
-cssFunctions =
+baseCssFunctions : CssFunctions
+baseCssFunctions =
     Dict.fromList
         [ ( ( [ "Html", "Attributes" ], "class" ), \{ firstArgument } -> [ fromLiteral firstArgument ] )
         , ( ( [ "Svg", "Attributes" ], "class" ), \{ firstArgument } -> [ fromLiteral firstArgument ] )
@@ -219,8 +231,8 @@ fromLiteral node =
             Variable (Node.range node)
 
 
-reportClasses : ModuleContext -> Range -> String -> Node Expression -> List (Node Expression) -> List (Rule.Error {})
-reportClasses context fnRange name firstArg restOfArguments =
+reportClasses : CssFunctions -> ModuleContext -> Range -> String -> Node Expression -> List (Node Expression) -> List (Rule.Error {})
+reportClasses cssFunctions context fnRange name firstArg restOfArguments =
     case
         ModuleNameLookupTable.moduleNameAt context.lookupTable fnRange
             |> Maybe.andThen (\moduleName -> Dict.get ( moduleName, name ) cssFunctions)

tests/NoUnknownCssClassesTest.elm

@@ -1,6 +1,10 @@
 module NoUnknownCssClassesTest exposing (all)
 
-import NoUnknownCssClasses exposing (defaults, rule, withCssFiles, withHardcodedKnownClasses)
+import Dict
+import Elm.Syntax.Expression as Expression exposing (Expression)
+import Elm.Syntax.ModuleName exposing (ModuleName)
+import Elm.Syntax.Node as Node exposing (Node(..))
+import NoUnknownCssClasses exposing (CssArgument, defaults, fromLiteral, rule, withCssFiles, withCssUsingFunctions, withHardcodedKnownClasses)
 import Review.Project as Project exposing (Project)
 import Review.Test
 import Review.Test.Dependencies
@@ -148,9 +152,50 @@ view model =
                             , under = "variable"
                             }
                         ]
+        , test "should not report an error when encountering a literal CSS class with a custom CSS function" <|
+            \() ->
+                """module A exposing (..)
+import Class
+
+view model =
+    Class.fromString "known"
+"""
+                    |> Review.Test.run
+                        (defaults
+                            |> withHardcodedKnownClasses [ "known" ]
+                            |> withCssUsingFunctions (Dict.fromList [ ( ( [ "Class" ], "fromString" ), classFromAttrFunction ) ])
+                            |> rule
+                        )
+                    |> Review.Test.expectNoErrors
+        , test "should report an error when encountering a non-literal CSS class with a custom CSS function" <|
+            \() ->
+                """module A exposing (..)
+import Class
+
+view model =
+    Class.fromString model.a
+"""
+                    |> Review.Test.run
+                        (defaults
+                            |> withHardcodedKnownClasses [ "known" ]
+                            |> withCssUsingFunctions (Dict.fromList [ ( ( [ "Class" ], "fromString" ), classFromAttrFunction ) ])
+                            |> rule
+                        )
+                    |> Review.Test.expectErrors
+                        [ Review.Test.error
+                            { message = "Non-literal argument to CSS class function"
+                            , details = [ "The argument given to this function is not a value that I could interpret. This makes it hard for me to figure out whether this was a known CSS class or not. Please transform this a string literal (\"my-class\")." ]
+                            , under = "model.a"
+                            }
+                        ]
         ]
 
 
+classFromAttrFunction : { firstArgument : Node Expression, restOfArguments : List (Node Expression) } -> List CssArgument
+classFromAttrFunction { firstArgument } =
+    [ fromLiteral firstArgument ]
+
+
 projectWithCssClasses : Project
 projectWithCssClasses =
     Project.addExtraFiles