1{-# LANGUAGE CPP #-} 2{-# LANGUAGE GADTs #-} 3{-# LANGUAGE RecordWildCards #-} 4{-# OPTIONS_GHC -fno-warn-orphans #-} 5 6-- simplifier goes nuts otherwise 7#if __GLASGOW_HASKELL__ < 806 8{-# OPTIONS_GHC -funfolding-use-threshold=30 #-} 9#endif 10 11module UnitTests.Distribution.Client.ProjectConfig (tests) where 12 13#if !MIN_VERSION_base(4,8,0) 14import Data.Monoid 15import Control.Applicative 16#endif 17import Data.Map (Map) 18import qualified Data.Map as Map 19import Data.List (isPrefixOf, intercalate, (\\)) 20import Network.URI (URI) 21 22import Distribution.Deprecated.ParseUtils 23import qualified Distribution.Deprecated.ReadP as Parse 24 25import Distribution.Package 26import Distribution.PackageDescription 27import Distribution.Compiler 28import Distribution.Version 29import Distribution.Simple.Program.Types 30import Distribution.Simple.Program.Db 31import Distribution.Types.PackageVersionConstraint 32 33import Distribution.Parsec 34import Distribution.Pretty 35 36import Distribution.Client.Types 37import Distribution.Client.CmdInstall.ClientInstallFlags 38import Distribution.Client.Dependency.Types 39import Distribution.Client.Targets 40import Distribution.Client.Types.SourceRepo 41import Distribution.Utils.NubList 42 43import Distribution.Solver.Types.PackageConstraint 44import Distribution.Solver.Types.ConstraintSource 45import Distribution.Solver.Types.Settings 46 47import Distribution.Client.ProjectConfig 48import Distribution.Client.ProjectConfig.Legacy 49 50import UnitTests.Distribution.Client.ArbitraryInstances 51import UnitTests.Distribution.Client.TreeDiffInstances () 52 53import Data.TreeDiff.Class 54import Data.TreeDiff.QuickCheck 55import Test.Tasty 56import Test.Tasty.QuickCheck 57 58tests :: [TestTree] 59tests = 60 [ testGroup "ProjectConfig <-> LegacyProjectConfig round trip" $ 61 [ testProperty "packages" prop_roundtrip_legacytypes_packages 62 , testProperty "buildonly" prop_roundtrip_legacytypes_buildonly 63 , testProperty "specific" prop_roundtrip_legacytypes_specific 64 ] ++ 65 -- a couple tests seem to trigger a RTS fault in ghc-7.6 and older 66 -- unclear why as of yet 67 concat 68 [ [ testProperty "shared" prop_roundtrip_legacytypes_shared 69 , testProperty "local" prop_roundtrip_legacytypes_local 70 , testProperty "all" prop_roundtrip_legacytypes_all 71 ] 72 | not usingGhc76orOlder 73 ] 74 75 , testGroup "individual parser tests" 76 [ testProperty "package location" prop_parsePackageLocationTokenQ 77 , testProperty "RelaxedDep" prop_roundtrip_printparse_RelaxedDep 78 , testProperty "RelaxDeps" prop_roundtrip_printparse_RelaxDeps 79 , testProperty "RelaxDeps'" prop_roundtrip_printparse_RelaxDeps' 80 ] 81 82 , testGroup "ProjectConfig printing/parsing round trip" 83 [ testProperty "packages" prop_roundtrip_printparse_packages 84 , testProperty "buildonly" prop_roundtrip_printparse_buildonly 85 , testProperty "shared" prop_roundtrip_printparse_shared 86 , testProperty "local" prop_roundtrip_printparse_local 87 , testProperty "specific" prop_roundtrip_printparse_specific 88 , testProperty "all" prop_roundtrip_printparse_all 89 ] 90 ] 91 where 92 usingGhc76orOlder = 93 case buildCompilerId of 94 CompilerId GHC v -> v < mkVersion [7,7] 95 _ -> False 96 97 98------------------------------------------------ 99-- Round trip: conversion to/from legacy types 100-- 101 102roundtrip :: (Eq a, ToExpr a) => (a -> b) -> (b -> a) -> a -> Property 103roundtrip f f_inv x = 104 let y = f x 105 in x `ediffEq` f_inv y -- no counterexample with y, as they not have ToExpr 106 107roundtrip_legacytypes :: ProjectConfig -> Property 108roundtrip_legacytypes = 109 roundtrip convertToLegacyProjectConfig 110 convertLegacyProjectConfig 111 112 113prop_roundtrip_legacytypes_all :: ProjectConfig -> Property 114prop_roundtrip_legacytypes_all config = 115 roundtrip_legacytypes 116 config { 117 projectConfigProvenance = mempty 118 } 119 120prop_roundtrip_legacytypes_packages :: ProjectConfig -> Property 121prop_roundtrip_legacytypes_packages config = 122 roundtrip_legacytypes 123 config { 124 projectConfigBuildOnly = mempty, 125 projectConfigShared = mempty, 126 projectConfigProvenance = mempty, 127 projectConfigLocalPackages = mempty, 128 projectConfigSpecificPackage = mempty 129 } 130 131prop_roundtrip_legacytypes_buildonly :: ProjectConfigBuildOnly -> Property 132prop_roundtrip_legacytypes_buildonly config = 133 roundtrip_legacytypes 134 mempty { projectConfigBuildOnly = config } 135 136prop_roundtrip_legacytypes_shared :: ProjectConfigShared -> Property 137prop_roundtrip_legacytypes_shared config = 138 roundtrip_legacytypes 139 mempty { projectConfigShared = config } 140 141prop_roundtrip_legacytypes_local :: PackageConfig -> Property 142prop_roundtrip_legacytypes_local config = 143 roundtrip_legacytypes 144 mempty { projectConfigLocalPackages = config } 145 146prop_roundtrip_legacytypes_specific :: Map PackageName PackageConfig -> Property 147prop_roundtrip_legacytypes_specific config = 148 roundtrip_legacytypes 149 mempty { projectConfigSpecificPackage = MapMappend config } 150 151 152-------------------------------------------- 153-- Round trip: printing and parsing config 154-- 155 156roundtrip_printparse :: ProjectConfig -> Property 157roundtrip_printparse config = 158 case fmap convertLegacyProjectConfig (parseLegacyProjectConfig str) of 159 ParseOk _ x -> counterexample ("shown: " ++ str) $ 160 x `ediffEq` config { projectConfigProvenance = mempty } 161 ParseFailed err -> counterexample (show err) False 162 where 163 str :: String 164 str = showLegacyProjectConfig (convertToLegacyProjectConfig config) 165 166 167prop_roundtrip_printparse_all :: ProjectConfig -> Property 168prop_roundtrip_printparse_all config = 169 roundtrip_printparse config { 170 projectConfigBuildOnly = 171 hackProjectConfigBuildOnly (projectConfigBuildOnly config), 172 173 projectConfigShared = 174 hackProjectConfigShared (projectConfigShared config) 175 } 176 177prop_roundtrip_printparse_packages :: [PackageLocationString] 178 -> [PackageLocationString] 179 -> [SourceRepoList] 180 -> [PackageVersionConstraint] 181 -> Property 182prop_roundtrip_printparse_packages pkglocstrs1 pkglocstrs2 repos named = 183 roundtrip_printparse 184 mempty { 185 projectPackages = map getPackageLocationString pkglocstrs1, 186 projectPackagesOptional = map getPackageLocationString pkglocstrs2, 187 projectPackagesRepo = repos, 188 projectPackagesNamed = named 189 } 190 191prop_roundtrip_printparse_buildonly :: ProjectConfigBuildOnly -> Property 192prop_roundtrip_printparse_buildonly config = 193 roundtrip_printparse 194 mempty { 195 projectConfigBuildOnly = hackProjectConfigBuildOnly config 196 } 197 198hackProjectConfigBuildOnly :: ProjectConfigBuildOnly -> ProjectConfigBuildOnly 199hackProjectConfigBuildOnly config = 200 config { 201 -- These two fields are only command line transitory things, not 202 -- something to be recorded persistently in a config file 203 projectConfigOnlyDeps = mempty, 204 projectConfigDryRun = mempty 205 } 206 207prop_roundtrip_printparse_shared :: ProjectConfigShared -> Property 208prop_roundtrip_printparse_shared config = 209 roundtrip_printparse 210 mempty { 211 projectConfigShared = hackProjectConfigShared config 212 } 213 214hackProjectConfigShared :: ProjectConfigShared -> ProjectConfigShared 215hackProjectConfigShared config = 216 config { 217 projectConfigProjectFile = mempty, -- not present within project files 218 projectConfigConfigFile = mempty, -- ditto 219 projectConfigConstraints = 220 --TODO: [required eventually] parse ambiguity in constraint 221 -- "pkgname -any" as either any version or disabled flag "any". 222 let ambiguous (UserConstraint _ (PackagePropertyFlags flags), _) = 223 (not . null) [ () | (name, False) <- unFlagAssignment flags 224 , "any" `isPrefixOf` unFlagName name ] 225 ambiguous _ = False 226 in filter (not . ambiguous) (projectConfigConstraints config) 227 } 228 229 230prop_roundtrip_printparse_local :: PackageConfig -> Property 231prop_roundtrip_printparse_local config = 232 roundtrip_printparse 233 mempty { 234 projectConfigLocalPackages = config 235 } 236 237prop_roundtrip_printparse_specific :: Map PackageName (NonMEmpty PackageConfig) 238 -> Property 239prop_roundtrip_printparse_specific config = 240 roundtrip_printparse 241 mempty { 242 projectConfigSpecificPackage = MapMappend (fmap getNonMEmpty config) 243 } 244 245 246---------------------------- 247-- Individual Parser tests 248-- 249 250-- | Helper to parse a given string 251-- 252-- Succeeds only if there is a unique complete parse 253runReadP :: Parse.ReadP a a -> String -> Maybe a 254runReadP parser s = case [ x | (x,"") <- Parse.readP_to_S parser s ] of 255 [x'] -> Just x' 256 _ -> Nothing 257 258prop_parsePackageLocationTokenQ :: PackageLocationString -> Bool 259prop_parsePackageLocationTokenQ (PackageLocationString str) = 260 runReadP parsePackageLocationTokenQ (renderPackageLocationToken str) == Just str 261 262prop_roundtrip_printparse_RelaxedDep :: RelaxedDep -> Property 263prop_roundtrip_printparse_RelaxedDep rdep = 264 counterexample (prettyShow rdep) $ 265 eitherParsec (prettyShow rdep) == Right rdep 266 267prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Property 268prop_roundtrip_printparse_RelaxDeps rdep = 269 counterexample (prettyShow rdep) $ 270 Right rdep `ediffEq` eitherParsec (prettyShow rdep) 271 272prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Property 273prop_roundtrip_printparse_RelaxDeps' rdep = 274 counterexample rdep' $ 275 Right rdep `ediffEq` eitherParsec rdep' 276 where 277 rdep' = go (prettyShow rdep) 278 279 -- replace 'all' tokens by '*' 280 go :: String -> String 281 go [] = [] 282 go "all" = "*" 283 go ('a':'l':'l':c:rest) | c `elem` ":," = '*' : go (c:rest) 284 go rest = let (x,y) = break (`elem` ":,") rest 285 (x',y') = span (`elem` ":,^") y 286 in x++x'++go y' 287 288------------------------ 289-- Arbitrary instances 290-- 291 292instance Arbitrary ProjectConfig where 293 arbitrary = 294 ProjectConfig 295 <$> (map getPackageLocationString <$> arbitrary) 296 <*> (map getPackageLocationString <$> arbitrary) 297 <*> shortListOf 3 arbitrary 298 <*> arbitrary 299 <*> arbitrary 300 <*> arbitrary 301 <*> arbitrary 302 <*> arbitrary 303 <*> arbitrary 304 <*> (MapMappend . fmap getNonMEmpty . Map.fromList 305 <$> shortListOf 3 arbitrary) 306 -- package entries with no content are equivalent to 307 -- the entry not existing at all, so exclude empty 308 309 shrink ProjectConfig { projectPackages = x0 310 , projectPackagesOptional = x1 311 , projectPackagesRepo = x2 312 , projectPackagesNamed = x3 313 , projectConfigBuildOnly = x4 314 , projectConfigShared = x5 315 , projectConfigProvenance = x6 316 , projectConfigLocalPackages = x7 317 , projectConfigSpecificPackage = x8 318 , projectConfigAllPackages = x9 } = 319 [ ProjectConfig { projectPackages = x0' 320 , projectPackagesOptional = x1' 321 , projectPackagesRepo = x2' 322 , projectPackagesNamed = x3' 323 , projectConfigBuildOnly = x4' 324 , projectConfigShared = x5' 325 , projectConfigProvenance = x6' 326 , projectConfigLocalPackages = x7' 327 , projectConfigSpecificPackage = (MapMappend 328 (fmap getNonMEmpty x8')) 329 , projectConfigAllPackages = x9' } 330 | ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8', x9')) 331 <- shrink ((x0, x1, x2, x3), 332 (x4, x5, x6, x7, fmap NonMEmpty (getMapMappend x8), x9)) 333 ] 334 335newtype PackageLocationString 336 = PackageLocationString { getPackageLocationString :: String } 337 deriving Show 338 339instance Arbitrary PackageLocationString where 340 arbitrary = 341 PackageLocationString <$> 342 oneof 343 [ show . getNonEmpty <$> (arbitrary :: Gen (NonEmptyList String)) 344 , arbitraryGlobLikeStr 345 , show <$> (arbitrary :: Gen URI) 346 ] 347 348arbitraryGlobLikeStr :: Gen String 349arbitraryGlobLikeStr = outerTerm 350 where 351 outerTerm = concat <$> shortListOf1 4 352 (frequency [ (2, token) 353 , (1, braces <$> innerTerm) ]) 354 innerTerm = intercalate "," <$> shortListOf1 3 355 (frequency [ (3, token) 356 , (1, braces <$> innerTerm) ]) 357 token = shortListOf1 4 (elements (['#'..'~'] \\ "{,}")) 358 braces s = "{" ++ s ++ "}" 359 360 361instance Arbitrary ClientInstallFlags where 362 arbitrary = 363 ClientInstallFlags 364 <$> arbitrary 365 <*> arbitraryFlag arbitraryShortToken 366 <*> arbitrary 367 <*> arbitrary 368 <*> arbitraryFlag arbitraryShortToken 369 370instance Arbitrary ProjectConfigBuildOnly where 371 arbitrary = 372 ProjectConfigBuildOnly 373 <$> arbitrary 374 <*> arbitrary 375 <*> arbitrary 376 <*> (toNubList <$> shortListOf 2 arbitrary) 377 <*> arbitrary 378 <*> arbitrary 379 <*> arbitrary 380 <*> (fmap getShortToken <$> arbitrary) 381 <*> arbitrary 382 <*> arbitraryNumJobs 383 <*> arbitrary 384 <*> arbitrary 385 <*> arbitrary 386 <*> (fmap getShortToken <$> arbitrary) 387 <*> arbitrary 388 <*> (fmap getShortToken <$> arbitrary) 389 <*> (fmap getShortToken <$> arbitrary) 390 <*> arbitrary 391 where 392 arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary 393 394 shrink ProjectConfigBuildOnly { projectConfigVerbosity = x00 395 , projectConfigDryRun = x01 396 , projectConfigOnlyDeps = x02 397 , projectConfigSummaryFile = x03 398 , projectConfigLogFile = x04 399 , projectConfigBuildReports = x05 400 , projectConfigReportPlanningFailure = x06 401 , projectConfigSymlinkBinDir = x07 402 , projectConfigOneShot = x08 403 , projectConfigNumJobs = x09 404 , projectConfigKeepGoing = x10 405 , projectConfigOfflineMode = x11 406 , projectConfigKeepTempFiles = x12 407 , projectConfigHttpTransport = x13 408 , projectConfigIgnoreExpiry = x14 409 , projectConfigCacheDir = x15 410 , projectConfigLogsDir = x16 411 , projectConfigClientInstallFlags = x17 } = 412 [ ProjectConfigBuildOnly { projectConfigVerbosity = x00' 413 , projectConfigDryRun = x01' 414 , projectConfigOnlyDeps = x02' 415 , projectConfigSummaryFile = x03' 416 , projectConfigLogFile = x04' 417 , projectConfigBuildReports = x05' 418 , projectConfigReportPlanningFailure = x06' 419 , projectConfigSymlinkBinDir = x07' 420 , projectConfigOneShot = x08' 421 , projectConfigNumJobs = postShrink_NumJobs x09' 422 , projectConfigKeepGoing = x10' 423 , projectConfigOfflineMode = x11' 424 , projectConfigKeepTempFiles = x12' 425 , projectConfigHttpTransport = x13 426 , projectConfigIgnoreExpiry = x14' 427 , projectConfigCacheDir = x15 428 , projectConfigLogsDir = x16 429 , projectConfigClientInstallFlags = x17' } 430 | ((x00', x01', x02', x03', x04'), 431 (x05', x06', x07', x08', x09'), 432 (x10', x11', x12', x14'), 433 ( x17' )) 434 <- shrink 435 ((x00, x01, x02, x03, x04), 436 (x05, x06, x07, x08, preShrink_NumJobs x09), 437 (x10, x11, x12, x14), 438 ( x17 )) 439 ] 440 where 441 preShrink_NumJobs = fmap (fmap Positive) 442 postShrink_NumJobs = fmap (fmap getPositive) 443 444instance Arbitrary ProjectConfigShared where 445 arbitrary = do 446 projectConfigDistDir <- arbitraryFlag arbitraryShortToken 447 projectConfigConfigFile <- arbitraryFlag arbitraryShortToken 448 projectConfigProjectFile <- arbitraryFlag arbitraryShortToken 449 projectConfigIgnoreProject <- arbitrary 450 projectConfigHcFlavor <- arbitrary 451 projectConfigHcPath <- arbitraryFlag arbitraryShortToken 452 projectConfigHcPkg <- arbitraryFlag arbitraryShortToken 453 projectConfigHaddockIndex <- arbitrary 454 projectConfigRemoteRepos <- arbitrary 455 projectConfigLocalNoIndexRepos <- arbitrary 456 projectConfigActiveRepos <- arbitrary 457 projectConfigIndexState <- arbitrary 458 projectConfigStoreDir <- arbitraryFlag arbitraryShortToken 459 projectConfigConstraints <- arbitraryConstraints 460 projectConfigPreferences <- shortListOf 2 arbitrary 461 projectConfigCabalVersion <- arbitrary 462 projectConfigSolver <- arbitrary 463 projectConfigAllowOlder <- arbitrary 464 projectConfigAllowNewer <- arbitrary 465 projectConfigWriteGhcEnvironmentFilesPolicy <- arbitrary 466 projectConfigMaxBackjumps <- arbitrary 467 projectConfigReorderGoals <- arbitrary 468 projectConfigCountConflicts <- arbitrary 469 projectConfigFineGrainedConflicts <- arbitrary 470 projectConfigMinimizeConflictSet <- arbitrary 471 projectConfigStrongFlags <- arbitrary 472 projectConfigAllowBootLibInstalls <- arbitrary 473 projectConfigOnlyConstrained <- arbitrary 474 projectConfigPerComponent <- arbitrary 475 projectConfigIndependentGoals <- arbitrary 476 projectConfigProgPathExtra <- toNubList <$> listOf arbitraryShortToken 477 return ProjectConfigShared {..} 478 where 479 arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)] 480 arbitraryConstraints = 481 fmap (\uc -> (uc, projectConfigConstraintSource)) <$> arbitrary 482 483 shrink ProjectConfigShared {..} = runShrinker $ pure ProjectConfigShared 484 <*> shrinker projectConfigDistDir 485 <*> shrinker projectConfigConfigFile 486 <*> shrinker projectConfigProjectFile 487 <*> shrinker projectConfigIgnoreProject 488 <*> shrinker projectConfigHcFlavor 489 <*> shrinkerAla (fmap NonEmpty) projectConfigHcPath 490 <*> shrinkerAla (fmap NonEmpty) projectConfigHcPkg 491 <*> shrinker projectConfigHaddockIndex 492 <*> shrinker projectConfigRemoteRepos 493 <*> shrinker projectConfigLocalNoIndexRepos 494 <*> shrinker projectConfigActiveRepos 495 <*> shrinker projectConfigIndexState 496 <*> shrinker projectConfigStoreDir 497 <*> shrinkerPP preShrink_Constraints postShrink_Constraints projectConfigConstraints 498 <*> shrinker projectConfigPreferences 499 <*> shrinker projectConfigCabalVersion 500 <*> shrinker projectConfigSolver 501 <*> shrinker projectConfigAllowOlder 502 <*> shrinker projectConfigAllowNewer 503 <*> shrinker projectConfigWriteGhcEnvironmentFilesPolicy 504 <*> shrinker projectConfigMaxBackjumps 505 <*> shrinker projectConfigReorderGoals 506 <*> shrinker projectConfigCountConflicts 507 <*> shrinker projectConfigFineGrainedConflicts 508 <*> shrinker projectConfigMinimizeConflictSet 509 <*> shrinker projectConfigStrongFlags 510 <*> shrinker projectConfigAllowBootLibInstalls 511 <*> shrinker projectConfigOnlyConstrained 512 <*> shrinker projectConfigPerComponent 513 <*> shrinker projectConfigIndependentGoals 514 <*> shrinker projectConfigProgPathExtra 515 where 516 preShrink_Constraints = map fst 517 postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource)) 518 519projectConfigConstraintSource :: ConstraintSource 520projectConfigConstraintSource = 521 ConstraintSourceProjectConfig "TODO" 522 523instance Arbitrary ProjectConfigProvenance where 524 arbitrary = elements [Implicit, Explicit "cabal.project"] 525 526instance Arbitrary PackageConfig where 527 arbitrary = 528 PackageConfig 529 <$> (MapLast . Map.fromList <$> shortListOf 10 530 ((,) <$> arbitraryProgramName 531 <*> arbitraryShortToken)) 532 <*> (MapMappend . Map.fromList <$> shortListOf 10 533 ((,) <$> arbitraryProgramName 534 <*> listOf arbitraryShortToken)) 535 <*> (toNubList <$> listOf arbitraryShortToken) 536 <*> arbitrary 537 <*> arbitrary <*> arbitrary <*> arbitrary 538 <*> arbitrary <*> arbitrary 539 <*> arbitrary 540 <*> arbitrary <*> arbitrary 541 <*> arbitrary <*> arbitrary 542 <*> shortListOf 5 arbitraryShortToken 543 <*> arbitrary 544 <*> arbitrary <*> arbitrary 545 <*> shortListOf 5 arbitraryShortToken 546 <*> shortListOf 5 arbitraryShortToken 547 <*> shortListOf 5 arbitraryShortToken 548 <*> arbitrary <*> arbitrary 549 <*> arbitrary <*> arbitrary 550 <*> arbitrary <*> arbitrary 551 <*> arbitrary <*> arbitrary 552 <*> arbitrary <*> arbitrary 553 <*> arbitrary <*> arbitrary 554 <*> arbitrary <*> arbitrary 555 <*> arbitraryFlag arbitraryShortToken 556 <*> arbitrary 557 <*> arbitrary 558 <*> arbitrary <*> arbitrary 559 <*> arbitrary 560 <*> arbitraryFlag arbitraryShortToken 561 <*> arbitrary 562 <*> arbitrary 563 <*> arbitraryFlag arbitraryShortToken 564 <*> arbitrary 565 <*> arbitrary 566 <*> arbitrary 567 <*> arbitrary 568 <*> arbitrary 569 <*> arbitrary 570 <*> arbitraryFlag arbitraryShortToken 571 <*> arbitrary 572 <*> shortListOf 5 arbitrary 573 <*> shortListOf 5 arbitrary 574 where 575 arbitraryProgramName :: Gen String 576 arbitraryProgramName = 577 elements [ programName prog 578 | (prog, _) <- knownPrograms (defaultProgramDb) ] 579 580 shrink PackageConfig { packageConfigProgramPaths = x00 581 , packageConfigProgramArgs = x01 582 , packageConfigProgramPathExtra = x02 583 , packageConfigFlagAssignment = x03 584 , packageConfigVanillaLib = x04 585 , packageConfigSharedLib = x05 586 , packageConfigStaticLib = x42 587 , packageConfigDynExe = x06 588 , packageConfigFullyStaticExe = x50 589 , packageConfigProf = x07 590 , packageConfigProfLib = x08 591 , packageConfigProfExe = x09 592 , packageConfigProfDetail = x10 593 , packageConfigProfLibDetail = x11 594 , packageConfigConfigureArgs = x12 595 , packageConfigOptimization = x13 596 , packageConfigProgPrefix = x14 597 , packageConfigProgSuffix = x15 598 , packageConfigExtraLibDirs = x16 599 , packageConfigExtraFrameworkDirs = x17 600 , packageConfigExtraIncludeDirs = x18 601 , packageConfigGHCiLib = x19 602 , packageConfigSplitSections = x20 603 , packageConfigSplitObjs = x20_1 604 , packageConfigStripExes = x21 605 , packageConfigStripLibs = x22 606 , packageConfigTests = x23 607 , packageConfigBenchmarks = x24 608 , packageConfigCoverage = x25 609 , packageConfigRelocatable = x26 610 , packageConfigDebugInfo = x27 611 , packageConfigRunTests = x28 612 , packageConfigDocumentation = x29 613 , packageConfigHaddockHoogle = x30 614 , packageConfigHaddockHtml = x31 615 , packageConfigHaddockHtmlLocation = x32 616 , packageConfigHaddockForeignLibs = x33 617 , packageConfigHaddockExecutables = x33_1 618 , packageConfigHaddockTestSuites = x34 619 , packageConfigHaddockBenchmarks = x35 620 , packageConfigHaddockInternal = x36 621 , packageConfigHaddockCss = x37 622 , packageConfigHaddockLinkedSource = x38 623 , packageConfigHaddockQuickJump = x43 624 , packageConfigHaddockHscolourCss = x39 625 , packageConfigHaddockContents = x40 626 , packageConfigHaddockForHackage = x41 627 , packageConfigTestHumanLog = x44 628 , packageConfigTestMachineLog = x45 629 , packageConfigTestShowDetails = x46 630 , packageConfigTestKeepTix = x47 631 , packageConfigTestWrapper = x48 632 , packageConfigTestFailWhenNoTestSuites = x49 633 , packageConfigTestTestOptions = x51 634 , packageConfigBenchmarkOptions = x52 } = 635 [ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00' 636 , packageConfigProgramArgs = postShrink_Args x01' 637 , packageConfigProgramPathExtra = x02' 638 , packageConfigFlagAssignment = x03' 639 , packageConfigVanillaLib = x04' 640 , packageConfigSharedLib = x05' 641 , packageConfigStaticLib = x42' 642 , packageConfigDynExe = x06' 643 , packageConfigFullyStaticExe = x50' 644 , packageConfigProf = x07' 645 , packageConfigProfLib = x08' 646 , packageConfigProfExe = x09' 647 , packageConfigProfDetail = x10' 648 , packageConfigProfLibDetail = x11' 649 , packageConfigConfigureArgs = map getNonEmpty x12' 650 , packageConfigOptimization = x13' 651 , packageConfigProgPrefix = x14' 652 , packageConfigProgSuffix = x15' 653 , packageConfigExtraLibDirs = map getNonEmpty x16' 654 , packageConfigExtraFrameworkDirs = map getNonEmpty x17' 655 , packageConfigExtraIncludeDirs = map getNonEmpty x18' 656 , packageConfigGHCiLib = x19' 657 , packageConfigSplitSections = x20' 658 , packageConfigSplitObjs = x20_1' 659 , packageConfigStripExes = x21' 660 , packageConfigStripLibs = x22' 661 , packageConfigTests = x23' 662 , packageConfigBenchmarks = x24' 663 , packageConfigCoverage = x25' 664 , packageConfigRelocatable = x26' 665 , packageConfigDebugInfo = x27' 666 , packageConfigRunTests = x28' 667 , packageConfigDocumentation = x29' 668 , packageConfigHaddockHoogle = x30' 669 , packageConfigHaddockHtml = x31' 670 , packageConfigHaddockHtmlLocation = x32' 671 , packageConfigHaddockForeignLibs = x33' 672 , packageConfigHaddockExecutables = x33_1' 673 , packageConfigHaddockTestSuites = x34' 674 , packageConfigHaddockBenchmarks = x35' 675 , packageConfigHaddockInternal = x36' 676 , packageConfigHaddockCss = fmap getNonEmpty x37' 677 , packageConfigHaddockLinkedSource = x38' 678 , packageConfigHaddockQuickJump = x43' 679 , packageConfigHaddockHscolourCss = fmap getNonEmpty x39' 680 , packageConfigHaddockContents = x40' 681 , packageConfigHaddockForHackage = x41' 682 , packageConfigTestHumanLog = x44' 683 , packageConfigTestMachineLog = x45' 684 , packageConfigTestShowDetails = x46' 685 , packageConfigTestKeepTix = x47' 686 , packageConfigTestWrapper = x48' 687 , packageConfigTestFailWhenNoTestSuites = x49' 688 , packageConfigTestTestOptions = x51' 689 , packageConfigBenchmarkOptions = x52' } 690 | (((x00', x01', x02', x03', x04'), 691 (x05', x42', x06', x50', x07', x08', x09'), 692 (x10', x11', x12', x13', x14'), 693 (x15', x16', x17', x18', x19')), 694 ((x20', x20_1', x21', x22', x23', x24'), 695 (x25', x26', x27', x28', x29'), 696 (x30', x31', x32', (x33', x33_1'), x34'), 697 (x35', x36', x37', x38', x43', x39'), 698 (x40', x41'), 699 (x44', x45', x46', x47', x48', x49', x51', x52'))) 700 <- shrink 701 (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04), 702 (x05, x42, x06, x50, x07, x08, x09), 703 (x10, x11, map NonEmpty x12, x13, x14), 704 (x15, map NonEmpty x16, 705 map NonEmpty x17, 706 map NonEmpty x18, 707 x19)), 708 ((x20, x20_1, x21, x22, x23, x24), 709 (x25, x26, x27, x28, x29), 710 (x30, x31, x32, (x33, x33_1), x34), 711 (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39), 712 (x40, x41), 713 (x44, x45, x46, x47, x48, x49, x51, x52))) 714 ] 715 where 716 preShrink_Paths = Map.map NonEmpty 717 . Map.mapKeys NoShrink 718 . getMapLast 719 postShrink_Paths = MapLast 720 . Map.map getNonEmpty 721 . Map.mapKeys getNoShrink 722 preShrink_Args = Map.map (NonEmpty . map NonEmpty) 723 . Map.mapKeys NoShrink 724 . getMapMappend 725 postShrink_Args = MapMappend 726 . Map.map (map getNonEmpty . getNonEmpty) 727 . Map.mapKeys getNoShrink 728 729 730 731instance f ~ [] => Arbitrary (SourceRepositoryPackage f) where 732 arbitrary = SourceRepositoryPackage 733 <$> arbitrary 734 <*> (getShortToken <$> arbitrary) 735 <*> (fmap getShortToken <$> arbitrary) 736 <*> (fmap getShortToken <$> arbitrary) 737 <*> (fmap getShortToken <$> shortListOf 3 arbitrary) 738 739 shrink (SourceRepositoryPackage x1 x2 x3 x4 x5) = 740 [ SourceRepositoryPackage 741 x1' 742 (getShortToken x2') 743 (fmap getShortToken x3') 744 (fmap getShortToken x4') 745 (fmap getShortToken x5') 746 | (x1', x2', x3', x4', x5') <- shrink 747 (x1, ShortToken x2, fmap ShortToken x3, fmap ShortToken x4, fmap ShortToken x5) 748 ] 749 750instance Arbitrary RemoteRepo where 751 arbitrary = 752 RemoteRepo 753 <$> arbitrary 754 <*> arbitrary -- URI 755 <*> arbitrary 756 <*> listOf arbitraryRootKey 757 <*> fmap getNonNegative arbitrary 758 <*> pure False 759 where 760 arbitraryRootKey = 761 shortListOf1 5 (oneof [ choose ('0', '9') 762 , choose ('a', 'f') ]) 763 764instance Arbitrary LocalRepo where 765 arbitrary = LocalRepo 766 <$> arbitrary 767 <*> elements ["/tmp/foo", "/tmp/bar"] -- TODO: generate valid absolute paths 768 <*> arbitrary 769 770instance Arbitrary PreSolver where 771 arbitrary = elements [minBound..maxBound] 772 773instance Arbitrary ReorderGoals where 774 arbitrary = ReorderGoals <$> arbitrary 775 776instance Arbitrary CountConflicts where 777 arbitrary = CountConflicts <$> arbitrary 778 779instance Arbitrary FineGrainedConflicts where 780 arbitrary = FineGrainedConflicts <$> arbitrary 781 782instance Arbitrary MinimizeConflictSet where 783 arbitrary = MinimizeConflictSet <$> arbitrary 784 785instance Arbitrary IndependentGoals where 786 arbitrary = IndependentGoals <$> arbitrary 787 788instance Arbitrary StrongFlags where 789 arbitrary = StrongFlags <$> arbitrary 790 791instance Arbitrary AllowBootLibInstalls where 792 arbitrary = AllowBootLibInstalls <$> arbitrary 793 794instance Arbitrary OnlyConstrained where 795 arbitrary = oneof [ pure OnlyConstrainedAll 796 , pure OnlyConstrainedNone 797 ] 798