Saving changes

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

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,33 +21,33 @@ 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"
 
 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