From f96b249fcae325950792129fab891f2372e2c0b3 Mon Sep 17 00:00:00 2001 From: fendor Date: Fri, 19 Apr 2019 18:59:10 +0200 Subject: [PATCH 01/11] Add Code action to use import-lists --- src/Haskell/Ide/Engine/Plugin/Brittany.hs | 4 +- src/Haskell/Ide/Engine/Plugin/Floskell.hs | 2 +- src/Haskell/Ide/Engine/Plugin/HsImport.hs | 162 +++++++++++++++------- 3 files changed, 118 insertions(+), 50 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Brittany.hs b/src/Haskell/Ide/Engine/Plugin/Brittany.hs index c5c180132..94ae3efbc 100644 --- a/src/Haskell/Ide/Engine/Plugin/Brittany.hs +++ b/src/Haskell/Ide/Engine/Plugin/Brittany.hs @@ -65,8 +65,8 @@ formatText => Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used. -> FormattingOptions -- ^ Options for the formatter such as indentation. -> Text -- ^ Text to format - -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany. -formatText confFile opts text = + -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany. +formatText confFile opts text = liftIO $ runBrittany tabSize confFile text where tabSize = opts ^. J.tabSize diff --git a/src/Haskell/Ide/Engine/Plugin/Floskell.hs b/src/Haskell/Ide/Engine/Plugin/Floskell.hs index 796bb22e9..386412005 100644 --- a/src/Haskell/Ide/Engine/Plugin/Floskell.hs +++ b/src/Haskell/Ide/Engine/Plugin/Floskell.hs @@ -37,7 +37,7 @@ provider contents uri typ _opts = let (range, selectedContents) = case typ of FormatDocument -> (fullRange contents, contents) FormatRange r -> (r, extractRange r contents) - result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents)) + result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents)) case result of Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null) Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))] diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs index 29c318c95..242413310 100644 --- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs +++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs @@ -42,19 +42,27 @@ hsimportDescriptor plId = PluginDescriptor , pluginFormattingProvider = Nothing } +-- | 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 - , moduleToImport :: T.Text + { file :: Uri -- ^ Uri to the file to import the module to. + , addToImportList :: Maybe T.Text -- ^ If not Nothing, an import-list will be created. + , moduleToImport :: T.Text -- ^ Name of the module to import. } deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) importCmd :: CommandFunc ImportParams J.WorkspaceEdit -importCmd = CmdSync $ \(ImportParams uri modName) -> importModule uri modName - -importModule :: Uri -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit) -importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do +importCmd = CmdSync $ \(ImportParams uri importList modName) -> + importModule uri importList modName + +-- | Import the given module for the given file. +-- May take an explicit function name to perform an import-list import. +importModule + :: Uri -> Maybe T.Text -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit) +importModule uri importList modName = + pluginGetFile "hsimport cmd: " uri $ \origInput -> do shouldFormat <- formatOnImportOn <$> getConfig - fileMap <- GM.mkRevRedirMapFunc GM.withMappedFile origInput $ \input -> do @@ -64,6 +72,7 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do let args = defaultArgs { moduleName = T.unpack modName , inputSrcFile = input + , symbolName = T.unpack $ fromMaybe "" importList , outputSrcFile = output } maybeErr <- liftIO $ hsimportWithArgs defaultConfig args @@ -89,13 +98,16 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do Just (_, provider) -> do let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit - formatEdit origEdit@(J.TextEdit _ t) = do + formatEdit origEdit@(J.TextEdit r t) = do + let strippedText = T.dropWhileEnd (=='\n') t -- TODO: are these default FormattingOptions ok? - res <- liftToGhc $ provider t uri FormatDocument (FormattingOptions 2 True) + res <- liftToGhc $ provider strippedText uri FormatDocument (FormattingOptions 2 True) let formatEdits = case res of IdeResultOk xs -> xs - _ -> [] - return $ foldl' J.editTextEdit origEdit formatEdits + _ -> [origEdit] + -- let edits = foldl' J.editTextEdit origEdit formatEdits -- TODO: this seems broken. + -- liftIO $ hPutStrLn stderr $ "Text Edits: " ++ show formatEdits + return (J.TextEdit r (J._newText $ head formatEdits)) -- behold: the legendary triple mapM newChanges <- (mapM . mapM . mapM) formatEdit mChanges @@ -110,48 +122,104 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges) else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges) +-- | Produces code actions. codeActionProvider :: CodeActionProvider codeActionProvider plId docId _ context = do let J.List diags = context ^. J.diagnostics - terms = mapMaybe getImportables diags - - res <- mapM (bimapM return Hoogle.searchModules) terms - actions <- catMaybes <$> mapM (uncurry mkImportAction) (concatTerms res) + terms = mapMaybe getImportables diags + -- Search for the given diagnostics and prodice appropiate import actions. + actions <- importActionsForTerms id terms if null actions - then do - let relaxedTerms = map (bimap id (head . T.words)) terms - relaxedRes <- mapM (bimapM return Hoogle.searchModules) relaxedTerms - relaxedActions <- catMaybes <$> mapM (uncurry mkImportAction) (concatTerms relaxedRes) - return $ IdeResultOk relaxedActions - else return $ IdeResultOk actions - - where - concatTerms = concatMap (\(d, ts) -> map (d,) ts) - - --TODO: Check if package is already installed - mkImportAction :: J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction) - mkImportAction diag modName = do - cmd <- mkLspCommand plId "import" title (Just cmdParams) - return (Just (codeAction cmd)) - where - codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [diag])) Nothing (Just cmd) - title = "Import module " <> modName - cmdParams = [toJSON (ImportParams (docId ^. J.uri) modName)] - - getImportables :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text) - getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) = (diag,) <$> extractImportableTerm msg - getImportables _ = Nothing - + then do + -- If we didn't find any exact matches, relax the search terms. + -- Only looks for the function names, not the exact siganture. + relaxedActions <- importActionsForTerms (head . T.words) terms + return $ IdeResultOk relaxedActions + else return $ IdeResultOk actions + + where + -- | Creates CodeActions from the diagnostics to add imports. + -- Takes a relaxation Function. Used to relax the search term, + -- e.g. instead of `take :: Int -> [a] -> [a]` use `take` as the search term. + -- + -- List of Diagnostics with the associated term to look for. + -- Diagnostic that is supposed to import the appropiate term. + -- + -- Result may produce several import actions, or none. + importActionsForTerms + :: (T.Text -> T.Text) -> [(J.Diagnostic, T.Text)] -> IdeM [J.CodeAction] + importActionsForTerms relax terms = do + let searchTerms = map (bimap id relax) 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) normalise + + -- | Turn a search term with function name into Import Actions. + -- 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. + -- + -- Note, that repeated use of the Import-List will add imports to + -- the appropriate import line, e.g. no module import is duplicated, except + -- for qualified imports. + termToActions :: T.Text -> (J.Diagnostic, T.Text) -> IdeM [J.CodeAction] + termToActions functionName (diagnostic, termName) = catMaybes <$> sequenceA + [ mkImportAction Nothing diagnostic termName + , mkImportAction (Just functionName) diagnostic termName + ] + + 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 + cmd <- mkLspCommand plId "import" title (Just cmdParams) + return (Just (codeAction cmd)) + where + codeAction cmd = J.CodeAction title + (Just J.CodeActionQuickFix) + (Just (J.List [diag])) + Nothing + (Just cmd) + title = + "Import module " + <> modName + <> maybe "" (\name -> " (" <> name <> ")") importList + cmdParams = [toJSON (ImportParams (docId ^. J.uri) importList 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 diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) = + (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 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 - $ T.splitOn "Perhaps you meant " - $ T.replace "\n" " " - -- Get rid of trailing/leading whitespace on each individual line - $ T.unlines $ map T.strip $ T.lines - $ T.replace "• " "" dirtyMsg + , T.stripPrefix "Data constructor not in scope: " msg + ] + where + msg = + head + -- 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 + $ T.unlines + $ map T.strip + $ T.lines + $ T.replace "• " "" dirtyMsg From e196a597e05676da75d077ab4c725e2b01fe3681 Mon Sep 17 00:00:00 2001 From: fendor Date: Fri, 19 Apr 2019 21:31:02 +0200 Subject: [PATCH 02/11] Document and rename formatting type options. --- .../Haskell/Ide/Engine/PluginsIdeMonads.hs | 20 +++++++++++++------ src/Haskell/Ide/Engine/Plugin/Brittany.hs | 15 ++++++++++---- src/Haskell/Ide/Engine/Plugin/Floskell.hs | 4 ++-- src/Haskell/Ide/Engine/Plugin/HsImport.hs | 13 ++++++++++-- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 12 +++++------ 5 files changed, 44 insertions(+), 20 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 8de813064..ef7b3f089 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -207,15 +207,18 @@ type HoverProvider = Uri -> Position -> IdeM (IdeResult [Hover]) type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol]) --- | Format the document either as a whole or only a given Range of it. -data FormattingType = FormatDocument +-- | Format the given Text as a whole or only a @Range@ of it. +-- Range must be relative to the text to format. +-- To format the whole document, read the Text from the file and use 'FormatText' +-- as the FormattingType. +data FormattingType = FormatText | FormatRange Range -- | Formats the given Text associated with the given Uri. --- Should, but might not, honor the provided formatting options (e.g. Floskell does not). --- A formatting type can be given to either format the whole document or only a Range. --- --- Text to format, may or may not, originate from the associated Uri. +-- Should, but might not, honour the provided formatting options (e.g. Floskell does not). +-- A formatting type can be given to either format the whole text or only a Range. +-- +-- Text to format, may or may not, originate from the associated Uri. -- E.g. it is ok, to modify the text and then reformat it through this API. -- -- The Uri is mainly used to discover formatting configurations in the file's path. @@ -224,6 +227,11 @@ data FormattingType = FormatDocument -- Failing means here that a IdeResultFail is returned. -- This can be used to display errors to the user, unless the error is an Internal one. -- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error. +-- +-- +-- To format a whole document, the 'FormatText' @FormattingType@ can be used. +-- It is required to pass in the whole Document Text for that to happen, an empty text +-- and file uri, does not suffice. type FormattingProvider = T.Text -- ^ Text to format -> Uri -- ^ Uri of the file being formatted -> FormattingType -- ^ How much to format diff --git a/src/Haskell/Ide/Engine/Plugin/Brittany.hs b/src/Haskell/Ide/Engine/Plugin/Brittany.hs index 94ae3efbc..8acd17c08 100644 --- a/src/Haskell/Ide/Engine/Plugin/Brittany.hs +++ b/src/Haskell/Ide/Engine/Plugin/Brittany.hs @@ -43,8 +43,8 @@ provider provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do confFile <- liftIO $ getConfFile fp let (range, selectedContents) = case formatType of - FormatDocument -> (fullRange text, text) - FormatRange r -> (normalize r, extractRange r text) + FormatText -> (fullRange text, text) + FormatRange r -> (normalize r, extractRange r text) res <- formatText confFile opts selectedContents case res of @@ -70,16 +70,23 @@ formatText confFile opts text = liftIO $ runBrittany tabSize confFile text where tabSize = opts ^. J.tabSize --- | Extend to the line below to replace newline character, as above. +-- | Extend to the line below and above to replace newline character. normalize :: Range -> Range normalize (Range (Position sl _) (Position el _)) = Range (Position sl 0) (Position (el + 1) 0) --- | Recursively search in every directory of the given filepath for brittany.yaml +-- | Recursively search in every directory of the given filepath for brittany.yaml. -- If no such file has been found, return Nothing. getConfFile :: FilePath -> IO (Maybe FilePath) getConfFile = findLocalConfigPath . takeDirectory +-- | Run Brittany on the given text with the given tab size and +-- a configuration path. If no configuration path is given, a +-- default configuration is chosen. The configuration may overwrite +-- tab size parameter. +-- +-- Returns either a list of Brittany Errors or the reformatted text. +-- May not throw an exception. runBrittany :: Int -- ^ tab size -> Maybe FilePath -- ^ local config file -> Text -- ^ text to format diff --git a/src/Haskell/Ide/Engine/Plugin/Floskell.hs b/src/Haskell/Ide/Engine/Plugin/Floskell.hs index 386412005..338231f43 100644 --- a/src/Haskell/Ide/Engine/Plugin/Floskell.hs +++ b/src/Haskell/Ide/Engine/Plugin/Floskell.hs @@ -35,8 +35,8 @@ provider contents uri typ _opts = pluginGetFile "Floskell: " uri $ \file -> do config <- liftIO $ findConfigOrDefault file let (range, selectedContents) = case typ of - FormatDocument -> (fullRange contents, contents) - FormatRange r -> (r, extractRange r contents) + FormatText -> (fullRange contents, contents) + FormatRange r -> (r, extractRange r contents) result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents)) case result of Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null) diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs index 242413310..b32d5c1eb 100644 --- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs +++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs @@ -58,6 +58,9 @@ importCmd = CmdSync $ \(ImportParams uri importList modName) -> -- | Import the given module for the given file. -- May take an explicit function name to perform an import-list import. +-- Multiple import-list imports will result in merged imports, +-- 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 = @@ -75,6 +78,7 @@ importModule uri importList modName = , symbolName = T.unpack $ fromMaybe "" importList , outputSrcFile = output } + -- execute hsimport on the given file and write into a temporary file. maybeErr <- liftIO $ hsimportWithArgs defaultConfig args case maybeErr of Just err -> do @@ -82,26 +86,31 @@ importModule uri importList modName = let msg = T.pack $ show err return $ IdeResultFail (IdeError PluginError msg Null) Nothing -> do + -- Since no error happened, calculate the differences of + -- the original file and after the import has been done. newText <- liftIO $ T.readFile output liftIO $ removeFile output J.WorkspaceEdit mChanges mDocChanges <- liftToGhc $ makeDiffResult input newText fileMap + -- If the client wants its import formatted, + -- it can be configured in the config. if shouldFormat then do config <- getConfig plugins <- getPlugins let mprovider = Hie.getFormattingPlugin config plugins case mprovider of + -- Client may have no formatter selected + -- but still the option to format on import. Nothing -> return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges) Just (_, provider) -> do let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit formatEdit origEdit@(J.TextEdit r t) = do - let strippedText = T.dropWhileEnd (=='\n') t -- TODO: are these default FormattingOptions ok? - res <- liftToGhc $ provider strippedText uri FormatDocument (FormattingOptions 2 True) + res <- liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) let formatEdits = case res of IdeResultOk xs -> xs _ -> [origEdit] diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index d9ca761cc..d6c95ad5b 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -736,7 +736,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri withDocumentContents (req ^. J.id) doc $ \text -> let callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List - hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatDocument (params ^. J.options) + hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options) in makeRequest hreq -- ------------------------------- @@ -809,10 +809,10 @@ reactor inp diagIn = do -- --------------------------------------------------------------------- -- | Execute a function in the current request with an Uri. --- Reads the content of the file specified by the Uri and invokes +-- Reads the content of the file specified by the Uri and invokes -- the function on it. -- --- If the Uri can not be mapped to a real file, the function will +-- If the Uri can not be mapped to a real file, the function will -- not be executed and an error message will be sent to the client. -- Error message is associated with the request id and, thus, identifiable. withDocumentContents :: J.LspId -> J.Uri -> (T.Text -> R ()) -> R () @@ -830,9 +830,9 @@ withDocumentContents reqId uri f = do -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. --- +-- -- It is possible that formatter configured by the user is not present. --- In this case, a nop (No-Operation) formatter is returned and a message will +-- In this case, a nop (No-Operation) formatter is returned and a message will -- be sent to the user. getFormattingProvider :: R FormattingProvider getFormattingProvider = do @@ -847,7 +847,7 @@ getFormattingProvider = do unless (providerName == "none") $ do let msg = providerName <> " is not a recognised plugin for formatting. Check your config" reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning msg - reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg + reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg return (\_ _ _ _ -> return (IdeResultOk [])) -- nop formatter Just (_, provider) -> return provider From 93cc5cc0c26a0b8090f85a76e8884c31db26f764 Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 20 Apr 2019 13:06:15 +0200 Subject: [PATCH 03/11] Add more comments and search exact --- src/Haskell/Ide/Engine/Plugin/HsImport.hs | 56 +++++++++++++++++------ 1 file changed, 42 insertions(+), 14 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs index b32d5c1eb..07d517c4d 100644 --- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs +++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs @@ -47,7 +47,7 @@ hsimportDescriptor plId = PluginDescriptor -- 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 not Nothing, an import-list will be created. + , addToImportList :: Maybe T.Text -- ^ If set, an import-list will be created. , moduleToImport :: T.Text -- ^ Name of the module to import. } deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON) @@ -131,19 +131,28 @@ importModule uri importList modName = $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges) else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges) +-- | 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. +data SearchStyle + = Exact -- ^ If you want to match exactly the search string. + | ExactName -- ^ If you want to match exactly a function name. + -- Same as @Exact@ if the term is just a function name. + | Relax (T.Text -> T.Text) -- ^ Relax the search term to match even more. + -- | Produces code actions. codeActionProvider :: CodeActionProvider codeActionProvider plId docId _ context = do let J.List diags = context ^. J.diagnostics terms = mapMaybe getImportables diags - -- Search for the given diagnostics and prodice appropiate import actions. - actions <- importActionsForTerms id terms + -- Search for the given diagnostics and produce appropiate import actions. + actions <- importActionsForTerms Exact terms if null actions then do -- If we didn't find any exact matches, relax the search terms. -- Only looks for the function names, not the exact siganture. - relaxedActions <- importActionsForTerms (head . T.words) terms + relaxedActions <- importActionsForTerms ExactName terms return $ IdeResultOk relaxedActions else return $ IdeResultOk actions @@ -157,9 +166,9 @@ codeActionProvider plId docId _ context = do -- -- Result may produce several import actions, or none. importActionsForTerms - :: (T.Text -> T.Text) -> [(J.Diagnostic, T.Text)] -> IdeM [J.CodeAction] - importActionsForTerms relax terms = do - let searchTerms = map (bimap id relax) terms + :: 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 @@ -167,7 +176,18 @@ codeActionProvider plId docId _ context = do let normalise = concatMap (\(a, b) -> zip (repeat a) (concatTerms b)) searchResults - concat <$> mapM (uncurry termToActions) normalise + concat <$> mapM (uncurry (termToActions style)) normalise + + -- | 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 + (x:_) -> "is:exact " <> x + applySearchStyle (Relax relax) term = relax term -- | Turn a search term with function name into Import Actions. -- Function name may be of only the exact phrase to import. @@ -177,11 +197,18 @@ codeActionProvider plId docId _ context = do -- Note, that repeated use of the Import-List will add imports to -- the appropriate import line, e.g. no module import is duplicated, except -- for qualified imports. - termToActions :: T.Text -> (J.Diagnostic, T.Text) -> IdeM [J.CodeAction] - termToActions functionName (diagnostic, termName) = catMaybes <$> sequenceA - [ mkImportAction Nothing diagnostic termName - , mkImportAction (Just functionName) diagnostic termName - ] + -- + -- If the search term is relaxed in a custom way, + -- 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) concatTerms :: (a, [b]) -> [(a, b)] concatTerms (a, b) = zip (repeat a) b @@ -213,7 +240,8 @@ codeActionProvider plId docId _ context = do 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 unknown function. +-- 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 From 817204078b3380d82e77f6265af215833fa89390 Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 20 Apr 2019 13:33:18 +0200 Subject: [PATCH 04/11] Add and fix tests for import code action --- test/functional/FunctionalCodeActionsSpec.hs | 72 +++++++++++++++++++- 1 file changed, 69 insertions(+), 3 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 752651ef0..03b0328eb 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -136,7 +136,8 @@ spec = describe "code actions" $ do let actns = map fromAction actionsOrCommands liftIO $ do - head actns ^. L.title `shouldBe` "Import module Control.Monad" + head actns ^. L.title `shouldBe` "Import module Control.Monad" + head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)" forM_ actns $ \a -> do a ^. L.kind `shouldBe` Just CodeActionQuickFix a ^. L.command `shouldSatisfy` isJust @@ -144,7 +145,7 @@ spec = describe "code actions" $ do let hasOneDiag (Just (List [_])) = True hasOneDiag _ = False a ^. L.diagnostics `shouldSatisfy` hasOneDiag - length actns `shouldBe` 5 + length actns `shouldBe` 10 executeCodeAction (head actns) @@ -160,9 +161,59 @@ spec = describe "code actions" $ do contents <- getDocumentEdit doc liftIO $ do - let l1:l2:_ = T.lines contents + let l1:l2:l3:_ = T.lines contents l1 `shouldBe` "import qualified Data.Maybe" l2 `shouldBe` "import Control.Monad" + l3 `shouldBe` "main :: IO ()" + it "formats with floskell" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formattingProvider = "floskell" } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let l1:l2:l3:_ = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad" + l3 `shouldBe` "main :: IO ()" + it "import-list formats with brittany" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + actionsOrCommands <- getAllCodeActions doc + let _:action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let l1:l2:l3:_ = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad ( when )" + l3 `shouldBe` "main :: IO ()" + it "import-list formats with floskell" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formattingProvider = "floskell" } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let _:action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let l1:l2:l3:_ = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad (when)" + l3 `shouldBe` "main :: IO ()" + -- TODO: repeated code actions it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportBrittany.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" @@ -179,7 +230,22 @@ spec = describe "code actions" $ do let l1:l2:_ = T.lines contents l1 `shouldBe` "import qualified Data.Maybe" l2 `shouldBe` "import Control.Monad" + it "import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formatOnImportOn = False } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + actionsOrCommands <- getAllCodeActions doc + let _:action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let l1:l2:_ = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad (when)" describe "add package suggestions" $ do it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal" $ do doc <- openDoc "AddPackage.hs" "haskell" From 590980ad3ec29a54c4ee0dc2aa0f45de5182ae56 Mon Sep 17 00:00:00 2001 From: fendor Date: Sun, 21 Apr 2019 19:02:06 +0200 Subject: [PATCH 05/11] Add test file for multiple import-list actions --- test/testdata/CodeActionImportList.hs | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 test/testdata/CodeActionImportList.hs diff --git a/test/testdata/CodeActionImportList.hs b/test/testdata/CodeActionImportList.hs new file mode 100644 index 000000000..1e1892e4a --- /dev/null +++ b/test/testdata/CodeActionImportList.hs @@ -0,0 +1,5 @@ +main :: IO () +main = + when True + $ hPutStrLn stdout + $ fromMaybe "Good night, World!" (Just "Hello, World!") \ No newline at end of file From 62061441fa1f9caf9b80186c91985b3c9b8ce432 Mon Sep 17 00:00:00 2001 From: fendor Date: Sun, 21 Apr 2019 19:02:49 +0200 Subject: [PATCH 06/11] Refactor HsImport Code Action tests Adds a parameterized test suite for formatter providers. Should be used when introducing new formatters. --- test/functional/FunctionalCodeActionsSpec.hs | 334 ++++++++++++------- 1 file changed, 213 insertions(+), 121 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 03b0328eb..4115043ef 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -125,127 +125,54 @@ spec = describe "code actions" $ do liftIO $ x `shouldBe` "foo = putStrLn \"world\"" describe "import suggestions" $ do - it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImport.hs" "haskell" - - -- ignore the first empty hlint diagnostic publish - [_,diag:_] <- count 2 waitForDiagnostics - liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()" - - actionsOrCommands <- getAllCodeActions doc - let actns = map fromAction actionsOrCommands - - liftIO $ do - head actns ^. L.title `shouldBe` "Import module Control.Monad" - head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)" - forM_ actns $ \a -> do - a ^. L.kind `shouldBe` Just CodeActionQuickFix - a ^. L.command `shouldSatisfy` isJust - a ^. L.edit `shouldBe` Nothing - let hasOneDiag (Just (List [_])) = True - hasOneDiag _ = False - a ^. L.diagnostics `shouldSatisfy` hasOneDiag - length actns `shouldBe` 10 - - executeCodeAction (head actns) - - contents <- getDocumentEdit doc - liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\"" - it "formats with brittany" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - actionsOrCommands <- getAllCodeActions doc - let action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:l3:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad" - l3 `shouldBe` "main :: IO ()" - it "formats with floskell" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - let config = def { formattingProvider = "floskell" } - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - actionsOrCommands <- getAllCodeActions doc - let action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:l3:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad" - l3 `shouldBe` "main :: IO ()" - it "import-list formats with brittany" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - actionsOrCommands <- getAllCodeActions doc - let _:action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:l3:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad ( when )" - l3 `shouldBe` "main :: IO ()" - it "import-list formats with floskell" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - let config = def { formattingProvider = "floskell" } - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - actionsOrCommands <- getAllCodeActions doc - let _:action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:l3:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad (when)" - l3 `shouldBe` "main :: IO ()" - -- TODO: repeated code actions - it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - let config = def { formatOnImportOn = False } - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - actionsOrCommands <- getAllCodeActions doc - let action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad" - it "import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportBrittany.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - let config = def { formatOnImportOn = False } - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - actionsOrCommands <- getAllCodeActions doc - let _:action:_ = map fromAction actionsOrCommands - executeCodeAction action - - contents <- getDocumentEdit doc - liftIO $ do - let l1:l2:_ = T.lines contents - l1 `shouldBe` "import qualified Data.Maybe" - l2 `shouldBe` "import Control.Monad (when)" + hsImportSpec "brittany" + [ -- Expected output for simple format. + [ "import qualified Data.Maybe" + , "import Control.Monad" + , "main :: IO ()" + , "main = when True $ putStrLn \"hello\"" + ] + , -- Use an import list and format the output. + [ "import qualified Data.Maybe" + , "import Control.Monad ( when )" + , "main :: IO ()" + , "main = when True $ putStrLn \"hello\"" + ] + , -- Multiple import lists, should not introduce multiple newlines. + [ "import Data.Maybe ( fromMaybe )" + , "import Control.Monad ( when )" + , "import System.IO ( hPutStrLn" + , " , stdout" + , " )" + , "main =" + , " when True" + , " $ hPutStrLn stdout" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] + ] + hsImportSpec "floskell" + [ -- Expected output for simple format. + [ "import qualified Data.Maybe" + , "import Control.Monad" + , "main :: IO ()" + , "main = when True $ putStrLn \"hello\"" + ] + , -- Use an import list and format the output. + [ "import qualified Data.Maybe" + , "import Control.Monad (when)" + , "main :: IO ()" + , "main = when True $ putStrLn \"hello\"" + ] + , -- Multiple import lists, should not introduce multiple newlines. + [ "import Data.Maybe (fromMaybe)" + , "import Control.Monad (when)" + , "import System.IO (hPutStrLn, stdout)" + , "main =" + , " when True" + , " $ hPutStrLn stdout" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] + ] describe "add package suggestions" $ do it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal" $ do doc <- openDoc "AddPackage.hs" "haskell" @@ -539,6 +466,171 @@ spec = describe "code actions" $ do kinds `shouldSatisfy` all (Just CodeActionRefactorInline ==) -- --------------------------------------------------------------------- +-- Parameterized HsImport Spec. +-- --------------------------------------------------------------------- +hsImportSpec :: T.Text -> [[T.Text]]-> Spec +hsImportSpec formatterName [e1, e2, e3] = + 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" + -- No Formatting: + let config = def { formattingProvider = "none" } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics + liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()" + + actionsOrCommands <- getAllCodeActions doc + let actns = map fromAction actionsOrCommands + + liftIO $ do + head actns ^. L.title `shouldBe` "Import module Control.Monad" + head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)" + forM_ actns $ \a -> do + a ^. L.kind `shouldBe` Just CodeActionQuickFix + a ^. L.command `shouldSatisfy` isJust + a ^. L.edit `shouldBe` Nothing + let hasOneDiag (Just (List [_])) = True + hasOneDiag _ = False + a ^. L.diagnostics `shouldSatisfy` hasOneDiag + length actns `shouldBe` 10 + + executeCodeAction (head actns) + + contents <- getDocumentEdit doc + liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\"" + + it "formats" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ T.lines contents `shouldMatchList` e1 + + it "import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let _:action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ T.lines contents `shouldMatchList` e2 + + it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportList.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + , "Import module System.IO (stdout)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + ] + + mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles + + contents <- getDocumentEdit doc + liftIO $ T.lines contents `shouldBe` e3 + + it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportList.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 System.IO (stdout)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + ] + + mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles + + contents <- getDocumentEdit doc + liftIO $ T.lines contents `shouldBe` + [ "import Data.Maybe (fromMaybe)" + , "import Control.Monad (when)" + , "import System.IO (hPutStrLn, stdout)" + , "main :: IO ()" + , "main =" + , "when True" + , " $ hPutStrLn stdout" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")]" + ] + it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formatOnImportOn = False, formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let [l1, l2, l3, l4] = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad" + 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 + doc <- openDoc "CodeActionImportBrittany.hs" "haskell" + _ <- waitForDiagnosticsSource "ghcmod" + + let config = def { formatOnImportOn = False, formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + actionsOrCommands <- getAllCodeActions doc + let _:action:_ = map fromAction actionsOrCommands + executeCodeAction action + + contents <- getDocumentEdit doc + liftIO $ do + let [l1, l2, l3, l4] = T.lines contents + l1 `shouldBe` "import qualified Data.Maybe" + l2 `shouldBe` "import Control.Monad (when)" + l3 `shouldBe` "main :: IO ()" + l4 `shouldBe` "main = when True $ putStrLn \"hello\"" + where + executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () + executeCodeActionByName doc names = do + actionsOrCommands <- getAllCodeActions doc + let allActions = map fromAction actionsOrCommands + let actions = filter (\actn -> actn ^. L.title `elem` names) allActions + case actions of + (action:_) -> executeCodeAction action + xs -> + error + $ "Found an unexpected amount of action. Expected 1, but got: " + ++ show (length xs) + ++ "\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 " + ++ show (length args) +-- --------------------------------------------------------------------- fromAction :: CAResult -> CodeAction fromAction (CACodeAction action) = action From 85ac6e4e3514e69b6c19470e39c15d55e731ead5 Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 24 Apr 2019 18:14:08 +0200 Subject: [PATCH 07/11] Comment out tests that currently dont run Needs to be fixed. --- test/functional/FunctionalCodeActionsSpec.hs | 116 +++++++++---------- 1 file changed, 58 insertions(+), 58 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 4115043ef..67734c021 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -469,7 +469,7 @@ spec = describe "code actions" $ do -- Parameterized HsImport Spec. -- --------------------------------------------------------------------- hsImportSpec :: T.Text -> [[T.Text]]-> Spec -hsImportSpec formatterName [e1, e2, e3] = +hsImportSpec formatterName [e1, e2, _] = 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" @@ -529,50 +529,50 @@ hsImportSpec formatterName [e1, e2, e3] = contents <- getDocumentEdit doc liftIO $ T.lines contents `shouldMatchList` e2 - it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportList.hs" "haskell" - _ <- waitForDiagnosticsSource "ghcmod" - - let config = def { formattingProvider = formatterName } - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" - , "Import module System.IO (stdout)" - , "Import module Control.Monad (when)" - , "Import module Data.Maybe (fromMaybe)" - ] - - mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles - - contents <- getDocumentEdit doc - liftIO $ T.lines contents `shouldBe` e3 - - it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "CodeActionImportList.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 System.IO (stdout)" - , "Import module Control.Monad (when)" - , "Import module Data.Maybe (fromMaybe)" - ] - - mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles - - contents <- getDocumentEdit doc - liftIO $ T.lines contents `shouldBe` - [ "import Data.Maybe (fromMaybe)" - , "import Control.Monad (when)" - , "import System.IO (hPutStrLn, stdout)" - , "main :: IO ()" - , "main =" - , "when True" - , " $ hPutStrLn stdout" - , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")]" - ] + -- it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do + -- doc <- openDoc "CodeActionImportList.hs" "haskell" + -- _ <- waitForDiagnosticsSource "ghcmod" + + -- let config = def { formattingProvider = formatterName } + -- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + -- , "Import module System.IO (stdout)" + -- , "Import module Control.Monad (when)" + -- , "Import module Data.Maybe (fromMaybe)" + -- ] + + -- mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles + + -- contents <- getDocumentEdit doc + -- liftIO $ T.lines contents `shouldBe` e3 + + -- it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do + -- doc <- openDoc "CodeActionImportList.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 System.IO (stdout)" + -- , "Import module Control.Monad (when)" + -- , "Import module Data.Maybe (fromMaybe)" + -- ] + + -- mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles + + -- contents <- getDocumentEdit doc + -- liftIO $ T.lines contents `shouldBe` + -- [ "import Data.Maybe (fromMaybe)" + -- , "import Control.Monad (when)" + -- , "import System.IO (hPutStrLn, stdout)" + -- , "main :: IO ()" + -- , "main =" + -- , "when True" + -- , " $ hPutStrLn stdout" + -- , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")]" + -- ] it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportBrittany.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" @@ -610,19 +610,19 @@ hsImportSpec formatterName [e1, e2, e3] = l2 `shouldBe` "import Control.Monad (when)" l3 `shouldBe` "main :: IO ()" l4 `shouldBe` "main = when True $ putStrLn \"hello\"" - where - executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () - executeCodeActionByName doc names = do - actionsOrCommands <- getAllCodeActions doc - let allActions = map fromAction actionsOrCommands - let actions = filter (\actn -> actn ^. L.title `elem` names) allActions - case actions of - (action:_) -> executeCodeAction action - xs -> - error - $ "Found an unexpected amount of action. Expected 1, but got: " - ++ show (length xs) - ++ "\n. Titles: " ++ show (map (^. L.title) allActions) + -- where + -- executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () + -- executeCodeActionByName doc names = do + -- actionsOrCommands <- getAllCodeActions doc + -- let allActions = map fromAction actionsOrCommands + -- let actions = filter (\actn -> actn ^. L.title `elem` names) allActions + -- case actions of + -- (action:_) -> executeCodeAction action + -- xs -> + -- error + -- $ "Found an unexpected amount of action. Expected 1, but got: " + -- ++ show (length xs) + -- ++ "\n. Titles: " ++ show (map (^. L.title) allActions) -- Silence warnings hsImportSpec formatter args = From d6dedd329365421e68539367edf7b20a07d348c4 Mon Sep 17 00:00:00 2001 From: fendor Date: Sun, 28 Apr 2019 13:03:11 +0200 Subject: [PATCH 08/11] Fix additional newline when Brittany uses import-list --- src/Haskell/Ide/Engine/Plugin/HsImport.hs | 42 +++++++++++++++++------ 1 file changed, 32 insertions(+), 10 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs index 07d517c4d..aff815917 100644 --- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs +++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE LambdaCase #-} module Haskell.Ide.Engine.Plugin.HsImport where import Control.Lens.Operators @@ -72,7 +73,6 @@ 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 @@ -107,16 +107,38 @@ importModule uri importList modName = return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges) Just (_, provider) -> do - let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit + let + -- | Dirty little hack. + -- Necessary in the following case: + -- We want to add an item to an existing import-list. + -- The diff algorithm does not count the newline character + -- as part of the diff between new and old text. + -- However, some formatters (Brittany), add a trailing + -- newline nevertheless. + -- This leads to the problem that an additional + -- newline is inserted into the source. + -- This function makes sure, that if the original text + -- did not have a newline, none will be added, assuming + -- that the diff algorithm continues to not count newlines + -- as part of the diff. + -- This is only save to do in this very specific environment. + -- In any other case, this function may not be copy-pasted + -- to solve a similar problem. + renormalise :: T.Text -> T.Text -> T.Text + renormalise orig formatted + | T.null orig || T.null formatted = orig <> formatted + | T.last orig /= '\n' && T.last formatted == '\n' = T.init formatted + | otherwise = formatted + + formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit formatEdit origEdit@(J.TextEdit r t) = do -- TODO: are these default FormattingOptions ok? - res <- liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) - let formatEdits = case res of - IdeResultOk xs -> xs - _ -> [origEdit] + formatEdits <- + liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) >>= \case + IdeResultOk xs -> return xs + _ -> return [origEdit] -- let edits = foldl' J.editTextEdit origEdit formatEdits -- TODO: this seems broken. - -- liftIO $ hPutStrLn stderr $ "Text Edits: " ++ show formatEdits - return (J.TextEdit r (J._newText $ head formatEdits)) + return (J.TextEdit r (renormalise t . J._newText $ head formatEdits)) -- behold: the legendary triple mapM newChanges <- (mapM . mapM . mapM) formatEdit mChanges @@ -186,7 +208,7 @@ codeActionProvider plId docId _ context = do applySearchStyle Exact term = "is:exact " <> term applySearchStyle ExactName term = case T.words term of [] -> term - (x:_) -> "is:exact " <> x + (x : _) -> "is:exact " <> x applySearchStyle (Relax relax) term = relax term -- | Turn a search term with function name into Import Actions. @@ -206,7 +228,7 @@ codeActionProvider plId docId _ context = do termToActions style functionName (diagnostic, termName) = do let useImportList = case style of Relax _ -> Nothing - _ -> Just (mkImportAction (Just functionName) diagnostic termName) + _ -> Just (mkImportAction (Just functionName) diagnostic termName) catMaybes <$> sequenceA (mkImportAction Nothing diagnostic termName : maybeToList useImportList) From 32415b899001799983e94a185a2eb30c014fda58 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 1 May 2019 00:35:12 +0100 Subject: [PATCH 09/11] Fix tests --- test/functional/FunctionalCodeActionsSpec.hs | 136 ++++++++++--------- 1 file changed, 72 insertions(+), 64 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 67734c021..61f29f66b 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -139,11 +139,12 @@ spec = describe "code actions" $ do , "main = when True $ putStrLn \"hello\"" ] , -- Multiple import lists, should not introduce multiple newlines. - [ "import Data.Maybe ( fromMaybe )" - , "import Control.Monad ( when )" - , "import System.IO ( hPutStrLn" - , " , stdout" + [ "import System.IO ( stdout" + , " , hPutStrLn" , " )" + , "import Control.Monad ( when )" + , "import Data.Maybe ( fromMaybe )" + , "main :: IO ()" , "main =" , " when True" , " $ hPutStrLn stdout" @@ -164,9 +165,10 @@ spec = describe "code actions" $ do , "main = when True $ putStrLn \"hello\"" ] , -- Multiple import lists, should not introduce multiple newlines. - [ "import Data.Maybe (fromMaybe)" + [ "import System.IO (stdout, hPutStrLn)" , "import Control.Monad (when)" - , "import System.IO (hPutStrLn, stdout)" + , "import Data.Maybe (fromMaybe)" + , "main :: IO ()" , "main =" , " when True" , " $ hPutStrLn stdout" @@ -469,7 +471,7 @@ spec = describe "code actions" $ do -- Parameterized HsImport Spec. -- --------------------------------------------------------------------- hsImportSpec :: T.Text -> [[T.Text]]-> Spec -hsImportSpec formatterName [e1, e2, _] = +hsImportSpec formatterName [e1, e2, e3] = 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" @@ -529,50 +531,48 @@ hsImportSpec formatterName [e1, e2, _] = contents <- getDocumentEdit doc liftIO $ T.lines contents `shouldMatchList` e2 - -- it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do - -- doc <- openDoc "CodeActionImportList.hs" "haskell" - -- _ <- waitForDiagnosticsSource "ghcmod" - - -- let config = def { formattingProvider = formatterName } - -- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) - - -- let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" - -- , "Import module System.IO (stdout)" - -- , "Import module Control.Monad (when)" - -- , "Import module Data.Maybe (fromMaybe)" - -- ] - - -- mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles - - -- contents <- getDocumentEdit doc - -- liftIO $ T.lines contents `shouldBe` e3 - - -- it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do - -- doc <- openDoc "CodeActionImportList.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 System.IO (stdout)" - -- , "Import module Control.Monad (when)" - -- , "Import module Data.Maybe (fromMaybe)" - -- ] - - -- mapM_ (const (executeCodeActionByName doc wantedCodeActionTitles)) wantedCodeActionTitles - - -- contents <- getDocumentEdit doc - -- liftIO $ T.lines contents `shouldBe` - -- [ "import Data.Maybe (fromMaybe)" - -- , "import Control.Monad (when)" - -- , "import System.IO (hPutStrLn, stdout)" - -- , "main :: IO ()" - -- , "main =" - -- , "when True" - -- , " $ hPutStrLn stdout" - -- , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")]" - -- ] + it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportList.hs" "haskell" + + let config = def { formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + , "Import module System.IO (stdout)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + ] + + executeAllCodeActions doc wantedCodeActionTitles + + contents <- documentContents doc + liftIO $ T.lines contents `shouldBe` e3 + + it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImportList.hs" "haskell" + + let config = def { formatOnImportOn = False, formattingProvider = formatterName } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)" + , "Import module System.IO (stdout)" + , "Import module Control.Monad (when)" + , "Import module Data.Maybe (fromMaybe)" + ] + + executeAllCodeActions doc wantedCodeActionTitles + + contents <- documentContents doc + liftIO $ T.lines contents `shouldBe` + [ "import System.IO (stdout, hPutStrLn)" + , "import Control.Monad (when)" + , "import Data.Maybe (fromMaybe)" + , "main :: IO ()" + , "main =" + , " when True" + , " $ hPutStrLn stdout" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportBrittany.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod" @@ -610,19 +610,27 @@ hsImportSpec formatterName [e1, e2, _] = l2 `shouldBe` "import Control.Monad (when)" l3 `shouldBe` "main :: IO ()" l4 `shouldBe` "main = when True $ putStrLn \"hello\"" - -- where - -- executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () - -- executeCodeActionByName doc names = do - -- actionsOrCommands <- getAllCodeActions doc - -- let allActions = map fromAction actionsOrCommands - -- let actions = filter (\actn -> actn ^. L.title `elem` names) allActions - -- case actions of - -- (action:_) -> executeCodeAction action - -- xs -> - -- error - -- $ "Found an unexpected amount of action. Expected 1, but got: " - -- ++ show (length xs) - -- ++ "\n. Titles: " ++ show (map (^. L.title) allActions) + where + executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session () + executeAllCodeActions doc names = + replicateM_ (length names) $ do + _ <- waitForDiagnosticsSource "ghcmod" + executeCodeActionByName doc names + _ <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc + waitForDiagnosticsSource "ghcmod" + + executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session () + executeCodeActionByName doc names = do + actionsOrCommands <- getAllCodeActions doc + let allActions = map fromAction actionsOrCommands + let actions = filter (\actn -> actn ^. L.title `elem` names) allActions + case actions of + (action:_) -> executeCodeAction action + xs -> + error + $ "Found an unexpected amount of action. Expected 1, but got: " + ++ show (length xs) + ++ "\n. Titles: " ++ show (map (^. L.title) allActions) -- Silence warnings hsImportSpec formatter args = From 27a1a179422cc267fd698479ec917df8f9492d68 Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 1 May 2019 15:29:15 +0200 Subject: [PATCH 10/11] Bump hsimport version to 0.8.8 --- stack-8.2.1.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack-8.2.1.yaml b/stack-8.2.1.yaml index 980b3fbb0..216f136c1 100644 --- a/stack-8.2.1.yaml +++ b/stack-8.2.1.yaml @@ -22,7 +22,7 @@ extra-deps: - haskell-lsp-0.9.0.0 - haskell-lsp-types-0.9.0.0 - hlint-2.0.11 -- hsimport-0.8.6 +- hsimport-0.8.8 - lsp-test-0.5.1.1 - monad-dijkstra-0.1.1.2 - mtl-2.2.2 From 049609d41be67c1bf2c85fb9381dd8428891578d Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 1 May 2019 20:04:51 +0200 Subject: [PATCH 11/11] Relax HsImport test to satisfy different import orders --- haskell-ide-engine.cabal | 1 + test/functional/FunctionalCodeActionsSpec.hs | 25 ++++++++++---------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index c6e86ef58..9053c9adc 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -283,6 +283,7 @@ test-suite func-test , lens , text , unordered-containers + , containers ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wredundant-constraints if flag(pedantic) ghc-options: -Werror diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 61f29f66b..c717a521b 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -9,6 +9,7 @@ import Control.Monad.IO.Class import Data.Aeson import Data.Default import qualified Data.HashMap.Strict as HM +import qualified Data.Set as Set import Data.Maybe import Data.Monoid ((<>)) import qualified Data.Text as T @@ -546,7 +547,7 @@ hsImportSpec formatterName [e1, e2, e3] = executeAllCodeActions doc wantedCodeActionTitles contents <- documentContents doc - liftIO $ T.lines contents `shouldBe` e3 + liftIO $ Set.fromList (T.lines contents) `shouldBe` Set.fromList e3 it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportList.hs" "haskell" @@ -561,18 +562,18 @@ hsImportSpec formatterName [e1, e2, e3] = ] executeAllCodeActions doc wantedCodeActionTitles - contents <- documentContents doc - liftIO $ T.lines contents `shouldBe` - [ "import System.IO (stdout, hPutStrLn)" - , "import Control.Monad (when)" - , "import Data.Maybe (fromMaybe)" - , "main :: IO ()" - , "main =" - , " when True" - , " $ hPutStrLn stdout" - , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" - ] + liftIO $ Set.fromList (T.lines contents) `shouldBe` + Set.fromList + [ "import System.IO (stdout, hPutStrLn)" + , "import Control.Monad (when)" + , "import Data.Maybe (fromMaybe)" + , "main :: IO ()" + , "main =" + , " when True" + , " $ hPutStrLn stdout" + , " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")" + ] it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImportBrittany.hs" "haskell" _ <- waitForDiagnosticsSource "ghcmod"