WIP: Add elm-review rules

.gitignore

@@ -3,3 +3,4 @@
 /docs.json
 /package-lock.json
 /website/node_modules/
+/review/elm-stuff/

package.json

@@ -6,11 +6,13 @@
     "elm": "^0.19.1-3",
     "elm-doc-preview": "^3.0.4",
     "elm-format": "0.8.3",
+    "elm-review": "^2.3.3",
     "elm-test": "^0.19.1",
     "vuepress": "^1.3.1"
   },
   "scripts": {
-    "test": "elm-test && npm run-script build-examples && elm make --docs docs.json && elm-format --validate . && elm diff",
+    "test": "elm-test && npm run-script build-examples && elm make --docs docs.json && npm run-script check && (cd review && elm-test) && elm diff",
+    "check": "elm-format --validate . && elm-review",
     "build-examples": "(cd examples && elm make src/*.elm --output=/dev/null && elm-test)",
     "run-examples": "(cd examples && elm reactor --port 8002)",
     "run-examples-backend": "(cd examples && PORT=8003 ./node_modules/.bin/nodemon server.js)",

review/elm.json

@@ -0,0 +1,37 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/core": "1.0.5",
+            "elm/json": "1.1.3",
+            "elm/project-metadata-utils": "1.0.1",
+            "jfmengels/elm-review": "2.3.8",
+            "jfmengels/elm-review-debug": "1.0.3",
+            "mgold/elm-nonempty-list": "4.1.0",
+            "stil4m/elm-syntax": "7.1.3"
+        },
+        "indirect": {
+            "elm/html": "1.0.0",
+            "elm/parser": "1.1.0",
+            "elm/random": "1.0.0",
+            "elm/time": "1.0.0",
+            "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
+            "elm-community/json-extra": "4.3.0",
+            "elm-community/list-extra": "8.2.4",
+            "rtfeldman/elm-hex": "1.0.0",
+            "rtfeldman/elm-iso8601-date-strings": "1.1.3",
+            "stil4m/structured-writer": "1.0.3"
+        }
+    },
+    "test-dependencies": {
+        "direct": {
+            "elm-explorations/test": "1.2.2"
+        },
+        "indirect": {}
+    }
+}

review/src/ElmSyntaxHelper.elm

@@ -0,0 +1,78 @@
+module ElmSyntaxHelper exposing (removeTypeAnnotationRange, typeAnnotationToString)
+
+{-| from <https://gist.github.com/jfmengels/966c086eb79244ca55cf362fc2dd60cf>
+-}
+
+import Elm.Syntax.Node as Node exposing (Node(..))
+import Elm.Syntax.Range as Range
+import Elm.Syntax.TypeAnnotation exposing (RecordField, TypeAnnotation(..))
+
+
+removeTypeAnnotationRange : Node TypeAnnotation -> Node TypeAnnotation
+removeTypeAnnotationRange (Node _ value) =
+    Node Range.emptyRange
+        (case value of
+            FunctionTypeAnnotation input output ->
+                FunctionTypeAnnotation (removeTypeAnnotationRange input) (removeTypeAnnotationRange output)
+
+            Typed (Node _ nameNode) params ->
+                Typed (Node Range.emptyRange nameNode) (List.map removeTypeAnnotationRange params)
+
+            GenericType string ->
+                GenericType string
+
+            Unit ->
+                Unit
+
+            Tupled nodes ->
+                Tupled (List.map removeTypeAnnotationRange nodes)
+
+            Record recordDefinition ->
+                Record
+                    (List.map
+                        (Node.value
+                            >> (\( Node _ field, Node _ type_ ) ->
+                                    Node Range.emptyRange ( Node Range.emptyRange field, Node Range.emptyRange type_ )
+                               )
+                        )
+                        recordDefinition
+                    )
+
+            GenericRecord (Node _ var) (Node _ recordDefinition) ->
+                GenericRecord
+                    (Node Range.emptyRange var)
+                    (Node Range.emptyRange recordDefinition)
+        )
+
+
+typeAnnotationToString : Node TypeAnnotation -> String
+typeAnnotationToString node =
+    case Node.value node of
+        GenericType string ->
+            string
+
+        Typed (Node _ ( [], name )) args ->
+            String.join " " (name :: List.map typeAnnotationToString args)
+
+        Typed (Node _ ( moduleName, name )) args ->
+            String.join " " ((String.join "." moduleName ++ "." ++ name) :: List.map typeAnnotationToString args)
+
+        Unit ->
+            "()"
+
+        Tupled items ->
+            "( " ++ String.join ", " (List.map typeAnnotationToString items) ++ " )"
+
+        Record fields ->
+            "{ " ++ String.join ", " (List.map recordFieldToString fields) ++ " }"
+
+        GenericRecord (Node _ base) (Node _ fields) ->
+            "{ " ++ base ++ " | " ++ String.join ", " (List.map recordFieldToString fields) ++ " }"
+
+        FunctionTypeAnnotation left right ->
+            "(" ++ typeAnnotationToString left ++ " -> " ++ typeAnnotationToString right ++ ")"
+
+
+recordFieldToString : Node RecordField -> String
+recordFieldToString (Node _ ( Node _ key, value )) =
+    key ++ " : " ++ typeAnnotationToString value

review/src/ExpectEnsurePairsMatch.elm

@@ -0,0 +1,188 @@
+module ExpectEnsurePairsMatch exposing (rule)
+
+{-|
+
+@docs rule
+
+-}
+
+import Dict exposing (Dict)
+import Elm.Syntax.Declaration as Declaration exposing (Declaration)
+import Elm.Syntax.Node as Node exposing (Node(..))
+import Elm.Syntax.Range as Range
+import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..))
+import ElmSyntaxHelper exposing (removeTypeAnnotationRange, typeAnnotationToString)
+import List.Nonempty as Nonempty exposing (Nonempty)
+import Review.Rule as Rule exposing (Rule)
+
+
+{-| Makes sure that `expect*`/`ensure*` function pairs are consistent.
+-}
+rule : Rule
+rule =
+    Rule.newModuleRuleSchema "ExpectEnsurePairsMatch" initContext
+        |> Rule.withDeclarationListVisitor collectExpectTypes
+        |> Rule.withDeclarationEnterVisitor validateEnsureTypes
+        |> Rule.fromModuleRuleSchema
+
+
+type alias Context =
+    { expectFunctionArguments : Dict String (List (Node TypeAnnotation))
+    }
+
+
+initContext : Context
+initContext =
+    { expectFunctionArguments = Dict.empty
+    }
+
+
+collectExpectTypes : List (Node Declaration) -> Context -> ( List never, Context )
+collectExpectTypes declarations context =
+    ( []
+    , { context
+        | expectFunctionArguments =
+            -- TODO: report when expect functions aren't valid
+            List.filterMap
+                (\decl ->
+                    case getNamedFunctionType "expect" decl of
+                        Just ( name, _, Ok args ) ->
+                            Just ( name, args )
+
+                        _ ->
+                            Nothing
+                )
+                declarations
+                |> Dict.fromList
+      }
+    )
+
+
+getNamedFunctionType : String -> Node Declaration -> Maybe ( String, Node String, Result FunctionParseError (List (Node TypeAnnotation)) )
+getNamedFunctionType prefix declaration =
+    case getFunctionType declaration of
+        Just ( functionName, annotation ) ->
+            if String.startsWith prefix (Node.value functionName) then
+                Just
+                    ( String.dropLeft (String.length prefix) (Node.value functionName)
+                    , functionName
+                    , case Maybe.map (List.reverse << Nonempty.toList) annotation of
+                        Just (returnType :: programTest :: args) ->
+                            -- TODO: validate that return value is Expectation
+                            -- TODO: validate that last arg is ProgramTest msg model effect
+                            Ok (List.reverse args)
+
+                        Just _ ->
+                            Err NotEnoughArgs
+
+                        Nothing ->
+                            Err NoTypeAnnotation
+                    )
+
+            else
+                Nothing
+
+        Nothing ->
+            Nothing
+
+
+type FunctionParseError
+    = NotAFunction
+    | NotEnoughArgs
+    | NoTypeAnnotation
+
+
+getFunctionType : Node Declaration -> Maybe ( Node String, Maybe (Nonempty (Node TypeAnnotation)) )
+getFunctionType declaration =
+    case Node.value declaration of
+        Declaration.FunctionDeclaration function ->
+            let
+                functionName =
+                    function.declaration
+                        |> Node.value
+                        |> .name
+            in
+            Just
+                ( functionName
+                , Maybe.map (flattenFunctionType << .typeAnnotation << Node.value) function.signature
+                )
+
+        _ ->
+            Nothing
+
+
+flattenFunctionType : Node TypeAnnotation -> Nonempty (Node TypeAnnotation)
+flattenFunctionType typeAnnotation =
+    case Node.value typeAnnotation of
+        FunctionTypeAnnotation left right ->
+            Nonempty.cons left (flattenFunctionType right)
+
+        _ ->
+            Nonempty.fromElement typeAnnotation
+
+
+validateEnsureTypes : Node Declaration -> Context -> ( List (Rule.Error {}), Context )
+validateEnsureTypes node context =
+    ( case getNamedFunctionType "ensure" node of
+        Just ( name, functionName, Ok ensureArgs ) ->
+            case Dict.get name context.expectFunctionArguments of
+                Just expectArgs ->
+                    let
+                        checkArg ensureArg expectArg =
+                            if removeTypeAnnotationRange ensureArg == removeTypeAnnotationRange expectArg then
+                                Nothing
+
+                            else
+                                Just ensureArg
+
+                        mismatchedArgs =
+                            List.map2 checkArg ensureArgs expectArgs
+                                |> List.filterMap identity
+                    in
+                    if List.isEmpty mismatchedArgs then
+                        []
+
+                    else
+                        [ Rule.error
+                            { message = "ensure" ++ name ++ " should take the same arguments as expect" ++ name
+                            , details =
+                                [ "Assuming the type annotation for expect" ++ name ++ " is correct, the type annotation for ensure" ++ name ++ " should be:"
+                                , String.join " -> "
+                                    (List.map typeAnnotationToString expectArgs
+                                        ++ [ "ProgramTest msg model effect -> ProgramTest msg model effect" ]
+                                    )
+                                ]
+                            }
+                            (Range.combine <| List.map Node.range mismatchedArgs)
+                        ]
+
+                Nothing ->
+                    [ Rule.error
+                        { message = "ensure" ++ name ++ " must have a corresponding expect" ++ name ++ " function"
+                        , details =
+                            [ "The type for expect" ++ name ++ " should be:"
+                            , String.join " -> "
+                                (List.map typeAnnotationToString ensureArgs
+                                    ++ [ "ProgramTest msg model effect -> Expectation" ]
+                                )
+                            ]
+                        }
+                        (Node.range functionName)
+                    ]
+
+        Just ( name, functionName, Err NoTypeAnnotation ) ->
+            [ Rule.error
+                { message = Node.value functionName ++ " must have a type annotation"
+                , details =
+                    [ "Assuming the type annotation for expect" ++ name ++ " is correct, the type annotation for ensure" ++ name ++ " should be:"
+                    , "String -> ProgramTest msg model effect -> ProgramTest msg model effect"
+                    ]
+                }
+                (Node.range functionName)
+            ]
+
+        _ ->
+            -- TODO: report that ensure* must be a function
+            []
+    , context
+    )

review/src/ReviewConfig.elm

@@ -0,0 +1,26 @@
+module ReviewConfig exposing (config)
+
+{-| Do not rename the ReviewConfig module or the config function, because
+`elm-review` will look for these.
+
+To add packages that contain rules, add them to this review project using
+
+    `elm install author/packagename`
+
+when inside the directory containing this file.
+
+-}
+
+import ExpectEnsurePairsMatch
+import NoDebug.Log
+import NoDebug.TodoOrToString
+import Review.Rule as Rule exposing (Rule)
+
+
+config : List Rule
+config =
+    [ ExpectEnsurePairsMatch.rule
+    , NoDebug.Log.rule
+    , NoDebug.TodoOrToString.rule
+        |> Rule.ignoreErrorsForDirectories [ "tests/" ]
+    ]