Make it possible to search for config without getCurrentDirectory

Co-Authored-By: Jan Hrček <honza.hrk@gmail.com>

Author: jaspervdj

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)

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
 
 

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 "<embedded>" mbFp
     bytes <- maybe (return defaultConfigBytes) B.readFile mbFp
     case decode1Strict bytes of

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

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
 
 
 --------------------------------------------------------------------------------

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