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.
  • Loading branch information
alt-romes committed Jan 30, 2024
1 parent 3f4c81f commit 10e7ce6
Show file tree
Hide file tree
Showing 14 changed files with 459 additions and 478 deletions.
2 changes: 1 addition & 1 deletion Cabal-tests/tests/UnitTests/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,7 @@ testMatchesVersion version pat expected = do
where
isEqual = (==) `on` (sort . fmap (fmap normalise))
checkPure globPat = do
let actual = mapMaybe (fileGlobMatches globPat) sampleFileNames
let actual = mapMaybe (matchGlob globPat) ({- splitDirectories -} sampleFileNames)
unless (sort expected == sort actual) $
assertFailure $ "Unexpected result (pure matcher): " ++ show actual
checkIO globPat =
Expand Down
14 changes: 6 additions & 8 deletions Cabal/src/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -170,7 +170,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 @@ -854,7 +854,8 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
| otherwise = []

-- If there's a missing directory in play, since our globs don't
-- (currently) support disjunction, that will always mean there are
-- (currently) support disjunction, (ROMES:TODO: We do now...)
-- 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
Expand Down Expand Up @@ -969,9 +970,9 @@ pd2gpd pd = gpd
-- present in our .cabal file.
checkMissingDocs
:: Monad m
=> [Glob] -- data-files globs.
-> [Glob] -- extra-source-files globs.
-> [Glob] -- extra-doc-files globs.
=> [FilePathGlobRel] -- data-files globs.
-> [FilePathGlobRel] -- extra-source-files globs.
-> [FilePathGlobRel] -- extra-doc-files globs.
-> CheckM m ()
checkMissingDocs dgs esgs edgs = do
extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion
Expand Down Expand Up @@ -1012,9 +1013,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?
Expand Down
4 changes: 2 additions & 2 deletions Cabal/src/Distribution/PackageDescription/Check/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ import Distribution.CabalSpecVersion (CabalSpecVersion)
import Distribution.Package (packageName)
import Distribution.PackageDescription.Check.Warning
import Distribution.Simple.BuildToolDepends (desugarBuildToolSimple)
import Distribution.Simple.Glob (Glob, GlobResult)
import Distribution.Simple.Glob
import Distribution.Types.ExeDependency (ExeDependency)
import Distribution.Types.GenericPackageDescription
import Distribution.Types.LegacyExeDependency (LegacyExeDependency)
Expand Down Expand Up @@ -101,7 +101,7 @@ data CheckPackageContentOps m = CheckPackageContentOps
-- in case in the future we can obtain the same infos other than from IO
-- (e.g. a VCS work tree).
data CheckPreDistributionOps m = CheckPreDistributionOps
{ runDirFileGlobM :: FilePath -> Glob -> m [GlobResult FilePath]
{ runDirFileGlobM :: FilePath -> FilePathGlobRel -> m [GlobResult FilePath]
, getDirectoryContentsM :: FilePath -> m [FilePath]
}

Expand Down
2 changes: 1 addition & 1 deletion Cabal/src/Distribution/PackageDescription/Check/Paths.hs
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,7 @@ checkGlob
:: Monad m
=> CabalField -- .cabal field we are checking.
-> FilePath -- glob filepath pattern
-> CheckM m (Maybe Glob)
-> CheckM m (Maybe FilePathGlobRel)
checkGlob title pat = do
ver <- asksCM ccSpecVersion

Expand Down

0 comments on commit 10e7ce6

Please sign in to comment.