diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,52 @@ +# Qualify Imported Names + +![Qualify Imported Names Demo](qualify-imported-names-demo.gif) + +## Summary + +Rewrite imported names to be qualified. + +## Motivation + +You've imported a number of modules, and have written a lot of code with unqualified names. You want to import a new module but you know there will be a number name clashes so you want to switch your current usage of names to be qualified. + +It would be nice if you could change +``` +import Blah +``` +to +``` +import Blah as Bloo +``` +then magically qualify all the previous names imported from `Blah` with `Bloo`. After doing that you could then change +``` +import Blah as Bloo +``` +to +``` +import qualified Blah as Bloo +``` +and import your the new module using names from it without worry. + +Well, now you can... + +## Usage + +1. Put cursor over the import declaration you want to qualify names from. +2. Initiate a Code Action. +3. Select `Qualify imported names`. + +## Features +- Names are qualified on a per-import declaration basis. +- Names are qualified by the imported module's alias if it has one, otherwise by the imported module's name. +- If the import declaration has an explicit import list then the plugin will qualify only names on the list. +- If the import declaration has an explicit hiding list then the plugin will qualify names from the imported module that are not on the list. + +## Future possibilities +- It may be possible to use the LSP rename functionality to ask for a name so that we don't have to do the `as Alias` dance. + +## Change log +### 1.0.0.1 +- GHC 9.2.1 compatibility +### 1.0.0.0 +- Released... diff --git a/hls-qualify-imported-names-plugin.cabal b/hls-qualify-imported-names-plugin.cabal new file mode 100644 --- /dev/null +++ b/hls-qualify-imported-names-plugin.cabal @@ -0,0 +1,54 @@ +cabal-version: 2.2 +name: hls-qualify-imported-names-plugin +version: 1.0.1.0 +synopsis: A Haskell Language Server plugin that qualifies imported names +description: + Please see the README on GitHub at +license: Apache-2.0 +license-file: LICENSE +author: Jonathan Shen +maintainer: shenjonathan0@gmail.com +category: Development +build-type: Simple +extra-source-files: + LICENSE + qualify-imported-names-demo.gif + README.md + test/data/*.hs + test/data/*.yaml + +library + exposed-modules: Ide.Plugin.QualifyImportedNames + hs-source-dirs: src + build-depends: + , aeson + , base >=4.12 && <5 + , containers + , deepseq + , ghc + , ghcide ^>=1.6 + , hls-graph + , hls-plugin-api ^>=1.3 + , lsp + , text + , unordered-containers + , dlist + , transformers + + default-language: Haskell2010 + default-extensions: + DataKinds + TypeOperators + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + , base + , text + , filepath + , hls-qualify-imported-names-plugin + , hls-test-utils ^>=1.2 diff --git a/qualify-imported-names-demo.gif b/qualify-imported-names-demo.gif new file mode 100644 Binary files /dev/null and b/qualify-imported-names-demo.gif differ diff --git a/src/Ide/Plugin/QualifyImportedNames.hs b/src/Ide/Plugin/QualifyImportedNames.hs new file mode 100644 --- /dev/null +++ b/src/Ide/Plugin/QualifyImportedNames.hs @@ -0,0 +1,261 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module Ide.Plugin.QualifyImportedNames (descriptor) where + +import Control.Monad (foldM) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.State.Strict (State) +import qualified Control.Monad.Trans.State.Strict as State +import Data.DList (DList) +import qualified Data.DList as DList +import Data.Foldable (Foldable (foldl'), find) +import qualified Data.HashMap.Strict as HashMap +import Data.List (sortOn) +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import qualified Data.Text as Text +import Development.IDE.Core.RuleTypes (GetFileContents (GetFileContents), + GetHieAst (GetHieAst), + HieAstResult (HAR, refMap), + TcModuleResult (TcModuleResult, tmrParsed, tmrTypechecked), + TypeCheck (TypeCheck)) +import Development.IDE.Core.Service (runAction) +import Development.IDE.Core.Shake (IdeState, use) +import Development.IDE.GHC.Compat (ContextInfo (Use), + GenLocated (..), GhcPs, + GlobalRdrElt, GlobalRdrEnv, + HsModule (hsmodImports), + Identifier, + IdentifierDetails (IdentifierDetails, identInfo), + ImpDeclSpec (ImpDeclSpec, is_as, is_dloc, is_qual), + ImportSpec (ImpSpec), + LImportDecl, ModuleName, + Name, NameEnv, OccName, + ParsedModule, RefMap, Span, + SrcSpan, + TcGblEnv (tcg_rdr_env), + emptyUFM, globalRdrEnvElts, + gre_imp, gre_name, locA, + lookupNameEnv, + moduleNameString, + nameOccName, occNameString, + pattern GRE, + pattern ParsedModule, + plusUFM_C, pm_parsed_source, + srcSpanEndCol, + srcSpanEndLine, + srcSpanStartCol, + srcSpanStartLine, unitUFM) +import Development.IDE.GHC.Error (isInsideSrcSpan) +import Development.IDE.Types.Diagnostics (List (List)) +import Development.IDE.Types.Location (NormalizedFilePath, + Position (Position), + Range (Range), Uri, + toNormalizedUri) +import Ide.Types (PluginDescriptor (pluginHandlers), + PluginId, + PluginMethodHandler, + defaultPluginDescriptor, + mkPluginHandler) +import Language.LSP.Types (CodeAction (CodeAction, _command, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title, _xdata), + CodeActionKind (CodeActionQuickFix), + CodeActionParams (CodeActionParams), + Method (TextDocumentCodeAction), + SMethod (STextDocumentCodeAction), + TextDocumentIdentifier (TextDocumentIdentifier), + TextEdit (TextEdit), + WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), + type (|?) (InR), + uriToNormalizedFilePath) + +thenCmp :: Ordering -> Ordering -> Ordering +{-# INLINE thenCmp #-} +thenCmp EQ ordering = ordering +thenCmp ordering _ = ordering + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor pluginId = (defaultPluginDescriptor pluginId) { + pluginHandlers = mconcat + [ mkPluginHandler STextDocumentCodeAction codeActionProvider + ] +} + +isRangeWithinSrcSpan :: Range -> SrcSpan -> Bool +isRangeWithinSrcSpan (Range start end) srcSpan = + isInsideSrcSpan start srcSpan && isInsideSrcSpan end srcSpan + +findLImportDeclAt :: Range -> ParsedModule -> Maybe (LImportDecl GhcPs) +findLImportDeclAt range parsedModule + | ParsedModule {..} <- parsedModule + , L _ hsModule <- pm_parsed_source + , locatedImportDecls <- hsmodImports hsModule = + find (\ (L (locA -> srcSpan) _) -> isRangeWithinSrcSpan range srcSpan) locatedImportDecls + +makeCodeActions :: Uri -> [TextEdit] -> [a |? CodeAction] +makeCodeActions uri textEdits = [InR CodeAction {..} | not (null textEdits)] + where _title = "Qualify imported names" + _kind = Just CodeActionQuickFix + _command = Nothing + _edit = Just WorkspaceEdit {..} + _changes = Just $ HashMap.singleton uri $ List textEdits + _documentChanges = Nothing + _diagnostics = Nothing + _isPreferred = Nothing + _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing + +getTypeCheckedModule :: IdeState -> NormalizedFilePath -> IO (Maybe TcModuleResult) +getTypeCheckedModule ideState normalizedFilePath = + runAction "QualifyImportedNames.TypeCheck" ideState (use TypeCheck normalizedFilePath) + +getHieAst :: IdeState -> NormalizedFilePath -> IO (Maybe HieAstResult) +getHieAst ideState normalizedFilePath = + runAction "QualifyImportedNames.GetHieAst" ideState (use GetHieAst normalizedFilePath) + +getSourceText :: IdeState -> NormalizedFilePath -> IO (Maybe Text) +getSourceText ideState normalizedFilePath = do + fileContents <- runAction "QualifyImportedNames.GetFileContents" ideState (use GetFileContents normalizedFilePath) + if | Just (_, sourceText) <- fileContents -> pure sourceText + | otherwise -> pure Nothing + +data ImportedBy = ImportedBy { + importedByAlias :: !ModuleName, + importedBySrcSpan :: !SrcSpan +} + +isRangeWithinImportedBy :: Range -> ImportedBy -> Bool +isRangeWithinImportedBy range (ImportedBy _ srcSpan) = isRangeWithinSrcSpan range srcSpan + +globalRdrEnvToNameToImportedByMap :: GlobalRdrEnv -> NameEnv [ImportedBy] +globalRdrEnvToNameToImportedByMap = + fmap DList.toList . foldl' (plusUFM_C (<>)) emptyUFM . map globalRdrEltToNameToImportedByMap . globalRdrEnvElts + where + globalRdrEltToNameToImportedByMap :: GlobalRdrElt -> NameEnv (DList ImportedBy) + globalRdrEltToNameToImportedByMap GRE {..} = + unitUFM gre_name $ DList.fromList $ mapMaybe importSpecToImportedBy gre_imp + + importSpecToImportedBy :: ImportSpec -> Maybe ImportedBy + importSpecToImportedBy (ImpSpec ImpDeclSpec {..} _) + | is_qual = Nothing + | otherwise = Just (ImportedBy is_as is_dloc) + +data IdentifierSpan = IdentifierSpan { + identifierSpanLine :: !Int, + identifierSpanStartCol :: !Int, + identifierSpanEndCol :: !Int +} deriving (Show, Eq) + +instance Ord IdentifierSpan where + compare (IdentifierSpan line1 startCol1 endCol1) (IdentifierSpan line2 startCol2 endCol2) = + (line1 `compare` line2) `thenCmp` (startCol1 `compare` startCol2) `thenCmp` (endCol1 `compare` endCol2) + +realSrcSpanToIdentifierSpan :: Span -> Maybe IdentifierSpan +realSrcSpanToIdentifierSpan realSrcSpan + | let startLine = srcSpanStartLine realSrcSpan - 1 + , let endLine = srcSpanEndLine realSrcSpan - 1 + , startLine == endLine + , let startCol = srcSpanStartCol realSrcSpan - 1 + , let endCol = srcSpanEndCol realSrcSpan - 1 = + Just $ IdentifierSpan startLine startCol endCol + | otherwise = Nothing + +identifierSpanToRange :: IdentifierSpan -> Range +identifierSpanToRange (IdentifierSpan line startCol endCol) = + Range (Position (fromIntegral line) (fromIntegral startCol)) (Position (fromIntegral line) (fromIntegral endCol)) + +data UsedIdentifier = UsedIdentifier { + usedIdentifierName :: !Name, + usedIdentifierSpan :: !IdentifierSpan +} + +refMapToUsedIdentifiers :: RefMap a -> [UsedIdentifier] +refMapToUsedIdentifiers = DList.toList . Map.foldlWithKey' folder DList.empty + where + folder acc identifier spanIdentifierDetailsPairs = + DList.fromList (mapMaybe (uncurry (getUsedIdentifier identifier)) spanIdentifierDetailsPairs) <> acc + + getUsedIdentifier :: Identifier -> Span -> IdentifierDetails a -> Maybe UsedIdentifier + getUsedIdentifier identifier span IdentifierDetails {..} + | Just identifierSpan <- realSrcSpanToIdentifierSpan span + , Right name <- identifier + , Use `elem` identInfo = Just $ UsedIdentifier name identifierSpan + | otherwise = Nothing + +occNameToText :: OccName -> Text +occNameToText = Text.pack . occNameString + +updateColOffset :: Int -> Int -> Int -> Int +updateColOffset row lineOffset colOffset + | row == lineOffset = colOffset + | otherwise = 0 + +usedIdentifiersToTextEdits :: Range -> NameEnv [ImportedBy] -> Text -> [UsedIdentifier] -> [TextEdit] +usedIdentifiersToTextEdits range nameToImportedByMap sourceText usedIdentifiers + | let sortedUsedIdentifiers = sortOn usedIdentifierSpan usedIdentifiers = + State.evalState (makeStateComputation sortedUsedIdentifiers) (Text.lines sourceText, 0, 0) + where + folder :: [TextEdit] -> UsedIdentifier -> State ([Text], Int, Int) [TextEdit] + folder prevTextEdits (UsedIdentifier identifierName identifierSpan) + | Just importedBys <- lookupNameEnv nameToImportedByMap identifierName + , Just (ImportedBy alias _) <- find (isRangeWithinImportedBy range) importedBys + , let IdentifierSpan row startCol endCol = identifierSpan + , let identifierRange = identifierSpanToRange identifierSpan + , let aliasText = Text.pack $ moduleNameString alias + , let identifierText = Text.pack $ occNameString $ nameOccName identifierName + , let qualifiedIdentifierText = aliasText <> "." <> identifierText = do + (sourceTextLines, lineOffset, updateColOffset row lineOffset -> colOffset) <- State.get + let lines = List.drop (row - lineOffset) sourceTextLines + let (replacementText, remainingLines) = + if | line : remainingLines <- lines + , let lineStartingAtIdentifier = Text.drop (startCol - colOffset) line + , Just (c, _) <- Text.uncons lineStartingAtIdentifier + , let isParenthesized = c == '(' + , let isBackticked = c == '`' + , let replacementText = + if | isParenthesized -> "(" <> qualifiedIdentifierText <> ")" + | isBackticked -> "`" <> qualifiedIdentifierText <> "`" + | otherwise -> qualifiedIdentifierText -> + (replacementText, lineStartingAtIdentifier : remainingLines) + | otherwise -> (qualifiedIdentifierText, lines) + let textEdit = TextEdit identifierRange replacementText + State.put (remainingLines, row, startCol) + pure $ textEdit : prevTextEdits + | otherwise = pure prevTextEdits + + makeStateComputation :: [UsedIdentifier] -> State ([Text], Int, Int) [TextEdit] + makeStateComputation usedIdentifiers = foldM folder [] usedIdentifiers + +-- The overall idea: +-- 1. GlobalRdrEnv from typechecking phase contains info on what imported a +-- name. +-- 2. refMap from GetHieAst contains location of names and how they are used. +-- 3. For each used name in refMap check whether the name comes from an import +-- at the origin of the code action. +codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction +codeActionProvider ideState pluginId (CodeActionParams _ _ documentId range context) + | TextDocumentIdentifier uri <- documentId + , Just normalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri) = liftIO $ do + tcModuleResult <- getTypeCheckedModule ideState normalizedFilePath + if | Just TcModuleResult { tmrParsed, tmrTypechecked } <- tcModuleResult + , Just _ <- findLImportDeclAt range tmrParsed -> do + hieAstResult <- getHieAst ideState normalizedFilePath + sourceText <- getSourceText ideState normalizedFilePath + if | Just HAR {..} <- hieAstResult + , Just sourceText <- sourceText + , let globalRdrEnv = tcg_rdr_env tmrTypechecked + , let nameToImportedByMap = globalRdrEnvToNameToImportedByMap globalRdrEnv + , let usedIdentifiers = refMapToUsedIdentifiers refMap + , let textEdits = usedIdentifiersToTextEdits range nameToImportedByMap sourceText usedIdentifiers -> + pure $ Right $ List (makeCodeActions uri textEdits) + | otherwise -> pure $ Right $ List [] + | otherwise -> pure $ Right $ List [] + | otherwise = pure $ Right $ List [] + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} + +module Main (main) where + +import Data.Foldable (find) +import Data.Text (Text) +import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames +import System.FilePath (()) +import Test.Hls (CodeAction (CodeAction, _title), + Command (Command), IdeState, + MonadIO (liftIO), + PluginDescriptor, + Position (Position), + Range (Range), Session, + TestName, TestTree, + TextDocumentIdentifier, + assertBool, assertFailure, + defaultTestRunner, + executeCodeAction, + getCodeActions, + goldenWithHaskellDoc, openDoc, + rename, runSessionWithServer, + testCase, testGroup, + type (|?) (InR), (@?=)) + +import Prelude + +-- 1's based +data Point = Point { + line :: !Int, + column :: !Int +} + +makePoint line column + | line >= 1 && column >= 1 = Point line column + | otherwise = error "Line or column is less than 1." + +isNotEmpty :: Foldable f => f a -> Bool +isNotEmpty = not . isEmpty + +isEmpty :: Foldable f => f a -> Bool +isEmpty = null + +makeCodeActionNotFoundAtString :: Point -> String +makeCodeActionNotFoundAtString Point {..} = + "CodeAction not found at line: " <> show line <> ", column: " <> show column + +makeCodeActionFoundAtString :: Point -> String +makeCodeActionFoundAtString Point {..} = + "CodeAction found at line: " <> show line <> ", column: " <> show column + +main :: IO () +main = defaultTestRunner $ testGroup "Qualify Imported Names" + [ + testCase "No CodeAction when not at import" $ + runSessionWithServer pluginDescriptor testDataDir $ do + let point = makePoint 1 1 + document <- openDoc "NoImport.hs" "haskell" + actions <- getCodeActions document $ pointToRange point + liftIO $ assertBool (makeCodeActionFoundAtString point) (isEmpty actions) + , testCase "No CodeAction when import is qualified" $ + runSessionWithServer pluginDescriptor testDataDir $ do + let point = makePoint 3 1 + document <- openDoc "QualifiedImport.hs" "haskell" + actions <- getCodeActions document $ pointToRange point + liftIO $ assertBool (makeCodeActionFoundAtString point) (isEmpty actions) + , codeActionGoldenTest + "CodeAction qualifies names with alias if imported module is aliased" + "AliasedImport" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies names with module name if imported module is not aliased" + "UnaliasedImport" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies only names in import's explicit non-hiding list" + "ExplicitImport" + (makePoint 4 1) + , codeActionGoldenTest + "CodeAction qualifies only names outside of import's explicit hiding list" + "ExplicitHidingImport" + (makePoint 4 1) + , codeActionGoldenTest + "CodeAction can qualify names not defined in modules they are imported from" + "Reexported" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction can qualify explicitly imported Prelude" + "ExplicitPrelude" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies only imported names" + "OnlyImportedNames" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies parenthesized operators properly" + "Parenthesized" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies backticked operators properly" + "Backticked" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction qualifies parenthesized and backticked operators on the same line properly" + "SameLine" + (makePoint 3 1) + , codeActionGoldenTest + "CodeAction doesn't qualify already qualified names" + "NoDoubleQualify" + (makePoint 3 1) + ] + +codeActionGoldenTest :: TestName -> FilePath -> Point -> TestTree +codeActionGoldenTest testCaseName goldenFilename point = + goldenWithQualifyImportedNames testCaseName goldenFilename $ \document -> do + actions <- getCodeActions document $ pointToRange point + case find ((== Just "Qualify imported names") . getCodeActionTitle) actions of + Just (InR codeAction) -> executeCodeAction codeAction + _ -> liftIO $ assertFailure $ makeCodeActionNotFoundAtString point + +testDataDir :: String +testDataDir = "test" "data" + +pluginDescriptor :: PluginDescriptor IdeState +pluginDescriptor = QualifyImportedNames.descriptor "qualifyImportedNames" + +getCodeActionTitle :: (Command |? CodeAction) -> Maybe Text +getCodeActionTitle commandOrCodeAction + | InR CodeAction {_title} <- commandOrCodeAction = Just _title + | otherwise = Nothing + +goldenWithQualifyImportedNames :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithQualifyImportedNames testName path = + goldenWithHaskellDoc pluginDescriptor testName testDataDir path "expected" "hs" + +pointToRange :: Point -> Range +pointToRange Point {..} + | line <- fromIntegral $ subtract 1 line + , column <- fromIntegral $ subtract 1 column = + Range (Position line column) (Position line $ column + 1) + diff --git a/test/data/A.hs b/test/data/A.hs new file mode 100644 --- /dev/null +++ b/test/data/A.hs @@ -0,0 +1,12 @@ +module A (module B, a, b, op) where + +import B + +a :: Int -> Int +a = id + +b :: String -> String +b = id + +op :: Int -> Int -> Int +op = (+) diff --git a/test/data/AliasedImport.hs b/test/data/AliasedImport.hs new file mode 100644 --- /dev/null +++ b/test/data/AliasedImport.hs @@ -0,0 +1,6 @@ +module AliasedImport where + +import A as B + +thing = a + diff --git a/test/data/B.hs b/test/data/B.hs new file mode 100644 --- /dev/null +++ b/test/data/B.hs @@ -0,0 +1,7 @@ +module B where + +c :: Int +c = 3 + +d :: String +d = "d" diff --git a/test/data/Backticked.hs b/test/data/Backticked.hs new file mode 100644 --- /dev/null +++ b/test/data/Backticked.hs @@ -0,0 +1,10 @@ +module Backticked where + +import Prelude + +f a b = a `elem` b + +g a b = + let h = f a b + in a `elem` b + diff --git a/test/data/ExplicitHidingImport.hs b/test/data/ExplicitHidingImport.hs new file mode 100644 --- /dev/null +++ b/test/data/ExplicitHidingImport.hs @@ -0,0 +1,8 @@ +module ExplicitHidingImport where + +import A +import A hiding (b) + +thing1 = a +thing2 = b + diff --git a/test/data/ExplicitImport.hs b/test/data/ExplicitImport.hs new file mode 100644 --- /dev/null +++ b/test/data/ExplicitImport.hs @@ -0,0 +1,8 @@ +module ExplicitImport where + +import A (a) +import A (b) + +thing1 = a +thing2 = b + diff --git a/test/data/ExplicitPrelude.hs b/test/data/ExplicitPrelude.hs new file mode 100644 --- /dev/null +++ b/test/data/ExplicitPrelude.hs @@ -0,0 +1,10 @@ +module ExplicitPrelude where + +import Prelude + +f :: String -> Int -> Maybe Bool +f a b = Just False + +class Functor f => MyClass f where + method :: f Int + diff --git a/test/data/NoDoubleQualify.hs b/test/data/NoDoubleQualify.hs new file mode 100644 --- /dev/null +++ b/test/data/NoDoubleQualify.hs @@ -0,0 +1,7 @@ +module NoDoubleQualify where + +import A as AAA + +thing = AAA.a +thing2 = (AAA.op) +thing3 = 1 `AAA.op` 2 diff --git a/test/data/NoImport.hs b/test/data/NoImport.hs new file mode 100644 --- /dev/null +++ b/test/data/NoImport.hs @@ -0,0 +1,4 @@ +module NoImport where + +f = 3 + diff --git a/test/data/OnlyImportedNames.hs b/test/data/OnlyImportedNames.hs new file mode 100644 --- /dev/null +++ b/test/data/OnlyImportedNames.hs @@ -0,0 +1,16 @@ +module OnlyImportedNames where + +import A + +thing1 a = a + +thing2 b = b + +thing3 = f1 a c + +thing4 = f2 b d + +f1 a = a + +f2 c b = let { d = "k"; e = a } in c d ++ c b + diff --git a/test/data/Parenthesized.hs b/test/data/Parenthesized.hs new file mode 100644 --- /dev/null +++ b/test/data/Parenthesized.hs @@ -0,0 +1,6 @@ +module Parenthesized where + +import Prelude + +thing :: [Int] -> [Int] -> [Int] +thing = (<>) diff --git a/test/data/QualifiedImport.hs b/test/data/QualifiedImport.hs new file mode 100644 --- /dev/null +++ b/test/data/QualifiedImport.hs @@ -0,0 +1,4 @@ +module QualifiedImport where + +import qualified A + diff --git a/test/data/Reexported.hs b/test/data/Reexported.hs new file mode 100644 --- /dev/null +++ b/test/data/Reexported.hs @@ -0,0 +1,6 @@ +module Reexported where + +import A + +thing = c + diff --git a/test/data/SameLine.hs b/test/data/SameLine.hs new file mode 100644 --- /dev/null +++ b/test/data/SameLine.hs @@ -0,0 +1,5 @@ +module SameLine where + +import A + +thing = ((a) . (a) . (a)) (1 `op` 2 `op` 3 `op` 4) diff --git a/test/data/UnaliasedImport.hs b/test/data/UnaliasedImport.hs new file mode 100644 --- /dev/null +++ b/test/data/UnaliasedImport.hs @@ -0,0 +1,6 @@ +module UnaliasedImport where + +import A + +thing = a + diff --git a/test/data/hie.yaml b/test/data/hie.yaml new file mode 100644 --- /dev/null +++ b/test/data/hie.yaml @@ -0,0 +1,17 @@ +cradle: + direct: + arguments: + - A.hs + - B.hs + - QualifiedImport.hs + - NoImport.hs + - AliasedImport.hs + - UnaliasedImport.hs + - ExplicitImport.hs + - ExplicitHidingImport.hs + - Reexported.hs + - ExplicitPrelude.hs + - OnlyImportedNames.hs + - Parenthesized.hs + - Backticked.hs +