Make it possible to search for config without getCurrentDirectory (#483)

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

Author: jhrcek

CHANGELOG

@@ -1,6 +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
+       ```
+
      * Bump `Cabal` lower bound to 3.14
 
 - 0.14.6.0 (2024-01-19)

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,17 @@ 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
+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,16 +118,16 @@ 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
         Left (pos, err)     -> error $ prettyPosWithSource pos (fromStrict bytes) ("Language.Haskell.Stylish.Config.loadConfig: " ++ err)
         Right config -> do
           cabalLanguageExtensions <- if configCabal config
-            then map toStr <$> Cabal.findLanguageExtensions verbose
+            then map toStr <$> Cabal.findLanguageExtensions verbose configSearchStrategy
             else pure []
 
           return $ config

lib/Language/Haskell/Stylish/Config/Cabal.hs

@@ -16,31 +16,32 @@ import qualified Distribution.Parsec                      as Cabal
 import qualified Distribution.Simple.Utils                as Cabal
 import qualified Distribution.Utils.Path                  as Cabal
 import qualified Distribution.Verbosity                   as Cabal
+import           GHC.Data.Maybe                           (mapMaybe)
 import qualified Language.Haskell.Extension               as Language
+import           Language.Haskell.Stylish.Config.Internal
 import           Language.Haskell.Stylish.Verbose
 import           System.Directory                         (doesFileExist,
                                                            getCurrentDirectory)
 
 
 --------------------------------------------------------------------------------
-import           GHC.Data.Maybe                           (mapMaybe)
-import           Language.Haskell.Stylish.Config.Internal
-
-
---------------------------------------------------------------------------------
-findLanguageExtensions :: Verbose -> IO [(Language.KnownExtension, Bool)]
-findLanguageExtensions verbose =
-    findCabalFile verbose >>=
+findLanguageExtensions
+    :: Verbose -> ConfigSearchStrategy -> IO [(Language.KnownExtension, Bool)]
+findLanguageExtensions verbose configSearchStrategy =
+    findCabalFile verbose configSearchStrategy >>=
     maybe (pure []) (readDefaultLanguageExtensions verbose)
 
 
 --------------------------------------------------------------------------------
 -- | Find the closest .cabal file, possibly going up the directory structure.
--- TODO: use ConfigSearchStrategy here, too
-findCabalFile :: Verbose -> IO (Maybe FilePath)
-findCabalFile verbose = do
-  cwd <- getCurrentDirectory
-  go [] $ ancestors cwd
+findCabalFile :: Verbose -> ConfigSearchStrategy -> IO (Maybe FilePath)
+findCabalFile verbose configSearchStrategy = case configSearchStrategy of
+  -- If the invocation pointed us to a specific config file, it doesn't make
+  -- much sense to search for cabal files manually (the config file could be
+  -- somewhere like /etc, not necessarily a Haskell project).
+  UseConfig _                -> pure Nothing
+  SearchFromDirectory path   -> go [] $ ancestors path
+  SearchFromCurrentDirectory -> getCurrentDirectory >>= go [] . ancestors
  where
   go :: [FilePath] -> [FilePath] -> IO (Maybe FilePath)
   go searched [] = do

lib/Language/Haskell/Stylish/Config/Internal.hs

@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module Language.Haskell.Stylish.Config.Internal
-    ( ancestors
+    ( ConfigSearchStrategy (..)
+    , ancestors
     ) where
 
 
@@ -13,3 +14,15 @@ import           System.FilePath (joinPath, splitPath)
 -- All ancestors of a dir (including that dir)
 ancestors :: FilePath -> [FilePath]
 ancestors = map joinPath . reverse . dropWhile null . inits . splitPath
+
+
+--------------------------------------------------------------------------------
+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

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