Make it possible to search for config without getCurrentDirectory

.github/workflows/cabal.yml

@@ -15,7 +15,7 @@ jobs:
     steps:
     - uses: actions/checkout@v2
 
-    - uses: haskell/actions/setup@v2
+    - uses: haskell-actions/setup@v2
       name: Setup Haskell Cabal
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -27,7 +27,7 @@ jobs:
         key: "${{ runner.os }}-${{ matrix.ghc }}-v9-${{ hashFiles('stylish-haskell.cabal') }}"
 
     - name: Build
-      run: cabal build 
+      run: cabal build
       id: build
 
     - name: Test

.github/workflows/ci.yml

@@ -9,8 +9,8 @@ jobs:
     strategy:
       matrix:
         os: [ubuntu-latest, macOS-latest]
-        stack: ["2.1.3"]
-        ghc: ["8.8.3"]
+        stack: ["2.15.5"]
+        ghc: ["9.8.2"]
 
     steps:
     - name: Get the version
@@ -19,7 +19,7 @@ jobs:
 
     - uses: actions/checkout@v2
 
-    - uses: haskell/actions/setup@v2
+    - uses: haskell-actions/setup@v2
       name: Setup Haskell Stack
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -31,8 +31,10 @@ jobs:
         path: ~/.stack
         key: "${{ runner.os }}-${{ matrix.ghc }}-v9-${{ hashFiles('stylish-haskell.cabal', 'stack.yaml', 'stack.yaml.lock') }}"
 
-    - name: Add ~/.local/bin to PATH
-      run: echo "$HOME/.local/bin" >> $GITHUB_PATH
+    - name: Add ~/.local/bin and ~/.ghcup/bin to PATH
+      run: |
+        echo "$HOME/.local/bin" >> $GITHUB_PATH
+        echo "$HOME/.ghcup/bin" >> $GITHUB_PATH
 
     - name: Build
       run: make build

CHANGELOG

@@ -1,5 +1,8 @@
 # CHANGELOG
 
+- UNRELEASED
+     * #482 Add ConfigSearchStrategy to allow avoiding getCurrentDirectory when loading config (by Jan Hrček)
+
 - 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)

Makefile

@@ -1,3 +1,4 @@
+SHELL=/bin/bash
 ARCH=$(shell uname -m)
 UNAME=$(shell uname | tr 'A-Z' 'a-z')
 

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

stack.yaml

@@ -1,11 +1,3 @@
-resolver: nightly-2024-01-05
-
-extra-deps:
-  - ghc-lib-parser-9.8.1.20231121
-  - ghc-lib-parser-ex-9.8.0.0
-  - test-framework-0.8.2.0
-  - test-framework-hunit-0.3.0.2
-  - ansi-wl-pprint-0.6.9
-
+resolver: nightly-2024-06-28
 save-hackage-creds: false
-compiler: ghc-9.8.1
+compiler: ghc-9.8.2

stack.yaml.lock

@@ -3,45 +3,10 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages:
-- completed:
-    hackage: ghc-lib-parser-9.6.2.20230523@sha256:160fc11671ce69e756d67f42a75c564863f59b81782a3d23efc27a845d61041b,15694
-    pantry-tree:
-      sha256: 99328c298629fa921985d3de081354625463b659ca7122a1971e548d7051c68a
-      size: 33893
-  original:
-    hackage: ghc-lib-parser-9.6.2.20230523
-- completed:
-    hackage: ghc-lib-parser-ex-9.6.0.0@sha256:52e6ffb031669183ebfcff373a5cf0d89eb7621151d3822d80b5a2cce9123871,3493
-    pantry-tree:
-      sha256: 46525028b1594a7e3464620bb72158a64d181c556796855907c4e26b6bacf20d
-      size: 1955
-  original:
-    hackage: ghc-lib-parser-ex-9.6.0.0
-- completed:
-    hackage: test-framework-0.8.2.0@sha256:d62395d54bb2a0e2fe2dacd55f55678bc87a769103cca6295ead59720f92158f,6550
-    pantry-tree:
-      sha256: 3977a161a7105e8b4d5685df546eb00960c660afc5a0d295794e47d33c52222d
-      size: 2050
-  original:
-    hackage: test-framework-0.8.2.0
-- completed:
-    hackage: test-framework-hunit-0.3.0.2@sha256:7fd007e9cb082cd64a2213a6d36acf057f7d6df6b5343a088e81b2b3a9a23545,1487
-    pantry-tree:
-      sha256: 355897b03e0320296f207350f8c8aba4071b673021aef726bac27e3ad0bbb2cc
-      size: 239
-  original:
-    hackage: test-framework-hunit-0.3.0.2
-- completed:
-    hackage: ansi-wl-pprint-0.6.9@sha256:fb737bc96e2aef34ad595d54ced7a73f648c521ebcb00fe0679aff45ccd49212,2448
-    pantry-tree:
-      sha256: ebb02b32915c04146b193949c3c48d9e8200c152f38947e8d23ca25b0997e188
-      size: 472
-  original:
-    hackage: ansi-wl-pprint-0.6.9
+packages: []
 snapshots:
 - completed:
-    sha256: f040c40c0c7bceb931bb2fd36361e2580a2a78dabee350f18d0af32e2e7182c6
-    size: 504175
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2023/6/23.yaml
-  original: nightly-2023-06-23
+    sha256: a7f021220a9c5baaf5901b852feaabf773a7a0e3fd10f137379a90620b57a22a
+    size: 650424
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/6/28.yaml
+  original: nightly-2024-06-28

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