hls-module-name-plugin 1.0.2.0 → 1.1.0.0

raw patch · 8 files changed

+128/−68 lines, 8 filesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils

API changes (from Hackage documentation)

Files

• hls-module-name-plugin.cabal +8/−4
• src/Ide/Plugin/ModuleName.hs +85/−52
• test/Main.hs +10/−5
• test/testdata/cabal.project +1/−0
• test/testdata/canonicalize/Lib/A.expected.hs +1/−0
• test/testdata/canonicalize/Lib/A.hs +0/−0
• test/testdata/canonicalize/canonicalize.cabal +7/−0
• test/testdata/hie.yaml +16/−7

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-module-name-plugin-version:            1.0.2.0+version:            1.1.0.0 synopsis:           Module name plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -16,8 +16,11 @@   LICENSE   test/testdata/**/*.yaml   test/testdata/**/*.hs+  test/testdata/**/*.cabal+  test/testdata/**/*.project  library+  buildable: True   exposed-modules:  Ide.Plugin.ModuleName   hs-source-dirs:   src   build-depends:@@ -25,8 +28,8 @@     , base                  >=4.12 && <5     , directory     , filepath-    , ghcide                ^>=1.7-    , hls-plugin-api        ^>=1.4+    , ghcide                ^>=1.8+    , hls-plugin-api        ^>=1.5     , lsp     , text     , transformers@@ -35,6 +38,7 @@   default-language: Haskell2010  test-suite tests+  buildable: True   type:             exitcode-stdio-1.0   default-language: Haskell2010   hs-source-dirs:   test@@ -44,4 +48,4 @@     , base     , filepath     , hls-module-name-plugin-    , hls-test-utils          ^>=1.3+    , hls-test-utils          ^>=1.4

@@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE ViewPatterns      #-} {-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}  {- | Keep the module name in sync with its file path. @@ -15,54 +16,62 @@     descriptor, ) where -import           Control.Monad              (forM_, void)-import           Control.Monad.IO.Class     (liftIO)-import           Control.Monad.Trans.Class  (lift)+import           Control.Monad                (forM_, void)+import           Control.Monad.IO.Class       (liftIO)+import           Control.Monad.Trans.Class    (lift) import           Control.Monad.Trans.Maybe-import           Data.Aeson                 (Value (Null), toJSON)-import           Data.Char                  (isLower)-import qualified Data.HashMap.Strict        as HashMap-import           Data.List                  (intercalate, isPrefixOf, minimumBy)-import qualified Data.List.NonEmpty         as NE-import           Data.Maybe                 (maybeToList)-import           Data.Ord                   (comparing)-import           Data.String                (IsString)-import qualified Data.Text                  as T-import           Development.IDE            (GetParsedModule (GetParsedModule),-                                             GhcSession (GhcSession), IdeState,-                                             evalGhcEnv, hscEnvWithImportPaths,-                                             realSrcSpanToRange, runAction,-                                             uriToFilePath', use, use_)-import           Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags,-                                             hsmodName, importPaths, locA,-                                             pattern RealSrcSpan,-                                             pm_parsed_source, unLoc, moduleNameString)+import           Data.Aeson                   (Value (Null), toJSON)+import           Data.Char                    (isLower)+import qualified Data.HashMap.Strict          as HashMap+import           Data.List                    (intercalate, isPrefixOf,+                                               minimumBy)+import qualified Data.List.NonEmpty           as NE+import           Data.Maybe                   (maybeToList)+import           Data.Ord                     (comparing)+import           Data.String                  (IsString)+import qualified Data.Text                    as T+import           Development.IDE              (GetParsedModule (GetParsedModule),+                                               GhcSession (GhcSession),+                                               IdeState, Pretty,+                                               Priority (Debug, Info), Recorder,+                                               WithPriority, colon, evalGhcEnv,+                                               hscEnvWithImportPaths, logWith,+                                               realSrcSpanToRange, runAction,+                                               uriToFilePath', use, use_, (<+>))+import           Development.IDE.GHC.Compat   (GenLocated (L),+                                               getSessionDynFlags, hsmodName,+                                               importPaths, locA,+                                               moduleNameString,+                                               pattern RealSrcSpan,+                                               pm_parsed_source, unLoc)+import           Development.IDE.Types.Logger (Pretty (..)) import           Ide.Types import           Language.LSP.Server-import           Language.LSP.Types         hiding-                                            (SemanticTokenAbsolute (length, line),-                                             SemanticTokenRelative (length),-                                             SemanticTokensEdit (_start))-import           Language.LSP.VFS           (virtualFileText)-import           System.Directory           (makeAbsolute)-import           System.FilePath            (dropExtension, splitDirectories,-                                             takeFileName)+import           Language.LSP.Types           hiding+                                              (SemanticTokenAbsolute (length, line),+                                               SemanticTokenRelative (length),+                                               SemanticTokensEdit (_start))+import           Language.LSP.VFS             (virtualFileText)+import           System.Directory             (makeAbsolute)+import           System.FilePath              (dropExtension, normalise,+                                               pathSeparator, splitDirectories,+                                               takeFileName)  -- |Plugin descriptor-descriptor :: PluginId -> PluginDescriptor IdeState-descriptor plId =+descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder plId =     (defaultPluginDescriptor plId)-        { pluginHandlers = mkPluginHandler STextDocumentCodeLens codeLens-        , pluginCommands = [PluginCommand updateModuleNameCommand "set name of module to match with file path" command]+        { pluginHandlers = mkPluginHandler STextDocumentCodeLens (codeLens recorder)+        , pluginCommands = [PluginCommand updateModuleNameCommand "set name of module to match with file path" (command recorder)]         }  updateModuleNameCommand :: IsString p => p updateModuleNameCommand = "updateModuleName"  -- | Generate code lenses-codeLens :: PluginMethodHandler IdeState 'TextDocumentCodeLens-codeLens state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} =-  Right . List . maybeToList . (asCodeLens <$>) <$> action state uri+codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'TextDocumentCodeLens+codeLens recorder state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} =+  Right . List . maybeToList . (asCodeLens <$>) <$> action recorder state uri   where     asCodeLens :: Action -> CodeLens     asCodeLens Replace{..} = CodeLens aRange (Just cmd) Nothing@@ -70,9 +79,9 @@         cmd = mkLspCommand pluginId updateModuleNameCommand aTitle (Just [toJSON aUri])  -- | (Quasi) Idempotent command execution: recalculate action to execute on command request-command :: CommandFunction IdeState Uri-command state uri = do-  actMaybe <- action state uri+command :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri+command recorder state uri = do+  actMaybe <- action recorder state uri   forM_ actMaybe $ \Replace{..} ->     let       -- | Convert an Action to the corresponding edit operation@@ -91,19 +100,22 @@   deriving (Show)  -- | Required action (that can be converted to either CodeLenses or CodeActions)-action :: IdeState -> Uri -> LspM c (Maybe Action)-action state uri =-  traceAs "action" <$> runMaybeT $ do+action :: Recorder (WithPriority Log) -> IdeState -> Uri -> LspM c (Maybe Action)+action recorder state uri =+  runMaybeT $ do     nfp <- MaybeT . pure . uriToNormalizedFilePath $ toNormalizedUri uri     fp <- MaybeT . pure $ uriToFilePath' uri      contents <- lift . getVirtualFile $ toNormalizedUri uri     let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents -    correctNames <- liftIO $ traceAs "correctNames" <$> pathModuleNames state nfp fp+    correctNames <- liftIO $ pathModuleNames recorder state nfp fp+    logWith recorder Debug (CorrectNames correctNames)     bestName <- minimumBy (comparing T.length) <$> (MaybeT . pure $ NE.nonEmpty correctNames)+    logWith recorder Info (BestName bestName) -    statedNameMaybe <- liftIO $ traceAs "statedName" <$> codeModuleName state nfp+    statedNameMaybe <- liftIO $ codeModuleName state nfp+    logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe)     case statedNameMaybe of       Just (nameRange, statedName)         | statedName `notElem` correctNames ->@@ -117,14 +129,23 @@ -- | 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+pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> IO [T.Text]+pathModuleNames recorder 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 makeAbsolute srcPaths+      logWith recorder Debug (SrcPaths srcPaths)++      -- Append a `pathSeparator` to make the path looks like a directory,+      --   and then we can drop it uniformly.+      -- See https://github.com/haskell/haskell-language-server/pull/3092 for details.+      let paths = map (normalise . (<> pure pathSeparator)) srcPaths+      logWith recorder Debug (NormalisedPaths paths)+       mdlPath <- makeAbsolute filePath+      logWith recorder Debug (AbsoluteFilePath mdlPath)+       let prefixes = filter (`isPrefixOf` mdlPath) paths       pure (map (moduleNameFrom mdlPath) prefixes)   where@@ -132,7 +153,7 @@       T.pack         . intercalate "."         . splitDirectories-        . drop (length prefix + 1)+        . drop (length prefix)         $ dropExtension mdlPath  -- | The module name, as stated in the module@@ -142,8 +163,20 @@   L (locA -> (RealSrcSpan l _)) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm   pure (realSrcSpanToRange l, T.pack $ moduleNameString m) --- traceAs :: Show a => String -> a -> a--- traceAs lbl a = trace (lbl ++ " = " ++ show a) a+data Log =+    CorrectNames [T.Text]+  | BestName T.Text+  | ModuleName (Maybe T.Text)+  | SrcPaths [FilePath]+  | NormalisedPaths [FilePath]+  | AbsoluteFilePath FilePath+  deriving Show -traceAs :: b -> a -> a-traceAs _ a = a+instance Pretty Log where+  pretty log = "ModuleName." <> case log of+    CorrectNames log     -> "CorrectNames" <> colon <+> pretty log+    BestName log         -> "BestName" <> colon <+> pretty log+    ModuleName log       -> "StatedNameMaybe" <> colon <+> pretty log+    SrcPaths log         -> "SrcPaths" <> colon <+> pretty log+    NormalisedPaths log  -> "NormalisedPaths" <> colon <+> pretty log+    AbsoluteFilePath log -> "AbsoluteFilePath" <> colon <+> pretty log

@@ -13,7 +13,7 @@ main = defaultTestRunner tests  moduleNamePlugin :: PluginDescriptor IdeState-moduleNamePlugin = ModuleName.descriptor "moduleName"+moduleNamePlugin = ModuleName.descriptor mempty "moduleName"  tests :: TestTree tests =@@ -39,10 +39,15 @@       void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)   , testCase "Should not show code lens if the module name is correct" $       runSessionWithServer moduleNamePlugin testDataDir $ do-          doc <- openDoc "CorrectName.hs" "haskell"-          lenses <- getCodeLenses doc-          liftIO $ lenses @?= []-          closeDoc doc+        doc <- openDoc "CorrectName.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ lenses @?= []+        closeDoc doc+  -- https://github.com/haskell/haskell-language-server/issues/3047+  , goldenWithModuleName "Fix#3047" "canonicalize/Lib/A" $ \doc -> do+      [CodeLens { _command = Just c }] <- getCodeLenses doc+      executeCommand c+      void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)   ]  goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree

@@ -0,0 +1,1 @@+packages: ./canonicalize

@@ -0,0 +1,1 @@+module Lib.A where

@@ -0,0 +1,7 @@+cabal-version: 2.4+name: canonicalize+version: 0.1.0.0++library+  build-depends: base+  hs-source-dirs: ./

@@ -1,8 +1,17 @@ cradle:-  direct:-    arguments:-      - "-isubdir"-      - "TEmptyModule"-      - "TWrongModuleName"-      - "mainlike"-      - "CorrectName"+  multi:+    - path: "./"+      config:+        cradle:+          direct:+            arguments:+              - "-isubdir"+              - "TEmptyModule"+              - "TWrongModuleName"+              - "CorrectName"+    - path: "./canonicalize"+      config:+        cradle:+          cabal:+            - path: "./"+              component: "lib:canonicalize"