Proposal for tagging mechanism

.gitignore

@@ -2,4 +2,5 @@ elm-stuff
 bin/*.js
 src/main.js
 *analysis.json
+*tags.json
 node_modules

bin/check_files.sh

@@ -37,13 +37,30 @@ function main {
     exit 1
   fi
 
-  jq -S . ${exercise}/expected_analysis.json > /tmp/expected.json
-  jq -S . ${exercise}/analysis.json > /tmp/actual.json
+  jq -S '.comments |= sort' ${exercise}/expected_analysis.json > /tmp/expected.json
+  jq -S '.comments |= sort' ${exercise}/analysis.json > /tmp/actual.json
   if ! diff /tmp/expected.json /tmp/actual.json ;then
     echo "🔥 ${exercise}: expected ${exercise}/analysis.json to equal ${exercise}/expected_analysis.json on successful run 🔥"
     exit 1
   fi
 
+  if [[ ! -f "${exercise}/expected_tags.json" ]]; then
+    echo "🔥 ${exercise}: expected expected_tags.json to exist 🔥"
+    exit 1
+  fi
+
+  if [[ ! -f "${exercise}/tags.json" ]]; then
+    echo "🔥 ${exercise}: expected tags.json to exist on successful run 🔥"
+    exit 1
+  fi
+
+  jq -S 'sort' ${exercise}/expected_tags.json > /tmp/expected.json
+  jq -S 'sort' ${exercise}/tags.json > /tmp/actual.json
+  if ! diff /tmp/expected.json /tmp/actual.json ;then
+    echo "🔥 ${exercise}: expected ${exercise}/tags.json to equal ${exercise}/expected_tags.json on successful run 🔥"
+    exit 1
+  fi
+
   echo "🏁 ${exercise}: expected files present and correct after successful run 🏁"
 }
 

bin/run.sh

@@ -10,6 +10,7 @@ set -o pipefail # Catch failures in pipes.
 # Remove trailing slash for elm-review
 INPUT_DIR=${2%/}
 OUTPUT_DIR=${3%/}
+OUTPUT_TAGS=${4:-false}
 
 # Check if script running in docker
 if [ -f solution_cache.tar ]; then
@@ -20,14 +21,24 @@ if [ -f solution_cache.tar ]; then
     INPUT_DIR=/tmp/sol
 fi
 
-# Run analysis
 # Temporarily disable -e mode
 set +e
+
+# Run analysis
 npx elm-review $INPUT_DIR \
         --elmjson $INPUT_DIR/elm.json \
         --config . \
         --report=json \
-  | node ./bin/cli.js > $OUTPUT_DIR/analysis.json
+        --extract \
+  > /tmp/elm-review-report.json
 set -e
 
+# Output comments
+cat /tmp/elm-review-report.json | node ./bin/cli.js > $OUTPUT_DIR/analysis.json
+
+if [ $OUTPUT_TAGS = "--tags" ]; then
+  # Output tags
+  jq '.extracts | to_entries | map(.value) | add | sort' /tmp/elm-review-report.json > $OUTPUT_DIR/tags.json
+fi
+
 echo Finished

bin/smoke_test.sh

@@ -8,7 +8,7 @@ set -o pipefail # Catch failures in pipes.
 for solution in test_data/*/* ; do
   slug=$(basename $(dirname $solution))
   # run analysis
-  bin/run.sh $slug $solution $solution
+  bin/run.sh $slug $solution $solution --tags > /dev/null
   # check result
   bin/check_files.sh $solution
 done

src/ElmSyntaxHelpers.elm

@@ -1,5 +1,6 @@
-module ElmSyntaxHelpers exposing (hasGenericRecord, traversePattern, typeAnnotationsMatch)
+module ElmSyntaxHelpers exposing (hasDestructuringPattern, hasGenericRecord, hasTyped, traversePattern, typeAnnotationsMatch)
 
+import Elm.Syntax.ModuleName exposing (ModuleName)
 import Elm.Syntax.Node as Node exposing (Node(..))
 import Elm.Syntax.Pattern exposing (Pattern(..))
 import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..))
@@ -76,6 +77,61 @@ hasGenericRecord annotation =
             False
 
 
+hasTyped : ModuleName -> String -> Node TypeAnnotation -> Bool
+hasTyped moduleName name annotation =
+    case Node.value annotation of
+        Typed (Node _ ( typeModule, typeName )) annotations ->
+            (typeModule == moduleName && typeName == name)
+                || List.any (hasTyped moduleName name) annotations
+
+        Record recordFields ->
+            recordFields
+                |> List.map (Node.value >> Tuple.second)
+                |> List.any (hasTyped moduleName name)
+
+        GenericRecord _ (Node _ recordFields) ->
+            recordFields
+                |> List.map (Node.value >> Tuple.second)
+                |> List.any (hasTyped moduleName name)
+
+        Tupled annotations ->
+            List.any (hasTyped moduleName name) annotations
+
+        FunctionTypeAnnotation a b ->
+            hasTyped moduleName name a || hasTyped moduleName name b
+
+        GenericType _ ->
+            False
+
+        Unit ->
+            False
+
+
+hasDestructuringPattern : Node Pattern -> Bool
+hasDestructuringPattern fullPattern =
+    let
+        destructuringPattern pattern =
+            case Node.value pattern of
+                RecordPattern _ ->
+                    True
+
+                UnConsPattern _ _ ->
+                    True
+
+                TuplePattern _ ->
+                    True
+
+                NamedPattern _ _ ->
+                    True
+
+                _ ->
+                    False
+    in
+    fullPattern
+        |> traversePattern
+        |> List.any destructuringPattern
+
+
 traversePattern : Node Pattern -> List (Node Pattern)
 traversePattern pattern =
     case Node.value pattern of

src/ReviewConfig.elm

@@ -25,12 +25,16 @@ import Exercise.ValentinesDay
 import Exercise.ZebraPuzzle
 import Review.Rule as Rule exposing (Rule)
 import RuleConfig exposing (RuleConfig)
+import Tags
 
 
 ruleConfigs : List RuleConfig
 ruleConfigs =
-    [ -- Common Rules
-      Common.NoUnused.ruleConfig
+    [ -- Tags
+      Tags.ruleConfig
+
+    -- Common Rules
+    , Common.NoUnused.ruleConfig
     , Common.Simplify.ruleConfig
     , Common.NoDebug.ruleConfig
     , Common.UseCamelCase.ruleConfig

src/RuleConfig.elm

@@ -14,6 +14,7 @@ type alias RuleConfig =
 type AnalyzerRule
     = CustomRule (Comment -> Rule) Comment
     | ImportedRule Rule (Comment -> Decoder Comment) Comment
+    | TagRule Rule
 
 
 analyzerRuleToRule : AnalyzerRule -> Rule
@@ -25,6 +26,9 @@ analyzerRuleToRule analyzerRule =
         ImportedRule rule _ _ ->
             rule
 
+        TagRule rule ->
+            rule
+
 
 analyzerRuleToDecoder : AnalyzerRule -> Maybe (Decoder Comment)
 analyzerRuleToDecoder analyzerRule =
@@ -35,15 +39,21 @@ analyzerRuleToDecoder analyzerRule =
         ImportedRule _ toDecoder comment ->
             Just (toDecoder comment)
 
+        TagRule _ ->
+            Nothing
+
 
-analyzerRuleToComment : AnalyzerRule -> Comment
+analyzerRuleToComment : AnalyzerRule -> Maybe Comment
 analyzerRuleToComment analyzerRule =
     case analyzerRule of
         CustomRule _ comment ->
-            comment
+            Just comment
 
         ImportedRule _ _ comment ->
-            comment
+            Just comment
+
+        TagRule _ ->
+            Nothing
 
 
 getRules : RuleConfig -> List Rule
@@ -63,7 +73,7 @@ getDecoders =
 
 getComments : List RuleConfig -> List Comment
 getComments =
-    List.concatMap (.rules >> List.map analyzerRuleToComment)
+    List.concatMap (.rules >> List.filterMap analyzerRuleToComment)
 
 
 makeConfig : List RuleConfig -> List Rule