Fix error message parsing to import types

Fix error message parsing to enable HsImport plugin to
import Types.
Moreover, fix generation of Code Actions to avoid cases
where the same Code Action was displayed multiple times.

Author: fendor

hie-plugin-api/Haskell/Ide/Engine/Cradle.hs

@@ -786,22 +786,22 @@ isFilePathPrefixOf dir fp = isJust $ stripFilePath dir fp
 --
 -- >>> stripFilePath "app" "app/File.hs"
 -- Just "File.hs"
-
+--
 -- >>> stripFilePath "src" "app/File.hs"
 -- Nothing
-
+--
 -- >>> stripFilePath "src" "src-dir/File.hs"
 -- Nothing
-
+--
 -- >>> stripFilePath "." "src/File.hs"
 -- Just "src/File.hs"
-
+--
 -- >>> stripFilePath "app/" "./app/Lib/File.hs"
 -- Just "Lib/File.hs"
-
+--
 -- >>> stripFilePath "/app/" "./app/Lib/File.hs"
 -- Nothing -- Nothing since '/app/' is absolute
-
+--
 -- >>> stripFilePath "/app" "/app/Lib/File.hs"
 -- Just "Lib/File.hs"
 stripFilePath :: FilePath -> FilePath -> Maybe FilePath

src/Haskell/Ide/Engine/Plugin/HsImport.hs

@@ -339,7 +339,7 @@ codeActionProvider plId docId _ context = do
   importModuleAction
     :: SearchStyle -> ImportDiagnostic -> ModuleName -> SymbolName -> IdeM [J.CodeAction]
   importModuleAction searchStyle impDiagnostic moduleName symbolTerm =
-    catMaybes <$> sequenceA codeActions
+    catMaybes <$> sequenceA importListActions
     where
       importListActions :: [IdeM (Maybe J.CodeAction)]
       importListActions = case searchStyle of
@@ -353,34 +353,42 @@ codeActionProvider plId docId _ context = do
             -- If the term to import is a simple symbol, such as a function,
             -- import only this function
             Symbol
-              -> [ mkImportAction moduleName impDiagnostic . Just . Only
+              -> [ Just importModuleCodeAction
+                 , mkImportAction moduleName impDiagnostic . Just . Only
                      <$> symName symbolTerm
-                ]
+                 ]
             -- Constructors can be imported in two ways, either all
             -- constructors of a type or only a subset.
             -- We can only import a single constructor at a time though.
             Constructor
-              -> [ mkImportAction moduleName impDiagnostic . Just . AllOf
-                     <$> datatypeName symbolTerm
-                 , (\dt sym -> mkImportAction moduleName impDiagnostic . Just
-                    $ OneOf dt sym)
-                     <$> datatypeName symbolTerm
-                     <*> symName symbolTerm
-                 ]
+              -> case typeDeclaration symbolTerm of
+                -- If the symbolTerm is actually a data declaration
+                -- dont generate code actions for them.
+                Just _ -> []
+                Nothing ->
+                  [ Just importModuleCodeAction
+                  , mkImportAction moduleName impDiagnostic . Just . AllOf
+                      <$> datatypeName symbolTerm
+                  , (\dt sym -> mkImportAction moduleName impDiagnostic . Just
+                      $ OneOf dt sym)
+                      <$> datatypeName symbolTerm
+                      <*> symName symbolTerm
+                  ]
             -- If we are looking for a type, import it as just a symbol
             Type
-              -> [ mkImportAction moduleName impDiagnostic . Just . Only
-                     <$> symName symbolTerm]
-
-      -- | All code actions that may be available
-      -- Currently, omits all
-      codeActions :: [IdeM (Maybe J.CodeAction)]
-      codeActions = case termType impDiagnostic of
-        Hiding _ -> [] {- If we are hiding an import, we can not import
-                          a module hiding everything from it. -}
-                    -- Simple import, import the whole module
-        Import _ -> [mkImportAction moduleName impDiagnostic Nothing]
-        ++ importListActions
+              -> case typeDeclaration symbolTerm of
+                Nothing -> []
+                -- Only generate code actions,
+                -- if the symbolTerm is actually a data declaration
+                Just dataTerm ->
+                  [ Just importModuleCodeAction
+                  , Just $ mkImportAction moduleName impDiagnostic (Just $ Only dataTerm)
+                  , Just $ mkImportAction moduleName impDiagnostic (Just $ AllOf dataTerm)
+                  ]
+
+      -- | Plain Code Action to import the given module as a whole.
+      importModuleCodeAction :: IdeM (Maybe J.CodeAction)
+      importModuleCodeAction = mkImportAction moduleName impDiagnostic Nothing
 
       -- | Retrieve the function signature of a term such as
       -- >>> signatureOf "take :: Int -> [a] -> [a]"
@@ -391,6 +399,40 @@ codeActionProvider plId docId _ context = do
         typeSig <- S.tailMay parts
         S.headMay typeSig
 
+      -- | Given a term 'data Sum f g a', extract the name of the type 'Sum'.
+      --
+      -- Can be used to obtain the Type name.
+      -- Can also be used to check whether the given term is from the
+      -- Type level or Value level.
+      -- Constructors and Types are sometimes indistinguishable,
+      -- e.g. querying for 'Sum', possible results include:
+      --
+      -- * "data Sum f g a"
+      -- * "Sum :: a -> Sum a"
+      --
+      -- Depending on whether we are looking for a Type or Value,
+      -- we want to generate different Code Actions.
+      -- Important to generate the correct Code Actions.
+      --
+      -- >>> typeDeclaration "data Sum f g a"
+      -- Just "Sum"
+      --
+      -- >>> typeDeclaration "Sum :: Int -> Sum a"
+      -- Nothing
+      typeDeclaration :: T.Text -> Maybe T.Text
+      typeDeclaration arg = do
+        let parts = T.words arg
+        case parts of
+          declaration : typeName : _typeArgs
+            | declaration `elem` typeDeclarations ->
+              Just typeName
+          _ ->
+              Nothing
+
+      -- | Declarations for types in the Haskell language.
+      typeDeclarations :: [T.Text]
+      typeDeclarations = ["data", "newtype", "type"]
+
       -- | Retrieve the datatype name of a Constructor.
       --
       -- >>> datatypeName "Null :: Data.Aeson.Internal.Types.Value"
@@ -492,13 +534,13 @@ extractImportableTerm dirtyMsg = do
     extractTerm prefix symTy =
       importMsg
           >>= T.stripPrefix prefix
+          >>= Just . Hie.extractTerm' . T.strip
           >>= \name -> Just (name, Import symTy)
 
-    extractType b =
-      extractTerm ("Not in scope: type constructor or class " <> b) Type
+    extractType =
+      extractTerm "Not in scope: type constructor or class" Type
 
     extractedTerm = asum
       [ extractTerm "Variable not in scope: " Symbol
-      , extractType "‘"
-      , extractType "`" -- Needed for windows
+      , extractType
       , extractTerm "Data constructor not in scope: " Constructor]

src/Haskell/Ide/Engine/Support/HieExtras.hs

@@ -14,6 +14,7 @@ module Haskell.Ide.Engine.Support.HieExtras
   , getReferencesInDoc
   , getModule
   , extractTerm
+  , extractTerm'
   , findDef
   , findTypeDef
   , showName
@@ -239,6 +240,21 @@ extractTerm txt =
                     . T.dropWhileEnd (== e)
                     . T.dropAround (\c -> c /= b && c /= e)
 
+-- | Extract a term from a compiler message.
+-- Removes whitespace and tries to extract a message between '‘' and '’' falling back to '`' and '\''
+-- (the used ones in Windows systems).
+-- Different to @extractTerm@, it does not require that the term is actually surrounded
+-- and can be used to sanitize the input.
+extractTerm' :: T.Text -> T.Text
+extractTerm' txt =
+  case extract '‘' '’' txt of
+    ""  -> extract '`' '\'' txt -- Needed for windows
+    term -> term
+  where extract b e = T.dropWhile (== b)
+                    . T.dropWhileEnd (== e)
+                    . T.strip
+
+
 -- ---------------------------------------------------------------------
 
 -- | Return the type definition of the symbol at the given position.

src/Haskell/Ide/Engine/Support/Hoogle.hs

@@ -11,7 +11,7 @@ import           Data.Aeson
 import           Data.Bifunctor
 import           Data.Maybe
 import qualified Data.Text                          as T
-import Data.List
+import           Data.List
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.MonadFunctions
 import           Hoogle