Skip to content

Commit

Permalink
Merge the two Globbing modules in cabal and cabal-install
Browse files Browse the repository at this point in the history
We use the datatype representation from the globbing in cabal-install,
but preserve a standalone parser for globs present in cabal files, whose
specification is constrained by the cabal specification. The
implementations are merged taking the best parts of each.

We also make sure sdist is robust to accidentally-listed directories,
as the refactor of the globbing modules re-uncovered this issue, and
required a prompt fix for the refactor not to break some things.

Fixes haskell#5349
  • Loading branch information
alt-romes authored and sheaf committed Feb 15, 2024
1 parent d35f4e6 commit 0852ae7
Show file tree
Hide file tree
Showing 29 changed files with 754 additions and 549 deletions.
14 changes: 9 additions & 5 deletions Cabal-tests/tests/UnitTests/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module UnitTests.Distribution.Simple.Glob
( tests
) where
Expand Down Expand Up @@ -54,7 +55,7 @@ compatibilityTests version =
[ testCase "literal match" $
testMatches "foo/a" [GlobMatch "foo/a"]
, testCase "literal no match on prefix" $
testMatches "foo/c.html" []
testMatches "foo/c.html" [GlobMatchesDirectory "foo/c.html"]
, testCase "literal no match on suffix" $
testMatches "foo/a.html" [GlobMatch "foo/a.html"]
, testCase "literal no prefix" $
Expand All @@ -64,7 +65,7 @@ compatibilityTests version =
, testCase "glob" $
testMatches "*.html" [GlobMatch "a.html", GlobMatch "b.html"]
, testCase "glob in subdir" $
testMatches "foo/*.html" [GlobMatch "foo/a.html", GlobMatch "foo/b.html"]
testMatches "foo/*.html" [GlobMatchesDirectory "foo/c.html", GlobMatch "foo/b.html", GlobMatch "foo/a.html"]
, testCase "glob multiple extensions" $
testMatches "foo/*.html.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/b.html.gz"]
, testCase "glob in deep subdir" $
Expand Down Expand Up @@ -101,13 +102,16 @@ testMatchesVersion version pat expected = do
where
isEqual = (==) `on` (sort . fmap (fmap normalise))
checkPure globPat = do
let actual = mapMaybe (fileGlobMatches globPat) sampleFileNames
unless (sort expected == sort actual) $
let actual = mapMaybe (\p -> (p <$) <$> fileGlobMatches version globPat p) sampleFileNames
-- We drop directory matches from the expected results since the pure
-- check can't identify that kind of match.
expected' = filter (\case GlobMatchesDirectory _ -> False; _ -> True) expected
unless (sort expected' == sort actual) $
assertFailure $ "Unexpected result (pure matcher): " ++ show actual
checkIO globPat =
withSystemTempDirectory "globstar-sample" $ \tmpdir -> do
makeSampleFiles tmpdir
actual <- runDirFileGlob Verbosity.normal tmpdir globPat
actual <- runDirFileGlob Verbosity.normal (Just version) tmpdir globPat
unless (isEqual actual expected) $
assertFailure $ "Unexpected result (impure matcher): " ++ show actual

Expand Down
1 change: 1 addition & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -105,6 +105,7 @@ library
Distribution.Simple.GHCJS
Distribution.Simple.Haddock
Distribution.Simple.Glob
Distribution.Simple.Glob.Internal
Distribution.Simple.HaskellSuite
Distribution.Simple.Hpc
Distribution.Simple.Install
Expand Down
25 changes: 18 additions & 7 deletions Cabal/src/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,9 +61,20 @@ import Distribution.PackageDescription.Check.Warning
import Distribution.Parsec.Warning (PWarning)
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Glob
( Glob
, GlobResult (..)
, globMatches
, parseFileGlob
, runDirFileGlob
)
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Utils.Generic (isAscii)
import Distribution.Utils.Path
( LicenseFile
, PackageDir
, SymbolicPath
, getSymbolicPath
)
import Distribution.Verbosity
import Distribution.Version
import System.FilePath (splitExtension, takeFileName, (<.>), (</>))
Expand Down Expand Up @@ -170,7 +181,7 @@ checkPackageFilesGPD verbosity gpd root =

checkPreIO =
CheckPreDistributionOps
{ runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root </> fp) g
{ runDirFileGlobM = \fp g -> runDirFileGlob verbosity (Just . specVersion $ packageDescription gpd) (root </> fp) g
, getDirectoryContentsM = System.Directory.getDirectoryContents . relative
}

Expand Down Expand Up @@ -853,13 +864,14 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
[PackageDistSuspiciousWarn $ GlobNoMatch title fp]
| otherwise = []

-- If there's a missing directory in play, since our globs don't
-- (currently) support disjunction, that will always mean there are
-- If there's a missing directory in play, since globs in Cabal packages
-- don't (currently) support disjunction, that will always mean there are
-- no matches. The no matches error in this case is strictly less
-- informative than the missing directory error.
withoutNoMatchesWarning (GlobMatch _) = True
withoutNoMatchesWarning (GlobWarnMultiDot _) = False
withoutNoMatchesWarning (GlobMissingDirectory _) = True
withoutNoMatchesWarning (GlobMatchesDirectory _) = True

getWarning :: GlobResult FilePath -> Maybe PackageCheck
getWarning (GlobMatch _) = Nothing
Expand All @@ -871,6 +883,9 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file)
getWarning (GlobMissingDirectory dir) =
Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir)
-- GlobMatchesDirectory is handled elsewhere if relevant;
-- we can discard it here.
getWarning (GlobMatchesDirectory _) = Nothing

-- ------------------------------------------------------------
-- Other exports
Expand Down Expand Up @@ -1012,10 +1027,6 @@ checkMissingDocs dgs esgs edgs = do
return (mcs ++ pcs)
)
where
-- From Distribution.Simple.Glob.
globMatches :: [GlobResult a] -> [a]
globMatches input = [a | GlobMatch a <- input]

checkDoc
:: Bool -- Cabal spec ≥ 1.18?
-> [FilePath] -- Desirables.
Expand Down
5 changes: 5 additions & 0 deletions Cabal/src/Distribution/PackageDescription/Check/Paths.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,11 @@ import Distribution.PackageDescription.Check.Common
import Distribution.PackageDescription.Check.Monad
import Distribution.Simple.CCompiler
import Distribution.Simple.Glob
( Glob
, explainGlobSyntaxError
, isRecursiveInRoot
, parseFileGlob
)
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import System.FilePath (splitDirectories, splitPath, takeExtension)

Expand Down
Loading

0 comments on commit 0852ae7

Please sign in to comment.