Skip to content

Commit

Permalink
Make it possible to search for config without getCurrentDirectory
Browse files Browse the repository at this point in the history
Co-Authored-By: Jan Hrček <[email protected]>
  • Loading branch information
jaspervdj and jhrcek committed Jan 10, 2025
1 parent 12c9118 commit cbe47ce
Show file tree
Hide file tree
Showing 6 changed files with 56 additions and 23 deletions.
14 changes: 14 additions & 0 deletions CHANGELOG
Original file line number Diff line number Diff line change
@@ -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)
Expand Down
19 changes: 11 additions & 8 deletions lib/Language/Haskell/Stylish.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ module Language.Haskell.Stylish
, module Language.Haskell.Stylish.Verbose
, version
, format
, ConfigPath(..)
, ConfigSearchStrategy(..)
, Lines
, Step
) where
Expand Down Expand Up @@ -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


Expand Down
32 changes: 23 additions & 9 deletions lib/Language/Haskell/Stylish/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
module Language.Haskell.Stylish.Config
( Extensions
, Config (..)
, ConfigSearchStrategy (..)
, ExitCodeBehavior (..)
, defaultConfigBytes
, configFilePath
Expand Down Expand Up @@ -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)
Expand All @@ -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 "<embedded>" mbFp
bytes <- maybe (return defaultConfigBytes) B.readFile mbFp
case decode1Strict bytes of
Expand Down
4 changes: 3 additions & 1 deletion src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion tests/Language/Haskell/Stylish/Config/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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


--------------------------------------------------------------------------------
Expand Down
8 changes: 4 additions & 4 deletions tests/Language/Haskell/Stylish/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 }"
Expand All @@ -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"
Expand All @@ -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
Expand Down

0 comments on commit cbe47ce

Please sign in to comment.