From a6b9611946c617178e941c64394dfe255a461268 Mon Sep 17 00:00:00 2001 From: komikat Date: Sun, 21 Jul 2024 07:20:05 +0530 Subject: [PATCH 1/2] remove unused rootDir parameter from withHieDb --- ghcide/src/Development/IDE/Core/Service.hs | 2 +- ghcide/src/Development/IDE/Core/Shake.hs | 5 +---- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs index 52639aeb22..506319914c 100644 --- a/ghcide/src/Development/IDE/Core/Service.hs +++ b/ghcide/src/Development/IDE/Core/Service.hs @@ -93,7 +93,7 @@ initialise recorder defaultConfig plugins mainRule lspEnv debouncer options with ofInterestRules (cmapWithPrio LogOfInterest recorder) fileExistsRules (cmapWithPrio LogFileExists recorder) lspEnv mainRule) - rootDir + -- | Shutdown the Compiler Service. shutdown :: IdeState -> IO () diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 921dfe3e6d..141faf1756 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -649,14 +649,11 @@ shakeOpen :: Recorder (WithPriority Log) -> ShakeOptions -> Monitoring -> Rules () - -> FilePath - -- ^ Root directory, this one might be picking up from `LanguageContextEnv`'s `resRootPath` - -- , see Note [Root Directory] -> IO IdeState shakeOpen recorder lspEnv defaultConfig idePlugins debouncer shakeProfileDir (IdeReportProgress reportProgress) ideTesting - withHieDb threadQueue opts monitoring rules rootDir = mdo + withHieDb threadQueue opts monitoring rules = mdo -- see Note [Serializing runs in separate thread] let indexQueue = tIndexQueue threadQueue restartQueue = tRestartQueue threadQueue From 9b84ba76e211dabc534049f2269f3af571c5ce5f Mon Sep 17 00:00:00 2001 From: komikat Date: Sat, 27 Jul 2024 05:12:22 +0530 Subject: [PATCH 2/2] AbstractPath and hls-stylish-plugin refactor the loadConfig function calls setCurrentDirectory and getCurrentDirectory for recursively searching the current dir for `.stylish_haskell.yaml`, this has been replaced by a function which directly chooses the parent directory of the file as the currentDirectory, the `search` function nonetheless looks recursively outwards. TODO: cabalLanguageExtensions parsing support --- ghcide/ghcide.cabal | 1 + .../src/Development/IDE/Core/AbstractPath.hs | 11 ++++ haskell-language-server.cabal | 2 + .../src/Ide/Plugin/StylishHaskell.hs | 62 +++++++++++++++++-- 4 files changed, 70 insertions(+), 6 deletions(-) create mode 100644 ghcide/src/Development/IDE/Core/AbstractPath.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index bf88a55ed3..e1d2e55d8f 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -129,6 +129,7 @@ library exposed-modules: Control.Concurrent.Strict Development.IDE + Development.IDE.Core.AbstractPath Development.IDE.Core.Actions Development.IDE.Core.Compile Development.IDE.Core.Debouncer diff --git a/ghcide/src/Development/IDE/Core/AbstractPath.hs b/ghcide/src/Development/IDE/Core/AbstractPath.hs new file mode 100644 index 0000000000..6668f3066c --- /dev/null +++ b/ghcide/src/Development/IDE/Core/AbstractPath.hs @@ -0,0 +1,11 @@ +module Development.IDE.Core.AbstractPath where + +import System.FilePath + +data AbstractPath = RelativePath FilePath + | AbsolutePath FilePath + deriving (Show) + +mkAbstract :: FilePath -> AbstractPath +mkAbstract x | isRelative x = RelativePath x + | otherwise = AbsolutePath x diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 24f7c9b8ba..e995a802bb 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1578,6 +1578,7 @@ library hls-stylish-haskell-plugin hs-source-dirs: plugins/hls-stylish-haskell-plugin/src build-depends: , base >=4.12 && <5 + , bytestring , directory , filepath , ghc-boot-th @@ -1587,6 +1588,7 @@ library hls-stylish-haskell-plugin , mtl , stylish-haskell ^>=0.12 || ^>=0.13 || ^>=0.14 , text + , yaml test-suite hls-stylish-haskell-plugin-tests diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index a862e57fb8..b26ec765e0 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -11,8 +11,13 @@ where import Control.Monad.Except (throwError) import Control.Monad.IO.Class +import Data.ByteString as B +import Data.List (inits, nub) +import Data.Maybe import Data.Text (Text) import qualified Data.Text as T +import Data.Yaml +import Debug.Trace import Development.IDE hiding (getExtensions, pluginHandlers) import Development.IDE.Core.PluginUtils @@ -26,8 +31,11 @@ import Ide.Types hiding (Config) import Language.Haskell.Stylish import Language.LSP.Protocol.Types as LSP import System.Directory + import System.FilePath + + data Log = LogLanguageExtensionFromDynFlags @@ -61,7 +69,7 @@ provider recorder ide _token typ contents fp _opts = do Right new -> pure $ LSP.InL [TextEdit range new] where getMergedConfig dyn config - | null (configLanguageExtensions config) + | Prelude.null (configLanguageExtensions config) = do logWith recorder Info LogLanguageExtensionFromDynFlags pure @@ -70,19 +78,61 @@ provider recorder ide _token typ contents fp _opts = do | otherwise = pure config - getExtensions = map showExtension . Util.toList . extensionFlags + getExtensions = Prelude.map showExtension . Util.toList . extensionFlags showExtension Cpp = "CPP" showExtension other = show other +-- | taken and refactored from stylish-haskell which uses getCurrentDirectory +-- https://hackage.haskell.org/package/stylish-haskell-0.14.6.0/docs/src/Language.Haskell.Stylish.Config.html#configFilePath +-- https://github.com/haskell/haskell-language-server/issues/4234#issuecomment-2191571281 +ancestors :: FilePath -> [FilePath] +ancestors = Prelude.map joinPath . Prelude.reverse . Prelude.dropWhile Prelude.null . Data.List.inits . splitPath + +configFileName :: String +configFileName = ".stylish-haskell.yaml" + +configFilePathMT :: Verbose -> FilePath -> IO (Maybe FilePath) +configFilePathMT verbose currentDir = do + configPath <- getXdgDirectory XdgConfig "stylish-haskell" + home <- getHomeDirectory + search verbose $ + [d configFileName | d <- ancestors currentDir] ++ + [configPath "config.yaml", home configFileName] + +search :: Verbose -> [FilePath] -> IO (Maybe FilePath) +search _ [] = return Nothing +search verbose (f : fs) = do + -- TODO Maybe catch an error here, dir might be unreadable + exists <- doesFileExist f + verbose $ f ++ if exists then " exists" else " does not exist" + if exists then return (Just f) else search verbose fs + +loadConfigMT :: Verbose -> FilePath -> IO Config +loadConfigMT verbose currentDir = do + mbFp <- configFilePathMT verbose currentDir + verbose $ "Loading configuration at " ++ fromMaybe "" mbFp + bytes <- maybe (return defaultConfigBytes) B.readFile mbFp + case decodeEither' bytes of + Left exception -> error $ prettyPrintParseException exception + Right config -> do + -- | TODO + cabalLanguageExtensions <- pure [] + + return $ config + { configLanguageExtensions = nub $ + configLanguageExtensions config + } + where toStr (ext, True) = show ext + toStr (ext, False) = "No" ++ show ext + + + -- | Recursively search in every directory of the given filepath for .stylish-haskell.yaml. -- If no such file has been found, return default config. loadConfigFrom :: FilePath -> IO Config loadConfigFrom file = do - currDir <- getCurrentDirectory - setCurrentDirectory (takeDirectory file) - config <- loadConfig (makeVerbose False) Nothing - setCurrentDirectory currDir + config <- loadConfigMT (makeVerbose True) (takeDirectory file) pure config -- | Run stylish-haskell on the given text with the given configuration.