From a8195233503ff84d6dd42065bdace4897d9bce35 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Thu, 11 Aug 2022 21:50:42 +0800 Subject: [PATCH 1/6] Make path canonicalized --- exe/Plugins.hs | 2 +- .../src/Ide/Plugin/ModuleName.hs | 123 ++++++++++-------- plugins/hls-module-name-plugin/test/Main.hs | 15 ++- .../test/testdata/cabal.project | 1 + .../testdata/canonicalize/Lib/A.expected.hs | 1 + .../test/testdata/canonicalize/Lib/A.hs | 0 .../testdata/canonicalize/canonicalize.cabal | 7 + .../test/testdata/hie.yaml | 23 +++- 8 files changed, 106 insertions(+), 66 deletions(-) create mode 100644 plugins/hls-module-name-plugin/test/testdata/cabal.project create mode 100644 plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs create mode 100644 plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs create mode 100644 plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 561c8541a8..4a4138d7bd 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -183,7 +183,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins RefineImports.descriptor pluginRecorder "refineImports" : #endif #if hls_moduleName - ModuleName.descriptor "moduleName" : + ModuleName.descriptor pluginRecorder "moduleName" : #endif #if hls_hlint Hlint.descriptor pluginRecorder "hlint" : diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 55685778f4..3e6ac032ba 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# 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,55 +17,61 @@ module Ide.Plugin.ModuleName ( 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, - moduleNameString, - pattern RealSrcSpan, - pm_parsed_source, unLoc) +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, 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 (canonicalizePath, makeAbsolute) +import System.FilePath (dropExtension, 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 @@ -71,9 +79,9 @@ codeLens state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} 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 @@ -92,19 +100,22 @@ data Action = Replace 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 (ModuleNameLog $ "ModuleName.correctNames: " <> T.unlines correctNames) bestName <- minimumBy (comparing T.length) <$> (MaybeT . pure $ NE.nonEmpty correctNames) + logWith recorder Info (ModuleNameLog $ "ModuleName.bestName: " <> bestName) - statedNameMaybe <- liftIO $ traceAs "statedName" <$> codeModuleName state nfp + statedNameMaybe <- liftIO $ codeModuleName state nfp + logWith recorder Debug (ModuleNameLog $ "ModuleName.statedNameMaybe: " <> (T.pack $ show statedNameMaybe)) case statedNameMaybe of Just (nameRange, statedName) | statedName `notElem` correctNames -> @@ -118,14 +129,20 @@ action state uri = -- | 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 (ModuleNameLog $ "ModuleName.srcpath: " <> T.pack (unlines srcPaths)) + + paths <- mapM canonicalizePath srcPaths + logWith recorder Debug (ModuleNameLog $ "ModuleName.paths: " <> T.pack (unlines paths)) + mdlPath <- makeAbsolute filePath + logWith recorder Debug (ModuleNameLog $ "ModuleName.mdlPath: " <> T.pack mdlPath) + let prefixes = filter (`isPrefixOf` mdlPath) paths pure (map (moduleNameFrom mdlPath) prefixes) where @@ -133,7 +150,7 @@ pathModuleNames state normFilePath filePath T.pack . intercalate "." . splitDirectories - . drop (length prefix + 1) + . drop (length prefix + 1) -- plus one to remove `/`, for example `a/b/c` to `b/c`. $ dropExtension mdlPath -- | The module name, as stated in the module @@ -143,8 +160,8 @@ codeModuleName state nfp = runMaybeT $ do 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 +newtype Log = ModuleNameLog T.Text deriving Show -traceAs :: b -> a -> a -traceAs _ a = a +instance Pretty Log where + pretty = \case + ModuleNameLog log -> pretty log diff --git a/plugins/hls-module-name-plugin/test/Main.hs b/plugins/hls-module-name-plugin/test/Main.hs index ce0fa1e746..914fcb69dd 100644 --- a/plugins/hls-module-name-plugin/test/Main.hs +++ b/plugins/hls-module-name-plugin/test/Main.hs @@ -13,7 +13,7 @@ main :: IO () main = defaultTestRunner tests moduleNamePlugin :: PluginDescriptor IdeState -moduleNamePlugin = ModuleName.descriptor "moduleName" +moduleNamePlugin = ModuleName.descriptor mempty "moduleName" tests :: TestTree tests = @@ -39,10 +39,15 @@ tests = 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 diff --git a/plugins/hls-module-name-plugin/test/testdata/cabal.project b/plugins/hls-module-name-plugin/test/testdata/cabal.project new file mode 100644 index 0000000000..1406cd0907 --- /dev/null +++ b/plugins/hls-module-name-plugin/test/testdata/cabal.project @@ -0,0 +1 @@ +packages: ./canonicalize diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs b/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs new file mode 100644 index 0000000000..c5877f7100 --- /dev/null +++ b/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs @@ -0,0 +1 @@ +module Lib.A where diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs b/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs new file mode 100644 index 0000000000..e69de29bb2 diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal b/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal new file mode 100644 index 0000000000..dc0e099ed3 --- /dev/null +++ b/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.4 +name: canonicalize +version: 0.1.0.0 + +library + build-depends: base + hs-source-dirs: ./ diff --git a/plugins/hls-module-name-plugin/test/testdata/hie.yaml b/plugins/hls-module-name-plugin/test/testdata/hie.yaml index 022fee55a1..fb1c7521c3 100644 --- a/plugins/hls-module-name-plugin/test/testdata/hie.yaml +++ b/plugins/hls-module-name-plugin/test/testdata/hie.yaml @@ -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" From 3ff13edb4ee5aab7b672f8002bbc129a839d5cce Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Thu, 11 Aug 2022 22:21:17 +0800 Subject: [PATCH 2/6] Update extra-source-files --- plugins/hls-module-name-plugin/hls-module-name-plugin.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal index 29fbe521a0..1290ab75bf 100644 --- a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal +++ b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal @@ -16,6 +16,8 @@ extra-source-files: LICENSE test/testdata/**/*.yaml test/testdata/**/*.hs + test/testdata/**/*.cabal + test/testdata/**/*.project library exposed-modules: Ide.Plugin.ModuleName From f36be7b0c6471d5cf3be7d9473bbe9f67aee3d18 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Fri, 12 Aug 2022 21:53:23 +0800 Subject: [PATCH 3/6] Replace with normalise --- .../src/Ide/Plugin/ModuleName.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 3e6ac032ba..7c9a9b0322 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -53,8 +53,9 @@ import Language.LSP.Types hiding SemanticTokenRelative (length), SemanticTokensEdit (_start)) import Language.LSP.VFS (virtualFileText) -import System.Directory (canonicalizePath, makeAbsolute) -import System.FilePath (dropExtension, splitDirectories, +import System.Directory (makeAbsolute) +import System.FilePath (dropExtension, normalise, + pathSeparator, splitDirectories, takeFileName) -- |Plugin descriptor @@ -137,20 +138,21 @@ pathModuleNames recorder state normFilePath filePath srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags logWith recorder Debug (ModuleNameLog $ "ModuleName.srcpath: " <> T.pack (unlines srcPaths)) - paths <- mapM canonicalizePath srcPaths + let paths = map (normalise . (<> pure pathSeparator)) srcPaths logWith recorder Debug (ModuleNameLog $ "ModuleName.paths: " <> T.pack (unlines paths)) mdlPath <- makeAbsolute filePath logWith recorder Debug (ModuleNameLog $ "ModuleName.mdlPath: " <> T.pack mdlPath) let prefixes = filter (`isPrefixOf` mdlPath) paths + liftIO $ putStrLn $ "srcpath: " <> show srcPaths pure (map (moduleNameFrom mdlPath) prefixes) where moduleNameFrom mdlPath prefix = T.pack . intercalate "." . splitDirectories - . drop (length prefix + 1) -- plus one to remove `/`, for example `a/b/c` to `b/c`. + . drop (length prefix) $ dropExtension mdlPath -- | The module name, as stated in the module From 66e88e769b2b234b41bf03437e281cfdf1b94de8 Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Fri, 12 Aug 2022 22:48:38 +0800 Subject: [PATCH 4/6] Change to a more detailed log --- .../src/Ide/Plugin/ModuleName.hs | 36 ++++++++++++------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 7c9a9b0322..b0fb94ef32 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} @@ -35,10 +34,10 @@ import Development.IDE (GetParsedModule (GetParsedModule) GhcSession (GhcSession), IdeState, Pretty, Priority (Debug, Info), Recorder, - WithPriority, evalGhcEnv, + WithPriority, colon, evalGhcEnv, hscEnvWithImportPaths, logWith, realSrcSpanToRange, runAction, - uriToFilePath', use, use_) + uriToFilePath', use, use_, (<+>)) import Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags, hsmodName, importPaths, locA, @@ -111,12 +110,12 @@ action recorder state uri = let emptyModule = maybe True (T.null . T.strip . virtualFileText) contents correctNames <- liftIO $ pathModuleNames recorder state nfp fp - logWith recorder Debug (ModuleNameLog $ "ModuleName.correctNames: " <> T.unlines correctNames) + logWith recorder Debug (CorrectNames correctNames) bestName <- minimumBy (comparing T.length) <$> (MaybeT . pure $ NE.nonEmpty correctNames) - logWith recorder Info (ModuleNameLog $ "ModuleName.bestName: " <> bestName) + logWith recorder Info (BestName bestName) statedNameMaybe <- liftIO $ codeModuleName state nfp - logWith recorder Debug (ModuleNameLog $ "ModuleName.statedNameMaybe: " <> (T.pack $ show statedNameMaybe)) + logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe) case statedNameMaybe of Just (nameRange, statedName) | statedName `notElem` correctNames -> @@ -136,16 +135,15 @@ pathModuleNames recorder state normFilePath filePath | otherwise = do session <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags - logWith recorder Debug (ModuleNameLog $ "ModuleName.srcpath: " <> T.pack (unlines srcPaths)) + logWith recorder Debug (SrcPaths srcPaths) let paths = map (normalise . (<> pure pathSeparator)) srcPaths - logWith recorder Debug (ModuleNameLog $ "ModuleName.paths: " <> T.pack (unlines paths)) + logWith recorder Debug (NormalisedPaths paths) mdlPath <- makeAbsolute filePath - logWith recorder Debug (ModuleNameLog $ "ModuleName.mdlPath: " <> T.pack mdlPath) + logWith recorder Debug (AbsoluteFilePath mdlPath) let prefixes = filter (`isPrefixOf` mdlPath) paths - liftIO $ putStrLn $ "srcpath: " <> show srcPaths pure (map (moduleNameFrom mdlPath) prefixes) where moduleNameFrom mdlPath prefix = @@ -162,8 +160,20 @@ codeModuleName state nfp = runMaybeT $ do L (locA -> (RealSrcSpan l _)) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm pure (realSrcSpanToRange l, T.pack $ moduleNameString m) -newtype Log = ModuleNameLog T.Text deriving Show +data Log = + CorrectNames [T.Text] + | BestName T.Text + | ModuleName (Maybe T.Text) + | SrcPaths [FilePath] + | NormalisedPaths [FilePath] + | AbsoluteFilePath FilePath + deriving Show instance Pretty Log where - pretty = \case - ModuleNameLog log -> pretty log + 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 From 35b969ac4dd298f8692aa3aedef1e6a7085bab1a Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Fri, 12 Aug 2022 23:39:08 +0800 Subject: [PATCH 5/6] Comment patch detail --- plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index b0fb94ef32..24b9a88857 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -137,6 +137,9 @@ pathModuleNames recorder state normFilePath filePath srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags 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) From 5156ea1d828d1ae0057696183580fb95da9056fe Mon Sep 17 00:00:00 2001 From: Lei Zhu Date: Sat, 13 Aug 2022 21:41:17 +0800 Subject: [PATCH 6/6] 2 spaces indent --- .../src/Ide/Plugin/ModuleName.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 24b9a88857..05dd03ab56 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -173,10 +173,10 @@ data Log = deriving Show 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 + 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