Add unit tests for code action utilities

haskell · Nov 19, 2022 · 996d6a1 · 996d6a1
1 parent fcd4bff
commit 996d6a1
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 12 deletions.
diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal
@@ -70,6 +70,7 @@ test-suite tests
   main-is:          Main.hs
   build-depends:
     , base
+    , bytestring
     , filepath
     , ghcide
     , hls-cabal-plugin

diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TupleSections         #-}
-{-# LANGUAGE OverloadedStrings         #-}
 module Ide.Plugin.Cabal.Diagnostics
 ( errorDiagnostic
 , warningDiagnostic

diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs
@@ -33,7 +33,7 @@ licenseErrorAction
   -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
   -> Maybe CodeAction
 licenseErrorAction uri diag =
-  mkCodeAction <$> licenseErrorSuggestion diag
+  mkCodeAction <$> licenseErrorSuggestion (_message diag)
   where
     mkCodeAction (original, suggestion) =
       let
@@ -52,17 +52,17 @@ licenseErrorAction uri diag =
         edit  = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing
       in CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing
 
--- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
+-- | Given an error message returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
 --   if it represents an "Unknown SPDX license identifier"-error along
 --   with a suggestion then return the suggestion (after the "Do you mean"-text)
 --   along with the incorrect identifier.
 licenseErrorSuggestion
-  :: Diagnostic
+  :: T.Text
   -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
   -> Maybe (T.Text, T.Text)
   -- ^ (Original (incorrect) license identifier, suggested replacement)
-licenseErrorSuggestion diag =
-  mSuggestion (_message diag) >>= \case
+licenseErrorSuggestion message =
+  mSuggestion message >>= \case
     [original, suggestion] -> Just (original, suggestion)
     _                      -> Nothing
   where

diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs
@@ -5,17 +5,19 @@ module Main
   ( main
   ) where
 
-import           Control.Lens                 ((^.))
-import           Data.Either                  (isRight)
+import           Control.Lens                    ((^.))
+import qualified Data.ByteString                 as BS
+import           Data.Either                     (isRight)
 import           Data.Function
-import qualified Data.Text                    as Text
+import qualified Data.Text                       as Text
 import           Development.IDE.Types.Logger
 import           Ide.Plugin.Cabal
-import qualified Ide.Plugin.Cabal.Parse       as Lib
-import qualified Language.LSP.Types.Lens      as J
+import           Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
+import qualified Ide.Plugin.Cabal.Parse          as Lib
+import qualified Language.LSP.Types.Lens         as J
 import           System.FilePath
 import           Test.Hls
-import qualified Data.ByteString as BS
+
 
 cabalPlugin :: Recorder (WithPriority Log) -> PluginDescriptor IdeState
 cabalPlugin recorder = descriptor recorder "cabal"
@@ -51,13 +53,33 @@ initialiseRecorder False = do
 unitTests :: TestTree
 unitTests =
   testGroup "Unit Tests"
+  [ cabalParserUnitTests,
+    codeActionUnitTests
+  ]
+
+cabalParserUnitTests :: TestTree
+cabalParserUnitTests = testGroup "Parsing Cabal"
   [ testCase "Simple Parsing works" $ do
       (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir </> "simple.cabal")
       liftIO $ do
         null warnings @? "Found unexpected warnings"
         isRight pm @? "Failed to parse GenericPackageDescription"
   ]
 
+codeActionUnitTests :: TestTree
+codeActionUnitTests = testGroup "Code Action Tests"
+  [ testCase "Unknown format" $ do
+      -- the message has the wrong format
+      licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Nothing,
+
+    testCase "BSD-3-Clause" $ do
+      licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= Just ("BSD3", "BSD-3-Clause"),
+
+    testCase "MIT" $ do
+      -- contains no suggestion
+      licenseErrorSuggestion "Unknown SPDX license identifier: 'MIT3'" @?= Nothing
+  ]
+
 -- ------------------------------------------------------------------------
 -- Integration Tests
 -- ------------------------------------------------------------------------