Fix bugs in UndesirableFunctions, add more tests

Author: fsoikin

dist/npm/package.json

@@ -1,6 +1,6 @@
 {
   "name": "whine",
-  "version": "0.0.26",
+  "version": "0.0.27",
   "description": "PureScript linter, extensible, with configurable rules, and one-off escape hatches",
   "keywords": ["purescript", "lint"],
   "author": "Fyodor Soikin <name.fa@gmail.com>",

dist/vscode-extension/package.json

@@ -3,7 +3,7 @@
   "publisher": "collegevine",
   "displayName": "Whine at PureScript",
   "description": "PureScript linter, extensible, with configurable rules, and one-off escape hatches",
-  "version": "0.0.26",
+  "version": "0.0.27",
   "repository": "https://github.com/collegevine/purescript-whine",
   "engines": {
     "vscode": "^1.95.0"

spago.yaml

@@ -51,7 +51,7 @@ package:
     dependencies:
       - spec-node
   publish:
-    version: 0.0.26
+    version: 0.0.27
     license: MIT
     location:
       githubOwner: collegevine

src/Whine/Core/UndesirableFunctions.purs

@@ -24,6 +24,7 @@ import Data.Map as Map
 import Data.String as String
 import PureScript.CST.Range (rangeOf)
 import PureScript.CST.Types (Expr(..), Ident(..), Import(..), ImportDecl(..), Module(..), ModuleHeader(..), ModuleName, Name(..), Operator(..), QualifiedName(..), Separated(..), Wrapped(..))
+import Whine.Log (logDebug)
 import Whine.Types (Handle(..), Rule, currentModule, emptyRule, reportViolation)
 
 -- Config for this rule is a two-level map: first level is names of functions
@@ -58,10 +59,15 @@ rule badFunctions = emptyRule { onExpr = onExpr }
       e@(ExprIdent (QualifiedName { name: Ident function, module: mod }))
         | Just mods <- Map.lookup { function } badFunctions -> -- This function is on the list of undesirables.
             currentModule \m -> do
+              logDebug $ "Checking " <> function <> " from " <> show (unwrap <$> mod)
+              logDebug $ "Modules: " <> show ((lmap $ map unwrap) <$> Map.toUnfoldable mods :: Array _)
               let report message = reportViolation { source: Just $ rangeOf e, message }
-                  importedFrom = explicitOrQualifiedImport m mod function <|> loneOpenImport m
+                  importedFrom = qualifiedImport m mod <|> explicitImport m function <|> loneOpenImport m
+              logDebug $ "Imported from " <> show (unwrap <$> importedFrom)
               case importedFrom of
                 Just imprt -> do -- Found whence this function is imported.
+                  logDebug $ "Explicit message: " <> show (Map.lookup (Just imprt) mods)
+                  logDebug $ "Module-agnostic message: " <> show (Map.lookup Nothing mods)
                   let message =
                         Map.lookup (Just imprt) mods -- See if we have a message for this specific import.
                         <|> Map.lookup Nothing mods -- If not, see if we have a module-agnostic message for this function.
@@ -74,16 +80,22 @@ rule badFunctions = emptyRule { onExpr = onExpr }
       _ -> do
         pure unit
 
-    -- Look through imports in the header of the module and find one that either
-    -- (1) is qualified with the given qualifier `mod` or (2) lists the given
-    -- identifier `ident` among imported values or operators.
-    explicitOrQualifiedImport :: ∀ e. Module e -> Maybe ModuleName -> String -> Maybe ModuleName
-    explicitOrQualifiedImport (Module { header: ModuleHeader { imports } }) mod ident =
+    -- Look through imports in the header of the module and find one that is
+    -- qualified with the given qualifier `mod`
+    qualifiedImport :: ∀ e. Module e -> Maybe ModuleName -> Maybe ModuleName
+    qualifiedImport _ Nothing = Nothing
+    qualifiedImport (Module { header: ModuleHeader { imports } }) (Just mod) =
+      imports # findMap \(ImportDecl i@{ module: Name { name } }) -> case i of
+        { qualified: Just (_ /\ Name { name: qualifier }) } | qualifier == mod ->
+          Just name
+        _ ->
+          Nothing
+
+    -- Look through imports in the header of the module and find one that lists
+    -- the given identifier `ident` among imported values or operators.
+    explicitImport :: ∀ e. Module e -> String -> Maybe ModuleName
+    explicitImport (Module { header: ModuleHeader { imports } }) ident =
       imports # findMap \(ImportDecl i@{ module: Name { name } }) -> case i of
-        { qualified: Just (_ /\ Name { name: qualifier }) }
-          | Just qualifier == mod
-          ->
-            Just name
         { names: Just (_ /\ (Wrapped { value: Separated { head, tail } })) }
           | sameIdentifier head || any (sameIdentifier <<< snd) tail
           ->
@@ -131,7 +143,7 @@ codec =
       }
 
     foldMaps :: { functions :: Map String String } -> Args
-    foldMaps mm = Map.unions do
+    foldMaps mm = foldl (Map.unionWith Map.union) Map.empty do
       maybeQualifiedFunction /\ message <- (Map.toUnfoldable mm.functions :: Array _)
       let mod /\ function = fromQualified maybeQualifiedFunction
       pure $ Map.singleton { function } $ Map.singleton mod message

test/Core/UndesirableFunctions.purs

@@ -2,7 +2,12 @@ module Test.Core.UndesirableFunctions where
 
 import Test.Prelude
 
+import Codec.JSON.DecodeError as DecodeError
+import Control.Monad.Error.Class (throwError)
+import Data.Codec.JSON as CJ
 import Data.Map as Map
+import Effect.Exception (error)
+import JSON as JSON
 import PureScript.CST.Types (ModuleName(..))
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
@@ -14,9 +19,9 @@ spec = describe "UndesirableFunctions" do
 
   it "Reports bad functions" $
     hasViolations
-      [ "4:5-4:8" /\ "Do not use fn1"
-      , "5:4-5:7" /\ "Do not use fn2 from Bad.Module"
-      , "6:4-6:7" /\ "Do not use fn3 from Bad.Module"
+      [ "4:5-4:8 Do not use fn1"
+      , "5:4-5:7 Do not use fn2 from Bad.Module"
+      , "6:4-6:7 Do not use fn3 from Bad.Module"
       ]
       """
         import Some (fn1)
@@ -29,13 +34,13 @@ spec = describe "UndesirableFunctions" do
       """
 
   it "Falls back to unqualified message when there is no matching import" do
-    hasViolations ["1:6-1:9" /\ "Do not use fn3"] """
+    hasViolations ["1:6-1:9 Do not use fn3"] """
       import Some (fn3)
       x = y fn3
     """
 
   it "Assumes open-imported module if there is only one" do
-    hasViolations ["2:6-2:9" /\ "Do not use fn3 from Bad.Module"] """
+    hasViolations ["2:6-2:9 Do not use fn3 from Bad.Module"] """
       import Bad.Module
       import Another.Module (fn2)
       x = y fn3
@@ -49,7 +54,7 @@ spec = describe "UndesirableFunctions" do
     """
 
   it "Falls back to unqualified message when the import is open" do
-    hasViolations ["1:6-1:9" /\ "Do not use fn3"] """
+    hasViolations ["1:6-1:9 Do not use fn3"] """
       import Some
       x = y fn3
     """
@@ -62,8 +67,8 @@ spec = describe "UndesirableFunctions" do
 
   it "Reports when imported with a qualifier" do
     hasViolations
-      [ "2:6-2:13" /\ "Do not use fn2 from Bad.Module"
-      , "3:6-3:13" /\ "Do not use fn3 from Bad.Module"
+      [ "2:6-2:13 Do not use fn2 from Bad.Module"
+      , "3:6-3:13 Do not use fn3 from Bad.Module"
       ]
       """
         import Bad.Module as FN2
@@ -72,6 +77,18 @@ spec = describe "UndesirableFunctions" do
         y = z FN3.fn3
       """
 
+  it "Picks correct message according to the import" do
+    hasViolations
+      [ "2:6-2:9 Do not use fn2 from Bad.Module"
+      , "3:6-3:12 Do not use fn2 from Another.Module"
+      ]
+      """
+        import Bad.Module (fn2)
+        import Another.Module as AM
+        x = y fn2
+        y = z AM.fn2
+      """
+
   it "Allows imports from other modules" do
     hasViolations [] """
       import Innocent.Module (fn2)
@@ -83,7 +100,43 @@ spec = describe "UndesirableFunctions" do
       x = y IM.fn2
     """
 
+  describe "Config parsing" do
+    it "parses correctly" do
+      json <- unsafeRight $ JSON.parse """
+        {
+          "functions": {
+            "fn1": "Do not use fn1",
+            "Bad.fn1": "Do not use fn1 from Bad",
+            "Bad.Module.fn1": "Do not use fn1 from Bad.Module",
+            "Bad.fn2": "Do not use fn2 from Bad",
+            "Bad.Module.fn2": "Do not use fn2 from Bad.Module"
+          }
+        }
+      """
+
+      parsed <- unsafeRight $ lmap DecodeError.print $
+        CJ.decode UndesirableFunctions.codec json
+        <#> Map.toUnfoldable
+        <#> map \({ function } /\ m) ->
+                  function /\ (Map.toUnfoldable m <#> \(mn /\ msg) -> (unwrap <$> mn) /\ msg)
+
+      parsed `shouldEqual`
+        [ "fn1" /\
+            [ Nothing /\ "Do not use fn1"
+            , Just "Bad" /\ "Do not use fn1 from Bad"
+            , Just "Bad.Module" /\ "Do not use fn1 from Bad.Module"
+            ]
+        , "fn2" /\
+            [ Just "Bad" /\ "Do not use fn2 from Bad"
+            , Just "Bad.Module" /\ "Do not use fn2 from Bad.Module"
+            ]
+        ]
   where
+    unsafeRight :: ∀ a. Either String a -> _ a
+    unsafeRight = case _ of
+      Left e -> throwError $ error $ "Failed to parse config: " <> e
+      Right a -> pure a
+
     config = Map.fromFoldable
       [ { function: "fn1" } /\ Map.singleton
           Nothing "Do not use fn1"
@@ -102,5 +155,5 @@ spec = describe "UndesirableFunctions" do
         { rule: UndesirableFunctions.rule config
         , module: mod
         }
-      <#> map (\v -> fromMaybe "" (formatRange <$> v.source) /\ v.message)
+      <#> map (\v -> fromMaybe "" (formatRange <$> v.source) <> " " <> v.message)
       >>= shouldEqual vs