Skip to content

Commit 9c97b3e

Browse files
alt-romesalt-romes
committed
Closure property in the solver for private dependencies and finish private dependencies
Romes edits on top of MPs edits: implements the closure property and fixes the remaining bits of private dependencies such that the whole testsuite passes my edits Remove that [PackageName] attempt My example Get tests compiling Fix qualified constraints Readd support for --show-solver-log flag testsuite Add several tests WIP readd qualifyDeps privat ewrong just fail to make it work ... W RM Fix all the testsuite Corrently inheritQ for deps of packages in the private scope that are also in the private scope should not introduce top level but rather qualilfied goals... Ammendmmends to patch Drop allDependencies /easy Add cabal-hooks-demo PackageTest Closure-property-test PackageTest Drop 'tail' usage from InstallPlan More cleanups First pass of clean up, including naive impls for missing commands Add backpack + private deps test Tests for nested private scopes uhh... borked Fix first bug Fix second nested priv deps test Fix PackageInconsistency error checks, testsuite privdeps passing changes to tests Fix more PackageTests for PrivateDeps Formatting Satisfy build and lint Accept parser tests X Y Described PrivateDependency Z W A B Describe user constraint private qual Normal verbose Revert "Normal verbose" This reverts commit 7ea5838. Reapply "Normal verbose" This reverts commit 0114342. Not so pretty Thing to make tests pass Revert "Not so pretty Thing to make tests pass" This reverts commit 71e521a. Fix test stanzas ignored thing X fix first part of the problem for test Fix part 2 FORMAT
1 parent 6051bf6 commit 9c97b3e

File tree

191 files changed

+6897
-5538
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

191 files changed

+6897
-5538
lines changed

‎Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,13 +3,13 @@
33
{-# OPTIONS_GHC -fno-warn-orphans #-}
44
module Test.QuickCheck.Instances.Cabal () where
55

6-
import Control.Applicative (liftA2)
76
import Data.Bits (shiftR)
87
import Data.Char (isAlphaNum, isDigit, toLower)
98
import Data.List (intercalate, (\\))
109
import Data.List.NonEmpty (NonEmpty (..))
1110
import Distribution.Utils.Generic (lowercase)
1211
import Test.QuickCheck
12+
import Control.Applicative (liftA2)
1313

1414
#if MIN_VERSION_base(4,8,0)
1515
import Data.Bits (countLeadingZeros, finiteBitSize, shiftL)
@@ -206,6 +206,23 @@ instance Arbitrary Dependency where
206206
| (pn', vr', lb') <- shrink (pn, vr, lb)
207207
]
208208

209+
-------------------------------------------------------------------------------
210+
-- Private Dependency
211+
-------------------------------------------------------------------------------
212+
213+
instance Arbitrary PrivateAlias where
214+
arbitrary = PrivateAlias <$> arbitrary
215+
shrink (PrivateAlias al) = PrivateAlias <$> shrink al
216+
instance Arbitrary PrivateDependency where
217+
arbitrary = PrivateDependency
218+
<$> arbitrary
219+
<*> arbitrary
220+
221+
shrink (PrivateDependency al dps) =
222+
[ PrivateDependency al' dps'
223+
| (al', dps') <- shrink (al, dps)
224+
]
225+
209226
-------------------------------------------------------------------------------
210227
-- PackageVersionConstraint
211228
-------------------------------------------------------------------------------

‎Cabal-described/src/Distribution/Described.hs

Lines changed: 19 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ import Distribution.Types.AbiDependency (AbiDependency)
7676
import Distribution.Types.AbiHash (AbiHash)
7777
import Distribution.Types.BenchmarkType (BenchmarkType)
7878
import Distribution.Types.BuildType (BuildType)
79-
import Distribution.Types.Dependency (Dependency)
79+
import Distribution.Types.Dependency (Dependency, PrivateAlias(..), PrivateDependency)
8080
import Distribution.Types.ExecutableScope (ExecutableScope)
8181
import Distribution.Types.ExeDependency (ExeDependency)
8282
import Distribution.Types.ExposedModule (ExposedModule)
@@ -370,7 +370,7 @@ instance Described CompilerId where
370370
<> describe (Proxy :: Proxy Version)
371371

372372
instance Described Dependency where
373-
describe _ = REAppend
373+
describe _ = REAppend
374374
[ RENamed "pkg-name" (describe (Proxy :: Proxy PackageName))
375375
, REOpt $
376376
reChar ':'
@@ -391,6 +391,19 @@ instance Described Dependency where
391391
where
392392
vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange))
393393

394+
instance Described PrivateDependency where
395+
describe _ = REAppend
396+
[ RENamed "alias" (describe (Proxy :: Proxy PrivateAlias))
397+
, RESpaces1
398+
, "with"
399+
, RESpaces1
400+
, reChar '('
401+
, RESpaces
402+
, REMunch reSpacedComma (describe (Proxy :: Proxy Dependency))
403+
, RESpaces
404+
, reChar ')'
405+
]
406+
394407
instance Described ExecutableScope where
395408
describe _ = REUnion ["public","private"]
396409

@@ -446,6 +459,9 @@ instance Described ModuleName where
446459
describe _ = REMunch1 (reChar '.') component where
447460
component = RECharSet csUpper <> REMunch reEps (REUnion [RECharSet csAlphaNum, RECharSet (fromString "_'")])
448461

462+
instance Described PrivateAlias where
463+
describe _ = describe (Proxy :: Proxy ModuleName)
464+
449465
instance Described ModuleReexport where
450466
describe _ = RETodo
451467

@@ -591,4 +607,4 @@ instance Described CompatLicenseFile where
591607
describe _ = describe ([] :: [Token])
592608

593609
instance Described CompatFilePath where
594-
describe _ = describe ([] :: [Token])
610+
describe _ = describe ([] :: [Token])

‎Cabal-syntax/src/Distribution/FieldGrammar/Class.hs

Lines changed: 0 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -133,20 +133,6 @@ class
133133
-- ^ lens into the field
134134
-> g s a
135135

136-
-- | Like monoidalFieldAla but the field-name can have a parsed suffix
137-
monoidalFieldPrefixAla
138-
:: (c b, c d, Monoid a)
139-
=> FieldName
140-
-- ^ field name prefix
141-
-- b = parsing rest of prefix field
142-
-- d = parsing contents of field
143-
-> (a -> [(b, d)])
144-
-> ([(b, d)] -> a)
145-
-- ^ 'pack'
146-
-> ALens' s a
147-
-- ^ lens into the field
148-
-> g s a
149-
150136
-- | Parser matching all fields with a name starting with a prefix.
151137
prefixedFields
152138
:: FieldName

‎Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs

Lines changed: 2 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
{-# LANGUAGE DeriveFunctor #-}
2+
{-# LANGUAGE InstanceSigs #-}
23
{-# LANGUAGE MultiParamTypeClasses #-}
34
{-# LANGUAGE OverloadedStrings #-}
4-
{-# LANGUAGE ScopedTypeVariables #-}
5-
{-# LANGUAGE InstanceSigs #-}
65
{-# LANGUAGE PartialTypeSignatures #-}
6+
{-# LANGUAGE ScopedTypeVariables #-}
77

88
-- | This module provides a 'FieldGrammarParser', one way to parse
99
-- @.cabal@ -like files.
@@ -75,7 +75,6 @@ import Distribution.Utils.String (trim)
7575
import Prelude ()
7676

7777
import qualified Data.ByteString as BS
78-
import qualified Data.ByteString.Char8 as BS8
7978
import qualified Data.List.NonEmpty as NE
8079
import qualified Data.Map.Strict as Map
8180
import qualified Data.Set as Set
@@ -90,9 +89,6 @@ import Distribution.Fields.ParseResult
9089
import Distribution.Parsec
9190
import Distribution.Parsec.FieldLineStream
9291
import Distribution.Parsec.Position (positionCol, positionRow)
93-
import Distribution.Compat.Lens
94-
import Distribution.Compat.CharParsing (CharParsing(..), spaces)
95-
import Distribution.Types.Dependency (PrivateAlias(..))
9692

9793
-------------------------------------------------------------------------------
9894
-- Auxiliary types
@@ -271,45 +267,6 @@ instance FieldGrammar Parsec ParsecFieldGrammar where
271267

272268
parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls
273269

274-
monoidalFieldPrefixAla :: (Parsec b, Parsec d, Monoid a)
275-
=> FieldName
276-
-> (a -> [(b, d)])
277-
-> ([(b, d)] -> a)
278-
-> ALens' s a
279-
-> ParsecFieldGrammar s a
280-
monoidalFieldPrefixAla fnPfx _unpack _pack _extract = ParsecFG mempty (Set.singleton fnPfx) parser
281-
282-
where
283-
parser :: CabalSpecVersion -> Fields Position -> ParseResult _
284-
parser v values = process v $ filter match $ Map.toList values
285-
286-
process v xs = case xs of
287-
[] -> pure mempty
288-
xs -> foldMap _pack <$> traverse (parseStanza v) xs
289-
290-
parseStanza v (header, fls) = do
291-
traceShowM (header, fls)
292-
let mn = BS.drop (BS.length fnPfx + 1) header
293-
-- let name'' = PrivateAlias (fromString (map toUpper (BS8.unpack mn)))
294-
name'' <- runFieldParser' [] parsec v (fieldLineStreamFromBS mn)
295-
dls <- traverse (parseOne v) fls
296-
return $ [(name'', d) | d <- dls]
297-
298-
299-
parseOne v (MkNamelessField pos fls) = do
300-
runFieldParser pos parsec v fls
301-
302-
match (fn, _) = fnPfx `BS.isPrefixOf` fn
303-
304-
{-
305-
convert (fn, fields) =
306-
[ (pos, (fromUTF8BS fn, trim $ fromUTF8BS $ fieldlinesToBS fls))
307-
| MkNamelessField pos fls <- fields
308-
]
309-
-- hack: recover the order of prefixed fields
310-
reorder = map snd . sortBy (comparing fst)
311-
-}
312-
313270
prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs))
314271
where
315272
parser :: Fields Position -> [(String, String)]

‎Cabal-syntax/src/Distribution/FieldGrammar/Pretty.hs

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -86,16 +86,6 @@ instance FieldGrammar Pretty PrettyFieldGrammar where
8686
where
8787
pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s)))
8888

89-
monoidalFieldPrefixAla fnPfx _pack _unpack l = PrettyFG pp
90-
where
91-
pp v s =
92-
let d = _pack (aview l s)
93-
in concatMap (doOne v) d
94-
95-
doOne v (h, l) =
96-
let pfxString = PP.render (prettyVersioned v h)
97-
in ppField (fnPfx <> fromString " " <> toUTF8BS pfxString) (prettyVersioned v l)
98-
9989
prefixedFields _fnPfx l = PrettyFG (\_ -> pp . aview l)
10090
where
10191
pp xs =

‎Cabal-syntax/src/Distribution/ModuleName.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -99,12 +99,6 @@ validModuleComponent (c : cs) = isUpper c && all validModuleChar cs
9999
instance IsString ModuleName where
100100
fromString = ModuleName . toShortText
101101

102-
-- | Construct a 'ModuleName' from valid module components, i.e. parts
103-
-- separated by dots.
104-
fromComponents :: [String] -> ModuleName
105-
fromComponents comps = fromString (intercalate "." comps)
106-
{-# DEPRECATED fromComponents "Exists for cabal-install only" #-}
107-
108102
-- | The module name @Main@.
109103
main :: ModuleName
110104
main = ModuleName (fromString "Main")
@@ -119,6 +113,13 @@ components mn = split (unModuleName mn)
119113
(chunk, []) -> chunk : []
120114
(chunk, _ : rest) -> chunk : split rest
121115

116+
-- | Construct a 'ModuleName' from valid module components, i.e. parts
117+
-- separated by dots.
118+
--
119+
-- Inverse of 'components', i.e. @fromComponents (components x) = x@
120+
fromComponents :: [String] -> ModuleName
121+
fromComponents comps = fromString (intercalate "." comps)
122+
122123
-- | Convert a module name to a file path, but without any file extension.
123124
-- For example:
124125
--

‎Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -339,17 +339,20 @@ unionVersionRanges' (vr, cs) (vr', cs') = (unionVersionRanges vr vr', cs <> cs')
339339

340340
toDepMapUnion :: Dependencies -> DepMapUnion
341341
toDepMapUnion ds =
342-
DepMapUnion $ Map.fromListWith unionVersionRanges'
343-
([((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds]
344-
++ [((p, Private (private_alias d, pns)), (vr, cs)) | d <- privateDependencies ds, let pns = map depPkgName (private_depends d), Dependency p vr cs <- private_depends d])
342+
DepMapUnion $
343+
Map.fromListWith
344+
unionVersionRanges'
345+
( [((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds]
346+
++ [((p, Private (private_alias d)), (vr, cs)) | d <- privateDependencies ds, Dependency p vr cs <- private_depends d]
347+
)
345348

346349
fromDepMapUnion :: DepMapUnion -> Dependencies
347350
fromDepMapUnion m =
348351
Dependencies
349352
[Dependency p vr cs | ((p, Public), (vr, cs)) <- Map.toList (unDepMapUnion m)]
350353
[PrivateDependency alias deps | (alias, deps) <- Map.toList priv_deps]
351-
where
352-
priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, Private (sn, _)), (vr, cs)) <- Map.toList (unDepMapUnion m)]
354+
where
355+
priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, Private sn), (vr, cs)) <- Map.toList (unDepMapUnion m)]
353356

354357
freeVars :: CondTree ConfVar c a -> [FlagName]
355358
freeVars t = [f | PackageFlag f <- freeVars' t]
@@ -534,8 +537,10 @@ finalizePD
534537
| otherwise -> [b, not b]
535538
-- flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
536539
check ds =
537-
let missingDeps = Dependencies (filter (not . satisfyDep Nothing) (publicDependencies ds))
538-
(mapMaybe (\(PrivateDependency priv ds) -> case filter (not . satisfyDep (Just priv)) ds of { [] -> Nothing; ds' -> Just (PrivateDependency priv ds') }) (privateDependencies ds))
540+
let missingDeps =
541+
Dependencies
542+
(filter (not . satisfyDep Nothing) (publicDependencies ds))
543+
(mapMaybe (\(PrivateDependency priv pds) -> case filter (not . satisfyDep (Just priv)) pds of [] -> Nothing; pds' -> Just (PrivateDependency priv pds')) (privateDependencies ds))
539544
in if null (publicDependencies missingDeps) && null (privateDependencies missingDeps)
540545
then DepOk
541546
else MissingDeps missingDeps

‎Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -677,7 +677,7 @@ buildInfoFieldGrammar =
677677
<*> pure mempty -- static-options ???
678678
<*> prefixedFields "x-" L.customFieldsBI
679679
<*> monoidalFieldAla "build-depends" formatDependencyList L.targetBuildDepends
680-
<*> monoidalFieldAla "private-build-depends" formatPrivateDependencyList L.targetPrivateBuildDepends --(map (\(PrivateDependency a ds) -> (a, formatDependencyList ds))) (map (\(alias, ds) -> PrivateDependency alias (unpack' formatDependencyList ds))) L.targetPrivateBuildDepends
680+
<*> monoidalFieldAla "private-build-depends" formatPrivateDependencyList L.targetPrivateBuildDepends -- (map (\(PrivateDependency a ds) -> (a, formatDependencyList ds))) (map (\(alias, ds) -> PrivateDependency alias (unpack' formatDependencyList ds))) L.targetPrivateBuildDepends
681681
<*> monoidalFieldAla "mixins" formatMixinList L.mixins
682682
^^^ availableSince CabalSpecV2_0 []
683683
{-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-}

‎Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
1+
{-# LANGUAGE BangPatterns #-}
12
{-# LANGUAGE CPP #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE Rank2Types #-}
56
{-# LANGUAGE ScopedTypeVariables #-}
6-
{-# LANGUAGE BangPatterns #-}
77

88
-----------------------------------------------------------------------------
99

@@ -65,13 +65,13 @@ import qualified Data.Set as Set
6565
import qualified Distribution.Compat.Newtype as Newtype
6666
import qualified Distribution.Compat.NonEmptySet as NES
6767
import qualified Distribution.Types.BuildInfo.Lens as L
68+
import qualified Distribution.Types.Dependency.Lens as L
6869
import qualified Distribution.Types.Executable.Lens as L
6970
import qualified Distribution.Types.ForeignLib.Lens as L
7071
import qualified Distribution.Types.GenericPackageDescription.Lens as L
7172
import qualified Distribution.Types.PackageDescription.Lens as L
7273
import qualified Distribution.Types.SetupBuildInfo.Lens as L
7374
import qualified Text.Parsec as P
74-
import qualified Distribution.Types.Dependency.Lens as L
7575

7676
------------------------------------------------------------------------------
7777

‎Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -275,7 +275,7 @@ preProcessInternalDeps specVer gpd
275275
transformD (Dependency pn vr ln)
276276
| pn == thisPn =
277277
if LMainLibName `NES.member` ln
278-
then Dependency thisPn vr mainLibSet: sublibs
278+
then Dependency thisPn vr mainLibSet : sublibs
279279
else sublibs
280280
where
281281
sublibs =

‎Cabal-syntax/src/Distribution/Types/ComponentName.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@ module Distribution.Types.ComponentName
88
, componentNameRaw
99
, componentNameStanza
1010
, componentNameString
11-
12-
, NotLibComponentName(..)
11+
, NotLibComponentName (..)
1312
) where
1413

1514
import Distribution.Compat.Prelude

0 commit comments

Comments
 (0)