From cbe47ce56692de6aef1b07a8a2d6914d96a1d2fa Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 10 Jan 2025 17:46:55 +0100 Subject: [PATCH] Make it possible to search for config without getCurrentDirectory MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Jan Hrček --- CHANGELOG | 14 ++++++++ lib/Language/Haskell/Stylish.hs | 19 ++++++----- lib/Language/Haskell/Stylish/Config.hs | 32 +++++++++++++------ src/Main.hs | 4 ++- .../Language/Haskell/Stylish/Config/Tests.hs | 2 +- tests/Language/Haskell/Stylish/Tests.hs | 8 ++--- 6 files changed, 56 insertions(+), 23 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index f5874e1a..96e66c0f 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,19 @@ # CHANGELOG +- UNRELEASED + * #482 Add `ConfigSearchStrategy` to allow avoiding `getCurrentDirectory` + when loading config (by Jan Hrček) + + This is breaking API change that can be fixed like this: + + ```diff + -format Nothing maybeFile contents + +format SearchFromCurrentDirectory maybeFile contents + + -format (Just cfgFile) maybeFile content + +format (UseConfig cfgFile) maybeFile content + ``` + - 0.14.6.0 (2024-01-19) * #471 Support GHC 9.8 (by Michael Peyton Jones) * #440 Fix dissappearing `DEPRECATED` pragma on module (by Lev Dvorkin) diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index a767889e..0c403984 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -19,7 +19,7 @@ module Language.Haskell.Stylish , module Language.Haskell.Stylish.Verbose , version , format - , ConfigPath(..) + , ConfigSearchStrategy(..) , Lines , Step ) where @@ -105,14 +105,17 @@ runSteps :: runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps -newtype ConfigPath = ConfigPath { unConfigPath :: FilePath } --- |Formats given contents optionally using the config provided as first param. --- The second file path is the location from which the contents were read. --- If provided, it's going to be printed out in the error message. -format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines) -format maybeConfigPath maybeFilePath contents = do - conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath) +-- | Formats given contents. +format :: + ConfigSearchStrategy + -> Maybe FilePath + -- ^ the location from which the contents to format were read. + -- If provided, it's going to be printed out in the error message. + -> String -- ^ the contents to format + -> IO (Either String Lines) +format configSearchStrategy maybeFilePath contents = do + conf <- loadConfig (makeVerbose True) configSearchStrategy pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 3e62108c..1eb80d63 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -6,6 +6,7 @@ module Language.Haskell.Stylish.Config ( Extensions , Config (..) + , ConfigSearchStrategy (..) , ExitCodeBehavior (..) , defaultConfigBytes , configFilePath @@ -95,14 +96,27 @@ defaultConfigBytes = $(FileEmbed.embedFile "data/stylish-haskell.yaml") -------------------------------------------------------------------------------- -configFilePath :: Verbose -> Maybe FilePath -> IO (Maybe FilePath) -configFilePath _ (Just userSpecified) = return (Just userSpecified) -configFilePath verbose Nothing = do - current <- getCurrentDirectory +data ConfigSearchStrategy + = -- | Don't try to search, just use given config file + UseConfig FilePath + | -- | Search for @.stylish-haskell.yaml@ starting from given directory. + -- If not found, try all ancestor directories, @$XDG_CONFIG\/stylish-haskell\/config.yaml@ and @$HOME\/.stylish-haskell.yaml@ in order. + -- If no config is found, default built-in config will be used. + SearchFromDirectory FilePath + | -- | Like SearchFromDirectory, but using current working directory as a starting point + SearchFromCurrentDirectory + +configFilePath :: Verbose -> ConfigSearchStrategy -> IO (Maybe FilePath) +configFilePath _ (UseConfig userSpecified) = return (Just userSpecified) +configFilePath verbose (SearchFromDirectory dir) = searchFrom verbose dir +configFilePath verbose SearchFromCurrentDirectory = searchFrom verbose =<< getCurrentDirectory + +searchFrom :: Verbose -> FilePath -> IO (Maybe FilePath) +searchFrom verbose startDir = do configPath <- getXdgDirectory XdgConfig "stylish-haskell" - home <- getHomeDirectory + home <- getHomeDirectory search verbose $ - [d configFileName | d <- ancestors current] ++ + [d configFileName | d <- ancestors startDir] ++ [configPath "config.yaml", home configFileName] search :: Verbose -> [FilePath] -> IO (Maybe FilePath) @@ -114,9 +128,9 @@ search verbose (f : fs) = do if exists then return (Just f) else search verbose fs -------------------------------------------------------------------------------- -loadConfig :: Verbose -> Maybe FilePath -> IO Config -loadConfig verbose userSpecified = do - mbFp <- configFilePath verbose userSpecified +loadConfig :: Verbose -> ConfigSearchStrategy -> IO Config +loadConfig verbose configSearchStrategy = do + mbFp <- configFilePath verbose configSearchStrategy verbose $ "Loading configuration at " ++ fromMaybe "" mbFp bytes <- maybe (return defaultConfigBytes) B.readFile mbFp case decode1Strict bytes of diff --git a/src/Main.hs b/src/Main.hs index a41c1d86..31af4169 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -108,7 +108,9 @@ stylishHaskell sa = do BC8.putStr defaultConfigBytes else do - conf <- loadConfig verbose' (saConfig sa) + conf <- loadConfig verbose' $ case saConfig sa of + Nothing -> SearchFromCurrentDirectory + Just fp -> UseConfig fp filesR <- case (saRecursive sa) of True -> findHaskellFiles (saVerbose sa) (saFiles sa) _ -> return $ saFiles sa diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index 847ddc26..da2762c4 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -96,7 +96,7 @@ createFilesAndGetConfig files = withTestDirTree $ do setCurrentDirectory "src" -- from that directory read the config file and extract extensions -- to make sure the search for .cabal file works - loadConfig (const (pure ())) Nothing + loadConfig (const (pure ())) SearchFromCurrentDirectory -------------------------------------------------------------------------------- diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index 271016a9..f2001807 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -35,7 +35,7 @@ tests = testGroup "Language.Haskell.Stylish.Tests" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = (@?= result) =<< format Nothing Nothing input +case01 = (@?= result) =<< format SearchFromCurrentDirectory Nothing input where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right $ lines input @@ -54,7 +54,7 @@ case02 = withTestDirTree $ do , " via: \"indent 2\"" ] - actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual <- format (UseConfig "test-config.yaml") Nothing input actual @?= result where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" @@ -79,7 +79,7 @@ case03 = withTestDirTree $ do , " via: \"indent 2\"" ] - actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual <- format (UseConfig "test-config.yaml") Nothing input actual @?= result where input = unlines [ "module Herp where" @@ -98,7 +98,7 @@ case03 = withTestDirTree $ do -------------------------------------------------------------------------------- case04 :: Assertion -case04 = format Nothing (Just fileLocation) input >>= \case +case04 = format SearchFromCurrentDirectory (Just fileLocation) input >>= \case Right _ -> assertFailure "expected error" Left err | fileLocation `isInfixOf` err