From a4db4717cc2f484ab8fd87c9c89a4b2868b8e545 Mon Sep 17 00:00:00 2001 From: Greg Baimetov Date: Wed, 30 Oct 2024 19:25:54 -0700 Subject: [PATCH] Saving changes --- src/StaticLS/IDE/CodeActions/AutoImport.hs | 2 + .../IDE/CodeActions/RemoveRedundantImports.hs | 102 +++++++++++++----- 2 files changed, 75 insertions(+), 29 deletions(-) diff --git a/src/StaticLS/IDE/CodeActions/AutoImport.hs b/src/StaticLS/IDE/CodeActions/AutoImport.hs index 515b407..7bcf710 100644 --- a/src/StaticLS/IDE/CodeActions/AutoImport.hs +++ b/src/StaticLS/IDE/CodeActions/AutoImport.hs @@ -35,6 +35,8 @@ import StaticLS.Monad import StaticLS.StaticEnv (runHieDbExceptT) import StaticLS.Tree qualified as Tree import StaticLS.Utils +import Data.List qualified as UselessImport -- useless import + findModulesForDefQuery :: HieDb -> Text -> IO [Text] findModulesForDefQuery (getConn -> conn) name = do diff --git a/src/StaticLS/IDE/CodeActions/RemoveRedundantImports.hs b/src/StaticLS/IDE/CodeActions/RemoveRedundantImports.hs index 27a8f25..a57f4bb 100644 --- a/src/StaticLS/IDE/CodeActions/RemoveRedundantImports.hs +++ b/src/StaticLS/IDE/CodeActions/RemoveRedundantImports.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} -- whee9hefiu +{-# LANGUAGE OverloadedStrings #-} module StaticLS.IDE.CodeActions.RemoveRedundantImports where @@ -10,7 +10,8 @@ import Data.Edit import Data.Map () import Data.Path import Data.Foldable -import Data.Pos qualified as Pos +import Data.Pos (Pos (..)) +import Data.Range (Range (..)) import Data.Range qualified as Range import Data.Rope qualified as Rope import Data.Text qualified as Text @@ -20,17 +21,18 @@ import StaticLS.IDE.Diagnostics import StaticLS.IDE.Diagnostics.ParseGHC import StaticLS.IDE.FileWith import StaticLS.IDE.SourceEdit as SourceEdit -import StaticLS.IDE.Monad +import StaticLS.IDE.Monad as Monad import StaticLS.Monad import StaticLS.StaticEnv import System.FilePath -import System.IO import Data.LineCol import Data.Maybe import StaticLS.Tree - -debugStrLn :: MonadIO m => String -> m () -debugStrLn str = liftIO $ withFile "/Users/gb/.staticls-debug" AppendMode $ \handle -> hPutStrLn handle str +import Control.Applicative +import Control.Monad.Trans.Maybe +import StaticLS.Semantic +import Data.Functor --fioejwoi +import Data.List qualified as List ghcidFile :: FilePath ghcidFile = "ghcid.txt" @@ -38,15 +40,14 @@ ghcidFile = "ghcid.txt" codeAction :: CodeActionContext -> StaticLsM [Assist] codeAction CodeActionContext {path, lineCol, pos} = do diagnostics <- getDiagnostics - forM_ diagnostics (debugStrLn . show) - let globalRedundantImportDiagnostics = filter isRedundantImportDiagnostic diagnostics + let globalRedundantImportDiagnostics = filter (and . sequence [isRedundantImportDiagnostic, not . isPartialDiagnostic]) diagnostics let localRedundantImportDiagnostics = filter (isDiagnosticInFile path) globalRedundantImportDiagnostics let diagnosticsToAssist message diagnostics = do let numFixes = length diagnostics - let fixCase = if numFixes == 1 then "fix" else "fixes" + let fixCase = if numFixes == 1 then "fix" else "fixes" let message' = message <> " (" <> (Text.pack . show) numFixes <> " " <> fixCase <> ")" mkAssist message' <$> actOnDiagnostics diagnostics - globalAssist <- diagnosticsToAssist "[BEWARE!!!] Remove redundant imports in project" globalRedundantImportDiagnostics -- Does not work reliably yet. + globalAssist <- diagnosticsToAssist "Remove redundant imports in project" globalRedundantImportDiagnostics localAssist <- diagnosticsToAssist "Remove redundant imports in file" localRedundantImportDiagnostics pure [localAssist, globalAssist] @@ -73,23 +74,40 @@ isRedundantImportDiagnostic diagnostic = do let isSuffixCorrect = Text.isInfixOf "is redundant" dmessage isPrefixCorrect && isSuffixCorrect +isPartialDiagnostic :: Diagnostic -> Bool +isPartialDiagnostic diagnostic = Text.isInfixOf "from module" diagnostic.message + isDiagnosticInFile :: AbsPath -> Diagnostic -> Bool isDiagnosticInFile curPath diagnostic = do let dpath = diagnostic.range.path toFilePath dpath == toFilePath curPath createDeletion :: Diagnostic -> StaticLsM SourceEdit -createDeletion diagnostic = do +createDeletion diagnostic = if isPartialDiagnostic diagnostic then createPartialDeletion diagnostic else createFullDeletion diagnostic + +createFullDeletion :: Diagnostic -> StaticLsM SourceEdit +createFullDeletion diagnostic = do let path = diagnostic.range.path - sourceRope <- getSourceRope path - let loc = Rope.lineColRangeToRange sourceRope diagnostic.range.loc - node <- getImportAtLoc path loc - let edit = case node of - Nothing -> SourceEdit.empty - Just hsImport -> single path (delete $ extend sourceRope $ AST.nodeToRange hsImport) - pure edit - -getImportAtLoc :: AbsPath -> Range.Range -> StaticLsM (Maybe Haskell.Import) + isSaved <- pure True -- isFileSaved path + if isSaved + then do + sourceRope <- getSourceRope path + haskell <- getHaskell path + let loc = Rope.lineColRangeToRange sourceRope diagnostic.range.loc + node <- getImportAtLoc path loc + let edit = case node of + Nothing -> SourceEdit.empty + Just hsImport -> single path (delete $ extend sourceRope haskell $ AST.nodeToRange hsImport) + pure edit + else pure SourceEdit.empty + +createPartialDeletion :: Diagnostic -> StaticLsM SourceEdit +createPartialDeletion diagnostic = do + -- let startChar = '‘' + -- let endChar = '’' + pure SourceEdit.empty + +getImportAtLoc :: AbsPath -> Range -> StaticLsM (Maybe Haskell.Import) getImportAtLoc path loc = do haskell <- getHaskell path let imports = getImports haskell @@ -99,18 +117,44 @@ getImportAtLoc path loc = do let hsImport = find (\imp -> (AST.nodeToRange imp) `Range.containsRange` loc) importList pure hsImport -extend :: Rope.Rope -> Range.Range -> Range.Range -extend rope range@(Range.Range start end) = do +isFileSaved :: AbsPath -> StaticLsM Bool +isFileSaved absPath = do + fileState <- getFileState absPath + hieSource <- runMaybeT $ Monad.getHieSource absPath + pure $ case hieSource of + Just src -> src == fileState.contentsText + Nothing -> False + +-- This is not used right now. (The current (2024-10-30) behavior is to not extend at all) +extend :: Rope.Rope -> Haskell.Haskell -> Range -> Range +extend rope haskell range@(Range start end) = do let newEnd = fromMaybe end $ lastPosOnLine rope end - Range.Range start newEnd + let nodePred node = if (AST.nodeRange node).start.pos > start.pos then Just node else Nothing + let node = getDeepestContainingSatisfying nodePred (Range.point newEnd) haskell.dynNode + -- let comment = AST.getDeepestContaining @Haskell.Comment (Range.point newEnd) haskell.dynNode + -- let pragma = AST.getDeepestContaining @Haskell.Pragma (Range.point newEnd) haskell.dynNode + -- let node = fmap AST.nodeToRange comment <|> fmap AST.nodeToRange pragma d + let newEnd' = case node of + Nothing -> newEnd + Just cmt -> (AST.nodeToRange cmt).end + Range (Pos $ start.pos - 1) newEnd' --- lastPosOnLine :: Rope.Rope -> Pos.Pos -> Maybe Pos.Pol -lastPosOnLine :: Rope.Rope -> Pos.Pos -> Maybe Pos.Pos -lastPosOnLine rope pos@(Pos.Pos posidx) = do +lastPosOnLine :: Rope.Rope -> Pos -> Maybe Pos +lastPosOnLine rope pos@(Pos posidx) = do let lineCol = Rope.posToLineCol rope pos lineLen <- Text.length . Rope.toText <$> Rope.getLine rope lineCol.line - let (Pos.Pos col) = lineCol.col + let (Pos col) = lineCol.col let diff = lineLen - col - let newPos = Pos.Pos (posidx + diff) + let newPos = Pos (posidx + diff - 1) pure newPos + +getDeepestContainingSatisfying :: (AST.DynNode -> Maybe b) -> Range -> AST.DynNode -> Maybe b +getDeepestContainingSatisfying f range node = go node + where + go n = + ( do + n' <- List.find (\n -> n.nodeRange `Range.containsRange` range) n.nodeChildren + go n' + ) + <|> f n