Update branch to main

expect_tests/HirTest.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 
-module HirTest (tests) where
+module HirTest where
 
 import AST.Haskell qualified as H
 import Data.Text qualified as T
@@ -19,9 +19,10 @@ checkParse name source ex = test name ex $ do
 checkHir :: String -> T.Text -> Expect -> TestTree
 checkHir name source ex = test name ex $ do
   let tree = H.parse source
-  let (es, hir) = Hir.parseHaskell tree
+  let (_es, hir) = Hir.parseHaskell tree
   pure $ TL.toStrict $ Pretty.pShowNoColor hir
 
+src1 :: T.Text
 src1 =
   [trimming|
   module First where
@@ -30,6 +31,7 @@ src1 =
   import Second (First, C(.., first, type Another, (+++))) as Another
   |]
 
+src2 :: T.Text
 src2 =
   [trimming|
   module Second
@@ -43,6 +45,7 @@ src2 =
 
   |]
 
+src3 :: T.Text
 src3 =
   [trimming|
   module Third where
@@ -74,6 +77,7 @@ src3 =
     first :: a -> a
   |]
 
+tests :: TestTree
 tests =
   testGroup
     "HirTest"

expect_tests/Main.hs

@@ -1,6 +1,5 @@
 module Main where
 
-import Data.Text qualified as T
 import HirTest qualified
 import Test.Tasty
 import Test.Tasty.Expect

package.yaml

@@ -39,6 +39,7 @@ dependencies:
   - sqlite-simple >= 0.4.18 && < 0.5
   - template-haskell >= 2.19.0 && < 2.23
   - text >= 2.0.1 && < 2.2
+  - time >= 1.0 && < 2.0
   - bytestring >=0.10 && <0.13
   - transformers >= 0.5.6.2 && < 0.7
   - unliftio-core >= 0.2.1 && < 0.3

src/Data/ConcurrentCache.hs

@@ -7,15 +7,19 @@
 module Data.ConcurrentCache (
   ConcurrentCache,
   new,
+  Data.ConcurrentCache.lookup,
   remove,
   insert,
 ) where
 
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Maybe
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
 import Data.Hashable (Hashable)
+import StaticLS.Maybe
 import UnliftIO (onException)
 import UnliftIO.Exception (mask)
 import UnliftIO.IORef (IORef)
@@ -37,6 +41,13 @@ remove k cache = do
   IORef.atomicModifyIORef' cache.map \m -> do
     (HashMap.delete k m, ())
 
+lookup :: (MonadIO m, Hashable k) => k -> ConcurrentCache k v -> m (Maybe v)
+lookup k cache = do
+  runMaybeT $ do
+    cacheMap <- lift $ IORef.readIORef cache.map
+    (m :: MVar (Maybe v)) <- toAlt $ HashMap.lookup k cacheMap
+    MaybeT $ MVar.readMVar m
+
 insert :: (Hashable k, MonadUnliftIO m) => k -> m v -> ConcurrentCache k v -> m v
 insert k act cache = mask \restore -> do
   var <- MVar.newEmptyMVar

src/StaticLS/Except.hs

@@ -3,8 +3,6 @@ module StaticLS.Except where
 import Control.Error.Util
 import Control.Monad.Trans.Except
 import Data.Pos (Pos (..))
-import Data.Text (Text)
-import StaticLS.HieView.View
 
 exceptToMaybe :: Except a b -> Maybe b
 exceptToMaybe = hush . runExcept

src/StaticLS/FilePath.hs

@@ -1,14 +1,23 @@
-module StaticLS.FilePath (modToFilePath, subRootExtensionFilepath) where
+module StaticLS.FilePath (modToFilePath, subRootExtensionFilepath, getFileModifiedAt) where
 
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Maybe
 import Data.List qualified as List
 import Data.Path (AbsPath, Path (..), RelPath)
 import Data.Path qualified as Path
+import Data.Time
 import GHC.Plugins qualified as GHC
 import StaticLS.SrcFiles
 import System.Directory qualified as Dir
 import System.FilePath ((-<.>))
+import System.IO.Error
+
+getFileModifiedAt :: (MonadIO m) => AbsPath -> MaybeT m UTCTime
+getFileModifiedAt path = do
+  MaybeT $
+    liftIO $
+      (Just <$> Dir.getModificationTime (Path.toFilePath path))
+        `catchIOError` const (pure Nothing)
 
 modToFilePath :: GHC.ModuleName -> String -> RelPath
 modToFilePath modName ext =

src/StaticLS/Handlers.hs

@@ -160,8 +160,9 @@ handleDidChange = LSP.notificationHandler LSP.SMethod_TextDocumentDidChange $ \m
 handleDidSave :: Handlers (LspT c StaticLsM)
 handleDidSave = LSP.notificationHandler LSP.SMethod_TextDocumentDidSave $ \message -> do
   let params = message._params
-  let _uri = params._textDocument._uri
-  pure ()
+  let uri = params._textDocument._uri
+  -- Useful to invalidate for file watchers if a branch checkout invalidates the file state cache
+  updateFileStateForUri uri
 
 handleDidClose :: Handlers (LspT c StaticLsM)
 handleDidClose = LSP.notificationHandler LSP.SMethod_TextDocumentDidClose $ \_ -> do

src/StaticLS/HieView/Query.hs

@@ -105,7 +105,7 @@ fileEvidenceBinds file =
       )
       file
  where
-  evSourceNames (EvInstBind {cls}) = Nothing
+  evSourceNames (EvInstBind {}) = Nothing
   evSourceNames (EvLetBind (EvBindDeps {deps})) = Just deps
   evSourceNames EvOther = Nothing
 

src/StaticLS/HieView/Type.hs

@@ -1,7 +1,7 @@
 module StaticLS.HieView.Type (
   Type,
-  TypeArray,
-  FlatType,
+  TypeArray (..),
+  FlatType (..),
   TypeIndex (..),
   fromGHCHieType,
   fromGHCHieTypeFlat,

src/StaticLS/Hir/Make.hs

@@ -22,9 +22,9 @@ mkModuleText parts =
     , text = T.intercalate "." (NE.toList parts)
     }
 
-mkModuleName :: NonEmpty Text -> ModuleName
-mkModuleName parts =
-  ModuleName
-    { mod = mkModuleText parts
-    -- , node = AST.defaultNode
-    }
+-- mkModuleName :: NonEmpty Text -> ModuleName
+-- mkModuleName parts =
+--  ModuleName
+--    { mod = mkModuleText parts
+--    , node = AST.defaultNode
+--    }

src/StaticLS/IDE/CodeActions.hs

@@ -10,6 +10,7 @@ import Data.Path (AbsPath)
 import Data.Rope qualified as Rope
 import StaticLS.IDE.CodeActions.AddTypeSig qualified as AddTypeSig
 import StaticLS.IDE.CodeActions.AutoImport qualified as AutoImport
+import StaticLS.IDE.CodeActions.RemoveRedundantImports as RemoveRedundantImports
 import StaticLS.IDE.CodeActions.Types
 import StaticLS.IDE.Monad
 import StaticLS.IDE.SourceEdit (SourceEdit)
@@ -23,7 +24,8 @@ getCodeActions path lineCol = do
   let cx = CodeActionContext {path, pos, lineCol}
   typesCodeActions <- AddTypeSig.codeAction cx
   importCodeActions <- AutoImport.codeAction cx
-  let codeActions = typesCodeActions ++ importCodeActions
+  removeRedundantImports <- RemoveRedundantImports.codeAction cx
+  let codeActions = typesCodeActions ++ importCodeActions ++ removeRedundantImports
   pure codeActions
 
 resolveLazyAssist :: CodeActionMessage -> StaticLsM SourceEdit

src/StaticLS/IDE/CodeActions/AddTypeSig.hs

@@ -32,7 +32,7 @@ type BindName = Haskell.PrefixId :+ Haskell.Variable :+ Nil
 
 -- For now, it only works with top level declarations
 getDeclarationNameAtPos :: Haskell.Haskell -> Pos -> LineCol -> AST.Err (Maybe BindName)
-getDeclarationNameAtPos haskell pos lineCol = do
+getDeclarationNameAtPos haskell pos _lineCol = do
   let node = AST.getDeepestContaining @AddTypeContext (Range.point pos) haskell.dynNode
   case node of
     Just bind

src/StaticLS/IDE/CodeActions/AutoExport.hs

@@ -43,5 +43,5 @@ getDeclarationsAtPoint range decls =
 codeAction :: CodeActionContext -> StaticLsM [Assist]
 codeAction cx = do
   hir <- getHir cx.path
-  let decls = getDeclarationsAtPoint (Range.point cx.pos) hir.decls
+  let _decls = getDeclarationsAtPoint (Range.point cx.pos) hir.decls
   pure []

src/StaticLS/IDE/CodeActions/AutoImport.hs

@@ -104,7 +104,7 @@ createAutoImportCodeActions path mQualifier importMod =
         ]
 
 codeAction :: CodeActionContext -> StaticLsM [Assist]
-codeAction CodeActionContext {path, lineCol, pos} = do
+codeAction CodeActionContext {path, pos} = do
   hir <- getHir path
   modulesToImport <- getModulesToImport path pos
 
@@ -135,7 +135,7 @@ data ImportInsertPoint
   | AfterImportInsertPoint !Pos
 
 getImportsInsertPoint :: Rope -> Haskell.Haskell -> AST.Err ImportInsertPoint
-getImportsInsertPoint rope hs = do
+getImportsInsertPoint _rope hs = do
   imports <- Tree.getImports hs
   header <- Tree.getHeader hs
   let headerPos =