diff --git a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs index 2dd279ab1..eea4e2fca 100644 --- a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs +++ b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Haskell.Ide.Engine.Plugin.Hoogle where @@ -5,6 +6,7 @@ module Haskell.Ide.Engine.Plugin.Hoogle where import Control.Monad.IO.Class import Control.Monad (join) import Control.Exception +import Control.Applicative (liftA2) import Data.Aeson import Data.Bifunctor import Data.Maybe @@ -44,10 +46,10 @@ hoogleDescriptor plId = PluginDescriptor -- --------------------------------------------------------------------- -data HoogleError +data HoogleError = NoDb | DbFail T.Text - | NoResults + | NoResults deriving (Eq,Ord,Show) newtype HoogleDb = HoogleDb (Maybe FilePath) @@ -152,7 +154,28 @@ renderTarget t = T.intercalate "\n" $ -- If an error occurs, such as no hoogle database has been found, -- or the search term has no match, an empty list will be returned. searchModules :: T.Text -> IdeM [T.Text] -searchModules = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targetModule) +searchModules = fmap (map fst) . searchModules' + +-- | Just like 'searchModules', but includes the signature of the search term +-- that has been found in the module. +searchModules' :: T.Text -> IdeM [(T.Text, T.Text)] +searchModules' = fmap (take 5 . nub) . searchTargets retrieveModuleAndSignature + where + -- | Hoogle results contain html like tags. + -- We remove them with `tagsoup` here. + -- So, if something hoogle related shows html tags, + -- then maybe this function is responsible. + normaliseItem :: T.Text -> T.Text + normaliseItem = innerText . parseTags + + retrieveModuleAndSignature :: Target -> Maybe (T.Text, T.Text) + retrieveModuleAndSignature target = liftA2 (,) (packModuleName target) (packSymbolSignature target) + + packModuleName :: Target -> Maybe T.Text + packModuleName = fmap (T.pack . fst) . targetModule + + packSymbolSignature :: Target -> Maybe T.Text + packSymbolSignature = Just . normaliseItem . T.pack . targetItem -- | Search for packages that satisfy the given search text. -- Will return at most five, unique results. @@ -160,7 +183,7 @@ searchModules = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targe -- If an error occurs, such as no hoogle database has been found, -- or the search term has no match, an empty list will be returned. searchPackages :: T.Text -> IdeM [T.Text] -searchPackages = fmap (nub . take 5) . searchTargets (fmap (T.pack . fst) . targetPackage) +searchPackages = fmap (take 5 . nub) . searchTargets (fmap (T.pack . fst) . targetPackage) -- | Search for Targets that fit to the given Text and satisfy the given predicate. -- Limits the amount of matches to at most ten. diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs index 1737e66f9..ea28eef27 100644 --- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs +++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} module Haskell.Ide.Engine.Plugin.HsImport where @@ -9,8 +8,6 @@ import Control.Lens.Operators import Control.Monad.IO.Class import Control.Monad import Data.Aeson -import Data.Bitraversable -import Data.Bifunctor import Data.Foldable import Data.Maybe import Data.Monoid ( (<>) ) @@ -18,7 +15,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified GHC.Generics as Generics import qualified GhcModCore as GM ( mkRevRedirMapFunc, withMappedFile ) -import HsImport +import qualified HsImport import Haskell.Ide.Engine.Config import Haskell.Ide.Engine.MonadTypes import qualified Haskell.Ide.Engine.Support.HieExtras as Hie @@ -29,6 +26,7 @@ import qualified Haskell.Ide.Engine.Plugin.Hoogle as Hoogle import System.Directory import System.IO +import qualified Safe as S hsimportDescriptor :: PluginId -> PluginDescriptor hsimportDescriptor plId = PluginDescriptor @@ -43,19 +41,82 @@ hsimportDescriptor plId = PluginDescriptor , pluginFormattingProvider = Nothing } +-- | Type of the symbol to import. +-- Important to offer the correct import list, or hiding code action. +data SymbolType + = Symbol -- ^ Symbol is a simple function + | Constructor -- ^ Symbol is a constructor + | Type -- ^ Symbol is a type + deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) + + +-- | What of the symbol should be taken. +-- Import a simple symbol, or a value constructor. +data SymbolKind + = Only SymbolName -- ^ Only the symbol should be taken + | OneOf DatatypeName SymbolName -- ^ Some constructors or methods of the symbol should be taken: Symbol(X) + | AllOf DatatypeName -- ^ All constructors or methods of the symbol should be taken: Symbol(..) + deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) + +-- | Disambiguates between an import action and an hiding action. +-- Can be used to determine suggestion tpye from ghc-mod, +-- e.g. whether ghc-mod suggests to hide an identifier or to import an identifier. +-- Also important later, to know how the symbol shall be imported. +data SymbolImport a + = Import a -- ^ the symbol to import + | Hiding a -- ^ the symbol to hide from the import + deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) + + +-- | Utility to retrieve the contents of the 'SymbolImport'. +-- May never fail. +extractSymbolImport :: SymbolImport a -> a +extractSymbolImport (Hiding s) = s +extractSymbolImport (Import s) = s + +type ModuleName = T.Text +type SymbolName = T.Text +type DatatypeName = T.Text + +-- | Wrapper for a FilePath that is used as an Input file for HsImport +newtype InputFilePath = MkInputFilePath { getInput :: FilePath } + +-- | Wrapper for a FilePath that is used as an Output file for HsImport +newtype OutputFilePath = MkOutputFilePath { getOutput :: FilePath } + +-- | How to import a module. +-- Can be used to express to import a whole module or only specific symbols +-- from a module. +-- Is used to either hide symbols from an import or use an import-list to +-- import only a specific symbol. +data ImportStyle + = Simple -- ^ Import the whole module + | Complex (SymbolImport SymbolKind) -- ^ Complex operation, import module hiding symbols or import only selected symbols. + deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) + +-- | Contains information about the diagnostic, the symbol ghc-mod +-- complained about and what the kind of the symbol is and whether +-- to import or hide the symbol as suggested by ghc-mod. +data ImportDiagnostic = ImportDiagnostic + { diagnostic :: J.Diagnostic + , term :: SymbolName + , termType :: SymbolImport SymbolType + } + deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) + -- | Import Parameters for Modules. -- Can be used to import every symbol from a module, -- or to import only a specific function from a module. data ImportParams = ImportParams - { file :: Uri -- ^ Uri to the file to import the module to. - , addToImportList :: Maybe T.Text -- ^ If set, an import-list will be created. - , moduleToImport :: T.Text -- ^ Name of the module to import. + { file :: Uri -- ^ Uri to the file to import the module to. + , importStyle :: ImportStyle -- ^ How to import the module + , moduleToImport :: ModuleName -- ^ Name of the module to import. } deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) importCmd :: CommandFunc ImportParams J.WorkspaceEdit -importCmd = CmdSync $ \(ImportParams uri importList modName) -> - importModule uri importList modName +importCmd = CmdSync $ \(ImportParams uri style modName) -> + importModule uri style modName -- | Import the given module for the given file. -- May take an explicit function name to perform an import-list import. @@ -63,8 +124,8 @@ importCmd = CmdSync $ \(ImportParams uri importList modName) -> -- e.g. two consecutive imports for the same module will result in a single -- import line. importModule - :: Uri -> Maybe T.Text -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit) -importModule uri importList modName = + :: Uri -> ImportStyle -> ModuleName -> IdeGhcM (IdeResult J.WorkspaceEdit) +importModule uri impStyle modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do shouldFormat <- formatOnImportOn <$> getConfig fileMap <- GM.mkRevRedirMapFunc @@ -73,13 +134,13 @@ importModule uri importList modName = tmpDir <- liftIO getTemporaryDirectory (output, outputH) <- liftIO $ openTempFile tmpDir "hsimportOutput" liftIO $ hClose outputH - let args = defaultArgs { moduleName = T.unpack modName - , inputSrcFile = input - , symbolName = T.unpack $ fromMaybe "" importList - , outputSrcFile = output - } + let args = importStyleToHsImportArgs + (MkInputFilePath input) + (MkOutputFilePath output) + modName + impStyle -- execute hsimport on the given file and write into a temporary file. - maybeErr <- liftIO $ hsimportWithArgs defaultConfig args + maybeErr <- liftIO $ HsImport.hsimportWithArgs HsImport.defaultConfig args case maybeErr of Just err -> do liftIO $ removeFile output @@ -153,6 +214,49 @@ importModule uri importList modName = $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges) else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges) +-- | Convert the import style arguments into HsImport arguments. +-- Takes an input and an output file as well as a module name. +importStyleToHsImportArgs + :: InputFilePath -> OutputFilePath -> ModuleName -> ImportStyle -> HsImport.HsImportArgs +importStyleToHsImportArgs input output modName style = + let defaultArgs = -- Default args, must be set every time. + HsImport.defaultArgs { HsImport.moduleName = T.unpack modName + , HsImport.inputSrcFile = getInput input + , HsImport.outputSrcFile = getOutput output + } + + -- | Remove parenthesis for operators and infix operator cosntructors. + -- HsImport demands it. E.g. + -- > hsimport -m Data.Array.Repa -s :. -w :. + -- import Data.Array.Repa ((:.)((:.))) + -- + -- > hsimport -m Data.Function -s $ + -- import Data.Function (($)) + trimParenthesis :: T.Text -> T.Text + trimParenthesis = T.dropAround isParenthesis + + isParenthesis = (`elem` ['(', ')']) + + kindToArgs :: SymbolKind -> HsImport.HsImportArgs + kindToArgs kind = case kind of + -- Only import a single symbol e.g. Data.Text (isPrefixOf) + Only sym -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis sym } + -- Import a constructor e.g. Data.Mabye (Maybe(Just)) + OneOf dt sym -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis dt + , HsImport.with = [T.unpack $ trimParenthesis sym] + } + -- Import all constructors e.g. Data.Maybe (Maybe(..)) + AllOf dt -> defaultArgs { HsImport.symbolName = T.unpack $ trimParenthesis dt + , HsImport.all = True + } + in case style of + -- If the import style is simple, import thw whole module + Simple -> defaultArgs + Complex s -> case s of + Hiding kind -> kindToArgs kind {- TODO: wait for hsimport version bump -} + Import kind -> kindToArgs kind + + -- | Search style for Hoogle. -- Can be used to look either for the exact term, -- only the exact name or a relaxed form of the term. @@ -188,31 +292,26 @@ codeActionProvider plId docId _ context = do -- -- Result may produce several import actions, or none. importActionsForTerms - :: SearchStyle -> [(J.Diagnostic, T.Text)] -> IdeM [J.CodeAction] - importActionsForTerms style terms = do - let searchTerms = map (bimap id (applySearchStyle style)) terms - -- Get the function names for a nice import-list title. - let functionNames = map (head . T.words . snd) terms - searchResults' <- mapM (bimapM return Hoogle.searchModules) searchTerms - let searchResults = zip functionNames searchResults' - let normalise = - concatMap (\(a, b) -> zip (repeat a) (concatTerms b)) searchResults - - concat <$> mapM (uncurry (termToActions style)) normalise + :: SearchStyle -> [ImportDiagnostic] -> IdeM [J.CodeAction] + importActionsForTerms style importDiagnostics = do + let searchTerms = map (applySearchStyle style . term) importDiagnostics + searchResults <- mapM Hoogle.searchModules' searchTerms + let importTerms = zip searchResults importDiagnostics + concat <$> mapM (uncurry (termToActions style)) importTerms -- | Apply the search style to given term. -- Can be used to look for a term that matches exactly the search term, -- or one that matches only the exact name. -- At last, a custom relaxation function can be passed for more control. applySearchStyle :: SearchStyle -> T.Text -> T.Text - applySearchStyle Exact term = "is:exact " <> term - applySearchStyle ExactName term = case T.words term of - [] -> term + applySearchStyle Exact termName = "is:exact " <> termName + applySearchStyle ExactName termName = case T.words termName of + [] -> termName (x : _) -> "is:exact " <> x - applySearchStyle (Relax relax) term = relax term + applySearchStyle (Relax relax) termName = relax termName - -- | Turn a search term with function name into Import Actions. - -- Function name may be of only the exact phrase to import. + -- | Turn a search term with function name into an Import Actions. + -- The function name may be of only the exact phrase to import. -- The resulting CodeAction's contain a general import of a module or -- uses an Import-List. -- @@ -224,61 +323,177 @@ codeActionProvider plId docId _ context = do -- no import list can be offered, since the function name -- may be not the one we expect. termToActions - :: SearchStyle -> T.Text -> (J.Diagnostic, T.Text) -> IdeM [J.CodeAction] - termToActions style functionName (diagnostic, termName) = do - let useImportList = case style of - Relax _ -> Nothing - _ -> Just (mkImportAction (Just functionName) diagnostic termName) - catMaybes <$> sequenceA - (mkImportAction Nothing diagnostic termName : maybeToList useImportList) + :: SearchStyle -> [(ModuleName, SymbolName)] -> ImportDiagnostic -> IdeM [J.CodeAction] + termToActions style modules impDiagnostic = + concat <$> mapM (uncurry (importModuleAction style impDiagnostic)) modules + + -- | Creates various import actions for a module and the diagnostic. + -- Possible import actions depend on the type of the symbol to import. + -- It may be a 'Constructor', so the import actions need to be different + -- to a simple function symbol. + -- Thus, it may return zero, one or multiple import actions for a module. + -- List of import actions does contain no duplicates. + importModuleAction + :: SearchStyle -> ImportDiagnostic -> ModuleName -> SymbolName -> IdeM [J.CodeAction] + importModuleAction searchStyle impDiagnostic moduleName symbolTerm = + catMaybes <$> sequenceA codeActions + where + importListActions :: [IdeM (Maybe J.CodeAction)] + importListActions = case searchStyle of + -- If the search has been relaxed by a custom function, + -- we cant know how much the search query has been altered + -- and how close the result terms are to the initial diagnostic. + -- Thus, we cant offer more specific imports. + Relax _ -> [] + _ -> catMaybes + $ case extractSymbolImport $ termType impDiagnostic of + -- If the term to import is a simple symbol, such as a function, + -- import only this function + Symbol + -> [ 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 + ] + -- 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. -} + Import _ -> [mkImportAction moduleName impDiagnostic Nothing] + -- ^ Simple import, import the whole module + ++ importListActions + + -- | Retrieve the function signature of a term such as + -- >>> signatureOf "take :: Int -> [a] -> [a]" + -- Just " Int -> [a] -> [a]" + signatureOf :: T.Text -> Maybe T.Text + signatureOf sig = do + let parts = T.splitOn "::" sig + typeSig <- S.tailMay parts + S.headMay typeSig + + -- | Retrieve the datatype name of a Constructor. + -- + -- >>> datatypeName "Null :: Data.Aeson.Internal.Types.Value" + -- Just "Value" + -- + -- >>> datatypeName "take :: Int -> [a] -> [a]" -- Not a constructor + -- Just "[a]" + -- + -- >>> datatypeName "Just :: a -> Maybe a" + -- Just "Maybe" + -- + -- Thus, the result of this function only makes sense, + -- if the symbol kind of the diagnostic term is of type 'Constructor' + datatypeName :: T.Text -> Maybe T.Text + datatypeName sig = do + sig_ <- signatureOf sig + let sigParts = T.splitOn "->" sig_ + lastPart <- S.lastMay sigParts + let dtNameSig = T.words lastPart + qualifiedDtName <- S.headMay dtNameSig + let qualifiedDtNameParts = T.splitOn "." qualifiedDtName + S.lastMay qualifiedDtNameParts + + -- | Name of a symbol. May contain a function signature. + -- + -- >>> symName "take :: Int -> [a] -> [a]" + -- Just "take" + -- + -- >>> symName "take" + -- Just "take" + symName :: T.Text -> Maybe SymbolName + symName = S.headMay . T.words - concatTerms :: (a, [b]) -> [(a, b)] - concatTerms (a, b) = zip (repeat a) b --TODO: Check if package is already installed mkImportAction - :: Maybe T.Text -> J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction) - mkImportAction importList diag modName = do + :: ModuleName -> ImportDiagnostic -> Maybe SymbolKind -> IdeM (Maybe J.CodeAction) + mkImportAction modName importDiagnostic symbolType = do cmd <- mkLspCommand plId "import" title (Just cmdParams) return (Just (codeAction cmd)) - where + where codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) - (Just (J.List [diag])) + (Just (J.List [diagnostic importDiagnostic])) Nothing (Just cmd) - title = - "Import module " - <> modName - <> maybe "" (\name -> " (" <> name <> ")") importList - cmdParams = [toJSON (ImportParams (docId ^. J.uri) importList modName)] + title = "Import module " + <> modName + <> case termType importDiagnostic of + Hiding _ -> "hiding" + -- ^ Note, that it must never happen + -- in combination with `symbolType == Nothing` + Import _ -> "" + <> case symbolType of + Just s -> case s of + Only sym -> " (" <> sym <> ")" + AllOf dt -> " (" <> dt <> " (..))" + OneOf dt sym -> " (" <> dt <> " (" <> sym <> "))" + Nothing -> "" + + importStyleParam :: ImportStyle + importStyleParam = case symbolType of + Nothing -> Simple + Just k -> case termType importDiagnostic of + Hiding _ -> Complex (Hiding k) + Import _ -> Complex (Import k) + + cmdParams = [toJSON (ImportParams (docId ^. J.uri) importStyleParam modName)] -- | For a Diagnostic, get an associated function name. -- If Ghc-Mod can not find any candidates, Nothing is returned. - getImportables :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text) + getImportables :: J.Diagnostic -> Maybe ImportDiagnostic getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) = - (diag, ) <$> extractImportableTerm msg + uncurry (ImportDiagnostic diag) <$> extractImportableTerm msg getImportables _ = Nothing -- | Extract from an error message an appropriate term to search for. -- This looks at the error message and tries to extract the expected -- signature of an unknown function. -- If this is not possible, Nothing is returned. -extractImportableTerm :: T.Text -> Maybe T.Text -extractImportableTerm dirtyMsg = T.strip <$> asum - [ T.stripPrefix "Variable not in scope: " msg - , T.init <$> T.stripPrefix "Not in scope: type constructor or class ‘" msg - , T.stripPrefix "Data constructor not in scope: " msg - ] - where - msg = - head - -- Get rid of the rename suggestion parts +extractImportableTerm :: T.Text -> Maybe (T.Text, SymbolImport SymbolType) +extractImportableTerm dirtyMsg = do + (n, s) <- extractedTerm + let n' = T.strip n + return (n', s) + where + importMsg = S.headMay + -- Get rid of the rename suggestion parts $ T.splitOn "Perhaps you meant " $ T.replace "\n" " " - -- Get rid of trailing/leading whitespace on each individual line + -- Get rid of trailing/leading whitespace on each individual line $ T.unlines $ map T.strip $ T.lines $ T.replace "• " "" dirtyMsg + + extractedTerm = asum + [ importMsg + >>= T.stripPrefix "Variable not in scope: " + >>= \name -> Just (name, Import Symbol) + , importMsg + >>= T.stripPrefix "Not in scope: type constructor or class ‘" + >>= \name -> Just (T.init name, Import Type) + , importMsg + >>= T.stripPrefix "Data constructor not in scope: " + >>= \name -> Just (name, Import Constructor)] + + diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 07ab9d6ff..1bd5d3747 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -127,7 +127,7 @@ spec = describe "code actions" $ do liftIO $ x `shouldBe` "foo = putStrLn \"world\"" describe "import suggestions" $ do - hsImportSpec "brittany" + describe "formats with brittany" $ hsImportSpec "brittany" [ -- Expected output for simple format. [ "import qualified Data.Maybe" , "import Control.Monad" @@ -153,8 +153,27 @@ spec = describe "code actions" $ do , " $ hPutStrLn stdout" , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" ] + , -- Complex imports for Constructos and functions + [ "{-# LANGUAGE NoImplicitPrelude #-}" + , "import System.IO ( IO" + , " , hPutStrLn" + , " , stderr" + , " )" + , "import Prelude ( Bool(..) )" + , "import Control.Monad ( when )" + , "import Data.Function ( ($) )" + , "import Data.Maybe ( fromMaybe" + , " , Maybe(Just)" + , " )" + , "-- | Main entry point to the program" + , "main :: IO ()" + , "main =" + , " when True" + , " $ hPutStrLn stderr" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] ] - hsImportSpec "floskell" + describe "formats with floskell" $ hsImportSpec "floskell" [ -- Expected output for simple format. [ "import qualified Data.Maybe" , "import Control.Monad" @@ -178,6 +197,20 @@ spec = describe "code actions" $ do , " $ hPutStrLn stdout" , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" ] + , -- Complex imports for Constructos and functions + [ "{-# LANGUAGE NoImplicitPrelude #-}" + , "import System.IO (IO, hPutStrLn, stderr)" + , "import Prelude (Bool(..))" + , "import Control.Monad (when)" + , "import Data.Function (($))" + , "import Data.Maybe (fromMaybe, Maybe(Just))" + , "-- | Main entry point to the program" + , "main :: IO ()" + , "main =" + , " when True" + , " $ hPutStrLn stderr" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] ] describe "add package suggestions" $ do -- Only execute this test with ghc 8.4.4, below seems to be broken in the package. @@ -504,7 +537,7 @@ spec = describe "code actions" $ do -- Parameterized HsImport Spec. -- --------------------------------------------------------------------- hsImportSpec :: T.Text -> [[T.Text]]-> Spec -hsImportSpec formatterName [e1, e2, e3] = +hsImportSpec formatterName [e1, e2, e3, e4] = describe ("Execute HsImport with formatter " <> T.unpack formatterName) $ do it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImport.hs" "haskell" @@ -576,9 +609,8 @@ hsImportSpec formatterName [e1, e2, e3] = , "Import module Data.Maybe (fromMaybe)" ] - executeAllCodeActions doc wantedCodeActionTitles + contents <- executeAllCodeActions doc wantedCodeActionTitles - contents <- documentContents doc liftIO $ Set.fromList (T.lines contents) `shouldBe` Set.fromList e3 it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do @@ -593,8 +625,7 @@ hsImportSpec formatterName [e1, e2, e3] = , "Import module Data.Maybe (fromMaybe)" ] - executeAllCodeActions doc wantedCodeActionTitles - contents <- documentContents doc + contents <- executeAllCodeActions doc wantedCodeActionTitles liftIO $ Set.fromList (T.lines contents) `shouldBe` Set.fromList [ "import System.IO (stdout, hPutStrLn)" @@ -626,7 +657,7 @@ hsImportSpec formatterName [e1, e2, e3] = l3 `shouldBe` "main :: IO ()" l4 `shouldBe` "main = when True $ putStrLn \"hello\"" - it ("import-list respects format config with " <> T.unpack formatterName) $ runSession hieCommand fullCaps "test/testdata" $ do + it "import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportBrittany.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" @@ -644,14 +675,74 @@ hsImportSpec formatterName [e1, e2, e3] = l2 `shouldBe` "import Control.Monad (when)" l3 `shouldBe` "main :: IO ()" l4 `shouldBe` "main = when True $ putStrLn \"hello\"" + + it "complex import-list" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportListElaborate.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formatOnImportOn = True, formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + , "Import module Data.Function (($))" + , "Import module Data.Maybe (Maybe (Just))" + , "Import module Prelude (Bool (..))" + , "Import module System.IO (stderr)" + ] + + contents <- executeAllCodeActions doc wantedCodeActionTitles + + liftIO $ + T.lines contents `shouldBe` e4 + + it "complex import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportListElaborate.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formatOnImportOn = False, formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + , "Import module Data.Function (($))" + , "Import module Data.Maybe (Maybe (Just))" + , "Import module Prelude (Bool (..))" + , "Import module System.IO (stderr)" + ] + + contents <- executeAllCodeActions doc wantedCodeActionTitles + + liftIO $ + T.lines contents `shouldBe` + [ "{-# LANGUAGE NoImplicitPrelude #-}" + , "import System.IO (IO, hPutStrLn, stderr)" + , "import Prelude (Bool(..))" + , "import Control.Monad (when)" + , "import Data.Function (($))" + , "import Data.Maybe (fromMaybe, Maybe(Just))" + , "-- | Main entry point to the program" + , "main :: IO ()" + , "main =" + , " when True" + , " $ hPutStrLn stderr" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] + where - executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session () + executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session T.Text executeAllCodeActions doc names = - replicateM_ (length names) $ do - _ <- waitForDiagnosticsSource "ghcmod" - executeCodeActionByName doc names - _ <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc - waitForDiagnosticsSource "ghcmod" + foldM (\_ _ -> do + _ <- waitForDiagnosticsSource "ghcmod" + executeCodeActionByName doc names + content <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc + _ <- waitForDiagnosticsSource "ghcmod" + return content + ) + (T.pack "") + [ 1 .. length names ] executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () executeCodeActionByName doc names = do @@ -664,13 +755,13 @@ hsImportSpec formatterName [e1, e2, e3] = error $ "Found an unexpected amount of action. Expected 1, but got: " ++ show (length xs) - ++ "\n. Titles: " ++ show (map (^. L.title) allActions) + ++ ".\n Titles: " ++ show (map (^. L.title) allActions) -- Silence warnings hsImportSpec formatter args = error $ "Not the right amount of arguments for \"hsImportSpec (" ++ T.unpack formatter - ++ ")\", expected 3, got " + ++ ")\", expected 4, got " ++ show (length args) -- --------------------------------------------------------------------- diff --git a/test/testdata/CodeActionImportListElaborate.hs b/test/testdata/CodeActionImportListElaborate.hs new file mode 100644 index 000000000..587f9c042 --- /dev/null +++ b/test/testdata/CodeActionImportListElaborate.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} +import System.IO (IO) +-- | Main entry point to the program +main :: IO () +main = + when True + $ hPutStrLn stderr + $ fromMaybe "Good night, World!" (Just "Hello, World!") \ No newline at end of file diff --git a/test/unit/CodeActionsSpec.hs b/test/unit/CodeActionsSpec.hs index 2c5738cdb..73c2347eb 100644 --- a/test/unit/CodeActionsSpec.hs +++ b/test/unit/CodeActionsSpec.hs @@ -15,19 +15,22 @@ spec = do describe "import code actions" $ do it "pick up variable not in scope" $ let msg = "Variable not in scope: fromJust :: Maybe Integer -> t" - in extractImportableTerm msg `shouldBe` Just "fromJust :: Maybe Integer -> t" + in extractImportableTerm msg `shouldBe` Just ("fromJust :: Maybe Integer -> t", Import Symbol) it "pick up variable not in scope with 'perhaps you meant'" $ let msg = "• Variable not in scope: msgs :: T.Text\n• Perhaps you meant ‘msg’ (line 90)" - in extractImportableTerm msg `shouldBe` Just "msgs :: T.Text" + in extractImportableTerm msg `shouldBe` Just ("msgs :: T.Text", Import Symbol) it "pick up multi-line variable not in scope" $ let msg = "Variable not in scope:\nliftIO\n:: IO [FilePath]\n-> GhcMod.Monad.Newtypes.GmT\n (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]" - in extractImportableTerm msg `shouldBe` Just "liftIO :: IO [FilePath] -> GhcMod.Monad.Newtypes.GmT (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]" + in extractImportableTerm msg `shouldBe` Just ("liftIO :: IO [FilePath] -> GhcMod.Monad.Newtypes.GmT (GhcMod.Monad.Newtypes.GmOutT IdeM) [[t0]]", Import Symbol) it "pick up when" $ let msg = "Variable not in scope: when :: Bool -> IO () -> t" - in extractImportableTerm msg `shouldBe` Just "when :: Bool -> IO () -> t" + in extractImportableTerm msg `shouldBe` Just ("when :: Bool -> IO () -> t", Import Symbol) it "pick up data constructors" $ let msg = "Data constructor not in scope: ExitFailure :: Integer -> t" - in extractImportableTerm msg `shouldBe` Just "ExitFailure :: Integer -> t" + in extractImportableTerm msg `shouldBe` Just ("ExitFailure :: Integer -> t", Import Constructor) + it "pick up type" $ + let msg = "Not in scope: type constructor or class ‘Text" + in extractImportableTerm msg `shouldBe` Just ("Text", Import Type) describe "rename code actions" $ do it "pick up variable not in scope perhaps you meant" $ @@ -146,7 +149,7 @@ spec = do \ Text.Megaparsec.Error.ShowErrorComponent e, Ord t) =>\n\ \ OutputFormat -> Format.Result t e -> IO b" in extractMissingSignature msg `shouldBe` Just expected - + describe "unused term code actions" $ do it "pick up unused term" $ let msg = " Defined but not used: ‘imUnused’"