Upgrade for GHC 9.10

.github/workflows/ci.yml

@@ -4,54 +4,39 @@ on: ['pull_request', 'push']
 
 jobs:
   build:
-    name: Build on ${{ matrix.os }}
+    name: Build on ${{ matrix.os }} with GHC ${{ matrix.ghc }}
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
         os: [ubuntu-latest, macOS-latest]
-        stack: ["2.15.7"]
+        ghc: ["9.6.6", "9.8", "9.10"]
 
     steps:
-    - name: Get the version
-      id: get_version
-      run: 'echo ::set-output name=version::${GITHUB_REF#refs/tags/}'
-
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v4
 
     - uses: haskell-actions/setup@v2
-      name: Setup Haskell Stack
+      id: setup
       with:
-        enable-stack: true
-        stack-version: ${{ matrix.stack }}
-        stack-no-global: true
+        ghc-version: ${{ matrix.ghc }}
 
-    - uses: actions/cache@v2
-      name: Cache ~/.stack
+    - uses: actions/cache@v3
       with:
-        path: ~/.stack
-        key: "${{ runner.os }}-v9-${{ hashFiles('stylish-haskell.cabal', 'stack.yaml', 'stack.yaml.lock') }}"
-
-    - name: Add ~/.local/bin to PATH
-      run: echo "$HOME/.local/bin" >> $GITHUB_PATH
+        path: ${{ steps.setup.outputs.cabal-store }}
+        key: ${{ runner.os }}-${{ matrix.ghc }}-v2-${{ hashFiles('*.cabal') }}
+        restore-keys: |
+          ${{ runner.os }}-${{ matrix.ghc }}-v2-
 
-    - name: Build
-      run: make build
-      id: build
+    - run: make build
+    - run: make test
 
-    - name: Test
-      run: make test
-
-    - name: Build artifact
-      if: startsWith(github.ref, 'refs/tags')
+    - if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8')
       run: make artifact
-      env:
-        PATAT_TAG: ${{ steps.get_version.outputs.version }}
 
-    - uses: actions/upload-artifact@v2
-      if: startsWith(github.ref, 'refs/tags')
+    - uses: actions/upload-artifact@v4
+      if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8')
       with:
         path: artifacts/*
-        name: artifacts
+        name: artifacts-${{ runner.os }}
 
   release:
     name: Release
@@ -60,41 +45,15 @@ jobs:
     if: startsWith(github.ref, 'refs/tags')
 
     steps:
-    - name: Get the version
-      id: get_version
-      run: 'echo ::set-output name=version::${GITHUB_REF#refs/tags/}'
-
     - uses: actions/download-artifact@v4
       with:
-        name: artifacts
-
-    - name: Display structure of downloaded files
-      run: ls -R
+        pattern: artifacts-*
 
-    - uses: actions/create-release@v1
-      id: create_release
-      env:
-        GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-      with:
-        tag_name: ${{ steps.get_version.outputs.version }}
-        release_name: ${{ steps.get_version.outputs.version }}
-
-    - name: Upload Linux Asset
-      uses: actions/upload-release-asset@v1
-      env:
-        GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-      with:
-        upload_url: ${{ steps.create_release.outputs.upload_url }}
-        asset_path: ./stylish-haskell-${{ steps.get_version.outputs.version }}-linux-x86_64.tar.gz
-        asset_name: stylish-haskell-${{ steps.get_version.outputs.version }}-linux-x86_64.tar.gz
-        asset_content_type: application/gzip
+    - run: ls -R
+    - run: 'sha256sum artifacts-*/*'
 
-    - name: Upload MacOS Asset
-      uses: actions/upload-release-asset@v1
+    - uses: softprops/action-gh-release@v1
       env:
         GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
       with:
-        upload_url: ${{ steps.create_release.outputs.upload_url }}
-        asset_path: ./stylish-haskell-${{ steps.get_version.outputs.version }}-darwin-x86_64.zip
-        asset_name: stylish-haskell-${{ steps.get_version.outputs.version }}-darwin-x86_64.zip
-        asset_content_type: application/zip
+        files: 'artifacts-*/stylish-haskell-*'

CHANGELOG

@@ -1,5 +1,21 @@
 # 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)
      * #471 Support GHC 9.8 (by Michael Peyton Jones)
      * #440 Fix dissappearing `DEPRECATED` pragma on module (by Lev Dvorkin)

Makefile

@@ -27,8 +27,6 @@ COMPRESS_BIN_DEPS=$(UPX_BINARY)
 COMPRESS_BIN=upx
 endif
 
-STACK=stack
-
 # Default target.
 .PHONY: build
 build: $(STYLISH_BINARY)
@@ -49,7 +47,7 @@ $(STYLISH_PACKAGE).$(ARCHIVE): $(STYLISH_BINARY) $(COMPRESS_BIN_DEPS)
 	$(ARCHIVE_CREATE) $(STYLISH_PACKAGE).$(ARCHIVE) $(STYLISH_PACKAGE)
 
 $(STYLISH_BINARY):
-	$(STACK) build --copy-bins
+	cabal install --installdir="$(dir $(STYLISH_BINARY))"
 
 # UPX is used to compress the resulting binary.  We currently don't use this on
 # Mac OS.
@@ -62,4 +60,4 @@ $(UPX_BINARY):
 
 .PHONY: test
 test:
-	stack build --test
+	cabal test

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

@@ -7,47 +7,55 @@ module Language.Haskell.Stylish.Config.Cabal
 --------------------------------------------------------------------------------
 import           Control.Monad                            (unless)
 import qualified Data.ByteString.Char8                    as BS
-import           Data.Either                              (isRight)
 import           Data.Foldable                            (traverse_)
 import           Data.List                                (nub)
 import           Data.Maybe                               (maybeToList)
 import qualified Distribution.PackageDescription          as Cabal
 import qualified Distribution.PackageDescription.Parsec   as Cabal
 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           Language.Haskell.Stylish.Config.Internal
-import GHC.Data.Maybe (mapMaybe)
-
-
---------------------------------------------------------------------------------
-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.
-findCabalFile :: Verbose -> IO (Maybe FilePath)
-findCabalFile verbose = do
-  potentialProjectRoots <- ancestors <$> getCurrentDirectory
-  potentialCabalFile <- filter isRight <$>
-    traverse Cabal.findPackageDesc potentialProjectRoots
-  case potentialCabalFile of
-    [Right cabalFile] -> return (Just cabalFile)
-    _ -> do
-      verbose $ ".cabal file not found, directories searched: " <>
-        show potentialProjectRoots
-      verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
-      return Nothing
+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
+    verbose $ ".cabal file not found, directories searched: " <>
+      show searched
+    verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
+    return Nothing
+  go searched (p : ps) = do
+    let projectRoot = Just $ Cabal.makeSymbolicPath p
+    potentialCabalFile <- Cabal.findPackageDesc projectRoot
+    case potentialCabalFile of
+      Right cabalFile -> pure $ Just $
+        Cabal.interpretSymbolicPath projectRoot cabalFile
+      _ -> go (p : searched) ps
 
 
 --------------------------------------------------------------------------------

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