diff --git a/CHANGELOG.md b/CHANGELOG.md index a7e37b504..7e385b518 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +## Unreleased + +* Improvements to `.cabal` file handling: + * When looking for a `.cabal` file, directories were previously + erroneously also considered. [Issue 781]( + https://github.com/tweag/ormolu/issues/781). + * We now print a note if Ormolu was told to consider + `.cabal` files, but no suitable one could be found. + * Handle an empty `hs-source-dirs` correctly. + * Also consider modules which are only conditionally listed + in the `.cabal` file. + ## Ormolu 0.3.0.0 * Data declarations with multiline kind signatures are now formatted diff --git a/expected-failures/Agda.txt b/expected-failures/Agda.txt index 4635785f5..e8b51d72a 100644 --- a/expected-failures/Agda.txt +++ b/expected-failures/Agda.txt @@ -1,3 +1,6 @@ +Found .cabal file Agda.cabal, but it did not mention Setup.hs +Found .cabal file Agda.cabal, but it did not mention src/data/MAlonzo/src/MAlonzo/RTE.hs +Found .cabal file Agda.cabal, but it did not mention src/data/MAlonzo/src/MAlonzo/RTE/Float.hs src/full/Agda/Syntax/Internal.hs AST of input and AST of formatted code differ. at src/full/Agda/Syntax/Internal.hs:640:5 diff --git a/expected-failures/esqueleto.txt b/expected-failures/esqueleto.txt index 63511804a..833a5ba18 100644 --- a/expected-failures/esqueleto.txt +++ b/expected-failures/esqueleto.txt @@ -1,3 +1,4 @@ +Found .cabal file esqueleto.cabal, but it did not mention Setup.hs src/Database/Esqueleto/Internal/Internal.hs:405:1 The GHC parser (in Haddock mode) failed: lexical error in string/character literal at character 's' diff --git a/expected-failures/graphql-engine.txt b/expected-failures/graphql-engine.txt index 690940218..865669a5d 100644 --- a/expected-failures/graphql-engine.txt +++ b/expected-failures/graphql-engine.txt @@ -1,3 +1,6 @@ +Could not find a .cabal file for contrib/metadata-types/generated/HasuraMetadataV2.hs +Found .cabal file server/graphql-engine.cabal, but it did not mention server/Setup.hs +Found .cabal file server/bench-wrk/wrk-websocket-server/wrk-websocket-server.cabal, but it did not mention server/bench-wrk/wrk-websocket-server/Setup.hs server/src-lib/Hasura/Backends/BigQuery/Types.hs @@ -509,22 +509,29 @@ | LessOrEqualOp diff --git a/expected-failures/haxl.txt b/expected-failures/haxl.txt index 37dae1082..9a0e960dc 100644 --- a/expected-failures/haxl.txt +++ b/expected-failures/haxl.txt @@ -1,3 +1,4 @@ Haxl/Core/DataCache.hs:54:49 The GHC parser (in Haddock mode) failed: Not a data constructor: `!' +Found .cabal file haxl.cabal, but it did not mention Setup.hs diff --git a/expected-failures/hlint.txt b/expected-failures/hlint.txt index 76f9e8337..8d77a1b74 100644 --- a/expected-failures/hlint.txt +++ b/expected-failures/hlint.txt @@ -1,3 +1,7 @@ +Found .cabal file hlint.cabal, but it did not mention Setup.hs +Found .cabal file hlint.cabal, but it did not mention data/HLint_QuickCheck.hs +Found .cabal file hlint.cabal, but it did not mention data/HLint_TypeCheck.hs +Found .cabal file hlint.cabal, but it did not mention data/Test.hs src/Extension.hs @@ -17,7 +17,8 @@ UnboxedTuples, diff --git a/expected-failures/idris.txt b/expected-failures/idris.txt index 0a286508f..fcc177751 100644 --- a/expected-failures/idris.txt +++ b/expected-failures/idris.txt @@ -1,3 +1,4 @@ +Found .cabal file idris.cabal, but it did not mention Setup.hs src/Idris/Parser.hs:1052:1 The GHC parser (in Haddock mode) failed: parse error on input `@' diff --git a/expected-failures/intero.txt b/expected-failures/intero.txt index c0c12ba47..0ef179637 100644 --- a/expected-failures/intero.txt +++ b/expected-failures/intero.txt @@ -1,3 +1,4 @@ +Found .cabal file intero.cabal, but it did not mention Setup.hs src/InteractiveUI.hs @@ -3746,6 +3746,7 @@ stdout diff --git a/expected-failures/pandoc.txt b/expected-failures/pandoc.txt index 3f69b2803..4377fa571 100644 --- a/expected-failures/pandoc.txt +++ b/expected-failures/pandoc.txt @@ -1,3 +1,4 @@ +Found .cabal file pandoc.cabal, but it did not mention Setup.hs src/Text/Pandoc/Readers/Vimwiki.hs @@ -618,7 +618,8 @@ <$ ( skipMany1 spaceChar @@ -12,3 +13,4 @@ src/Text/Pandoc/Readers/Vimwiki.hs Formatting is not idempotent. Please, consider reporting the bug. +Found .cabal file pandoc.cabal, but it did not mention test/command/3510-src.hs diff --git a/expected-failures/pipes.txt b/expected-failures/pipes.txt index bef2df5c5..6f23a639c 100644 --- a/expected-failures/pipes.txt +++ b/expected-failures/pipes.txt @@ -1,3 +1,4 @@ +Found .cabal file pipes.cabal, but it did not mention Setup.hs src/Pipes/Core.hs AST of input and AST of formatted code differ. at src/Pipes/Core.hs:(128,1)-(151,2) diff --git a/expected-failures/postgrest.txt b/expected-failures/postgrest.txt index 8162785a7..7a204dfec 100644 --- a/expected-failures/postgrest.txt +++ b/expected-failures/postgrest.txt @@ -1,3 +1,4 @@ +Found .cabal file postgrest.cabal, but it did not mention Setup.hs src/PostgREST/DbRequestBuilder.hs @@ -148,12 +148,11 @@ -- /projects?select=clients(*) diff --git a/nix/ormolize/default.nix b/nix/ormolize/default.nix index 99dbf6661..5021ba36d 100644 --- a/nix/ormolize/default.nix +++ b/nix/ormolize/default.nix @@ -32,14 +32,14 @@ cp "$hs_file" "''${hs_file}-original" done - (ormolu --cabal-default-extensions --check-idempotence --mode inplace $hs_files || true) 2> log.txt + ((ormolu --cabal-default-extensions --check-idempotence --mode inplace $hs_files; echo $? > exit_code) || true) 2> log.txt ''; inherit doCheck; checkPhase = if expectedFailures == null then '' echo "No failures expected" - if [[ -s log.txt ]]; then exit 1; fi + if (( $(cat exit_code) != 0 )); then exit 1; fi '' else '' diff --ignore-blank-lines --color=always ${expectedFailures} log.txt diff --git a/ormolu.cabal b/ormolu.cabal index cfc09cbd4..6dc451994 100644 --- a/ormolu.cabal +++ b/ormolu.cabal @@ -149,11 +149,13 @@ test-suite tests build-depends: base >=4.12 && <5.0, containers >=0.5 && <0.7, + directory ^>=1.3, filepath >=1.2 && <1.5, hspec >=2.0 && <3.0, ormolu, path >=0.6 && <0.10, path-io >=1.4.2 && <2.0, + temporary ^>=1.3, text >=0.2 && <1.3 if flag(dev) diff --git a/src/Ormolu/Utils/Extensions.hs b/src/Ormolu/Utils/Extensions.hs index ebfef278c..059988347 100644 --- a/src/Ormolu/Utils/Extensions.hs +++ b/src/Ormolu/Utils/Extensions.hs @@ -14,18 +14,19 @@ where import Control.Exception import Control.Monad.IO.Class import qualified Data.ByteString as B -import Data.List (find) import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as M import Data.Maybe (maybeToList) import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription import Distribution.PackageDescription.Parsec +import qualified Distribution.Types.CondTree as CT import Language.Haskell.Extension import Ormolu.Config import Ormolu.Exception import System.Directory import System.FilePath +import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError) -- | Get a map from Haskell source file paths (without any extensions) @@ -49,12 +50,17 @@ getExtensionsFromCabalFile cabalFile = liftIO $ do buildMap extractFromBenchmark . snd <$> condBenchmarks ] where - buildMap f a = let (files, exts) = f (condTreeData a) in M.fromList $ (,exts) <$> files + buildMap f a = let (files, exts) = f mergedA in M.fromList $ (,exts) <$> files + where + (mergedA, _) = CT.ignoreConditions a extractFromBuildInfo extraModules BuildInfo {..} = (,exts) $ do m <- extraModules ++ (ModuleName.toFilePath <$> otherModules) - (takeDirectory cabalFile ) . ( dropExtensions m) <$> hsSourceDirs + (takeDirectory cabalFile ) <$> prependSrcDirs (dropExtensions m) where + prependSrcDirs f + | null hsSourceDirs = [f] + | otherwise = ( f) <$> hsSourceDirs exts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions langExt = pure . DynOption . \case @@ -94,11 +100,19 @@ findCabalFile :: m (Maybe FilePath) findCabalFile p = liftIO $ do let parentDir = takeDirectory p - ps <- + dirEntries <- listDirectory parentDir `catch` \case (isDoesNotExistError -> True) -> pure [] e -> throwIO e - case find ((== ".cabal") . takeExtension) ps of + let findDotCabal = \case + [] -> pure Nothing + e : es + | takeExtension e == ".cabal" -> + doesFileExist (parentDir e) >>= \case + True -> pure $ Just e + False -> findDotCabal es + _ : es -> findDotCabal es + findDotCabal dirEntries >>= \case Just cabalFile -> pure . Just $ parentDir cabalFile Nothing -> if isDrive parentDir @@ -114,9 +128,18 @@ getCabalExtensionDynOptions :: m [DynOption] getCabalExtensionDynOptions sourceFile' = liftIO $ do sourceFile <- makeAbsolute sourceFile' - mCabalFile <- findCabalFile sourceFile - case mCabalFile of + findCabalFile sourceFile >>= \case Just cabalFile -> do extsByFile <- getExtensionsFromCabalFile cabalFile - pure $ M.findWithDefault [] (dropExtensions sourceFile) extsByFile - Nothing -> pure [] + case M.lookup (dropExtensions sourceFile) extsByFile of + Just exts -> pure exts + Nothing -> do + relativeCabalFile <- makeRelativeToCurrentDirectory cabalFile + note $ + "Found .cabal file " + <> relativeCabalFile + <> ", but it did not mention " + <> sourceFile' + Nothing -> note $ "Could not find a .cabal file for " <> sourceFile' + where + note msg = [] <$ hPutStrLn stderr msg diff --git a/tests/Ormolu/CabalExtensionsSpec.hs b/tests/Ormolu/CabalExtensionsSpec.hs index 547cc169c..a1baed62a 100644 --- a/tests/Ormolu/CabalExtensionsSpec.hs +++ b/tests/Ormolu/CabalExtensionsSpec.hs @@ -3,6 +3,9 @@ module Ormolu.CabalExtensionsSpec (spec) where import qualified Data.Map as M import Ormolu.Config import Ormolu.Utils.Extensions +import System.Directory +import System.FilePath +import System.IO.Temp (withSystemTempDirectory) import Test.Hspec spec :: Spec @@ -23,5 +26,10 @@ spec = describe "Handle extensions from .cabal files" $ do cabalFile `shouldBe` Just expectedCabalFile findsOrmoluCabal "src/Ormolu/Config.hs" "./ormolu.cabal" findsOrmoluCabal "a/b/c/d/e" "./ormolu.cabal" + it "do not consider directories as .cabal files" $ + withSystemTempDirectory "" $ \dir -> do + createDirectory $ dir ".cabal" + cabalFile <- findCabalFile $ dir "foo/bar.hs" + cabalFile `shouldBe` Nothing where members as m = all (`M.member` m) as