hls-module-name-plugin 1.0.0.1 → 1.0.0.2

raw patch · 4 files changed

+32/−21 lines, 4 filesdep ~ghcide

Dependency ranges changed: ghcide

Files

• hls-module-name-plugin.cabal +2/−2
• src/Ide/Plugin/ModuleName.hs +24/−19
• test/Main.hs +5/−0
• test/testdata/hie.yaml +1/−0

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-module-name-plugin-version:            1.0.0.1+version:            1.0.0.2 synopsis:           Module name plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -25,7 +25,7 @@     , base                  >=4.12 && <5     , directory     , filepath-    , ghcide                >=1.2  && <1.5+    , ghcide                >=1.2  && <1.6     , hls-plugin-api        >=1.1  && <1.3     , lsp     , text

@@ -21,7 +21,7 @@ import           Data.Aeson                 (Value (Null), toJSON) import           Data.Char                  (isLower) import qualified Data.HashMap.Strict        as HashMap-import           Data.List                  (find, intercalate, isPrefixOf)+import           Data.List                  (intercalate, isPrefixOf, minimumBy) import           Data.Maybe                 (maybeToList) import           Data.String                (IsString) import qualified Data.Text                  as T@@ -32,7 +32,7 @@                                              uriToFilePath', use, use_) import           Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags,                                              hsmodName, importPaths,-                                             pattern OldRealSrcSpan,+                                             pattern RealSrcSpan,                                              pm_parsed_source, unLoc) import           Ide.Types import           Language.LSP.Server@@ -44,6 +44,7 @@ import           System.Directory           (canonicalizePath) import           System.FilePath            (dropExtension, splitDirectories,                                              takeFileName)+import Data.Ord (comparing)  -- |Plugin descriptor descriptor :: PluginId -> PluginDescriptor IdeState@@ -97,42 +98,46 @@     contents <- lift . getVirtualFile $ toNormalizedUri uri     let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents -    correctName <- MaybeT . liftIO $ traceAs "correctName" <$> pathModuleName state nfp fp+    correctNames <- liftIO $ traceAs "correctNames" <$> pathModuleNames state nfp fp+    let bestName = minimumBy (comparing T.length) correctNames      statedNameMaybe <- liftIO $ traceAs "statedName" <$> codeModuleName state nfp     case statedNameMaybe of       Just (nameRange, statedName)-        | correctName /= statedName ->-            pure $ Replace uri nameRange ("Set module name to " <> correctName) correctName+        | statedName `notElem` correctNames ->+            pure $ Replace uri nameRange ("Set module name to " <> bestName) bestName       Nothing         | emptyModule ->-            let code = "module " <> correctName <> " where\n"+            let code = "module " <> bestName <> " where\n"             in pure $ Replace uri (Range (Position 0 0) (Position 0 0)) code code       _ -> MaybeT $ pure Nothing --- | The module name, as derived by the position of the module in its source directory-pathModuleName :: IdeState -> NormalizedFilePath -> String -> IO (Maybe T.Text)-pathModuleName state normFilePath filePath-  | isLower . head $ takeFileName filePath = return $ Just "Main"+-- | Possible module names, as derived by the position of the module in the+-- source directories.  There may be more than one possible name, if the source+-- directories are nested inside each other.+pathModuleNames :: IdeState -> NormalizedFilePath -> String -> IO [T.Text]+pathModuleNames state normFilePath filePath+  | isLower . head $ takeFileName filePath = return ["Main"]   | otherwise = do       session <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath       srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags       paths <- mapM canonicalizePath srcPaths       mdlPath <- canonicalizePath filePath-      pure $ do-        prefix <- find (`isPrefixOf` mdlPath) paths-        pure-          . T.pack-          . intercalate "."-          . splitDirectories-          . drop (length prefix + 1)-          $ dropExtension mdlPath+      let prefixes = filter (`isPrefixOf` mdlPath) paths+      pure (map (moduleNameFrom mdlPath) prefixes)+  where+    moduleNameFrom mdlPath prefix =+      T.pack+        . intercalate "."+        . splitDirectories+        . drop (length prefix + 1)+        $ dropExtension mdlPath  -- | The module name, as stated in the module codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) codeModuleName state nfp = runMaybeT $ do   pm <- MaybeT . runAction "ModuleName.GetParsedModule" state $ use GetParsedModule nfp-  L (OldRealSrcSpan l) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm+  L (RealSrcSpan l _) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm   pure (realSrcSpanToRange l, T.pack $ show m)  -- traceAs :: Show a => String -> a -> a

@@ -32,6 +32,11 @@       [CodeLens { _command = Just c }] <- getCodeLenses doc       executeCommand c       void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)++  , goldenWithModuleName "Fix wrong module name in nested directory" "subdir/TWrongModuleName" $ \doc -> do+      [CodeLens { _command = Just c }] <- getCodeLenses doc+      executeCommand c+      void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)   ]  goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree

@@ -1,6 +1,7 @@ cradle:   direct:     arguments:+      - "-isubdir"       - "TEmptyModule"       - "TWrongModuleName"       - "mainlike"