File: ProjectConfig.hs

package info (click to toggle)
haskell-cabal-install 3.10.3.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,400 kB
  • sloc: haskell: 52,202; sh: 80; makefile: 9
file content (826 lines) | stat: -rw-r--r-- 35,033 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- simplifier goes nuts otherwise
#if __GLASGOW_HASKELL__ < 806
{-# OPTIONS_GHC -funfolding-use-threshold=30 #-}
#endif

module UnitTests.Distribution.Client.ProjectConfig (tests) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
import Control.Applicative
#endif
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (isPrefixOf, intercalate, (\\))
import Network.URI (URI)

import Distribution.Deprecated.ParseUtils
import qualified Distribution.Deprecated.ReadP as Parse

import Distribution.Package
import Distribution.PackageDescription
import Distribution.Compiler
import Distribution.Version
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Db
import Distribution.Simple.Utils (toUTF8BS)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Types.PackageVersionConstraint

import Distribution.Parsec
import Distribution.Pretty

import Distribution.Client.Types
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.Dependency.Types
import Distribution.Client.Targets
import Distribution.Client.Types.SourceRepo
import Distribution.Utils.NubList

import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.Settings

import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Legacy

import UnitTests.Distribution.Client.ArbitraryInstances
import UnitTests.Distribution.Client.TreeDiffInstances ()

import Data.TreeDiff.Class
import Data.TreeDiff.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck

tests :: [TestTree]
tests =
  [ testGroup "ProjectConfig <-> LegacyProjectConfig round trip" $
    [ testProperty "packages"  prop_roundtrip_legacytypes_packages
    , testProperty "buildonly" prop_roundtrip_legacytypes_buildonly
    , testProperty "specific"  prop_roundtrip_legacytypes_specific
    ] ++
    -- a couple tests seem to trigger a RTS fault in ghc-7.6 and older
    -- unclear why as of yet
    concat
    [ [ testProperty "shared"    prop_roundtrip_legacytypes_shared
      , testProperty "local"     prop_roundtrip_legacytypes_local
      , testProperty "all"       prop_roundtrip_legacytypes_all
      ]
    | not usingGhc76orOlder
    ]

  , testGroup "individual parser tests"
    [ testProperty "package location"  prop_parsePackageLocationTokenQ
    , testProperty "RelaxedDep"        prop_roundtrip_printparse_RelaxedDep
    , testProperty "RelaxDeps"         prop_roundtrip_printparse_RelaxDeps
    , testProperty "RelaxDeps'"        prop_roundtrip_printparse_RelaxDeps'
    ]

  , testGroup "ProjectConfig printing/parsing round trip"
    [ testProperty "packages"  prop_roundtrip_printparse_packages
    , testProperty "buildonly" prop_roundtrip_printparse_buildonly
    , testProperty "shared"    prop_roundtrip_printparse_shared
    , testProperty "local"     prop_roundtrip_printparse_local
    , testProperty "specific"  prop_roundtrip_printparse_specific
    , testProperty "all"       prop_roundtrip_printparse_all
    ]
  ]
  where
    usingGhc76orOlder =
      case buildCompilerId of
        CompilerId GHC v -> v < mkVersion [7,7]
        _                -> False


------------------------------------------------
-- Round trip: conversion to/from legacy types
--

roundtrip :: (Eq a, ToExpr a, Show b) => (a -> b) -> (b -> a) -> a -> Property
roundtrip f f_inv x =
    counterexample (show y) $
    x `ediffEq` f_inv y -- no counterexample with y, as they not have ToExpr
  where
    y = f x

roundtrip_legacytypes :: ProjectConfig -> Property
roundtrip_legacytypes =
    roundtrip convertToLegacyProjectConfig
              convertLegacyProjectConfig


prop_roundtrip_legacytypes_all :: ProjectConfig -> Property
prop_roundtrip_legacytypes_all config =
    roundtrip_legacytypes
      config {
        projectConfigProvenance = mempty
      }

prop_roundtrip_legacytypes_packages :: ProjectConfig -> Property
prop_roundtrip_legacytypes_packages config =
    roundtrip_legacytypes
      config {
        projectConfigBuildOnly       = mempty,
        projectConfigShared          = mempty,
        projectConfigProvenance      = mempty,
        projectConfigLocalPackages   = mempty,
        projectConfigSpecificPackage = mempty
      }

prop_roundtrip_legacytypes_buildonly :: ProjectConfigBuildOnly -> Property
prop_roundtrip_legacytypes_buildonly config =
    roundtrip_legacytypes
      mempty { projectConfigBuildOnly = config }

prop_roundtrip_legacytypes_shared :: ProjectConfigShared -> Property
prop_roundtrip_legacytypes_shared config =
    roundtrip_legacytypes
      mempty { projectConfigShared = config }

prop_roundtrip_legacytypes_local :: PackageConfig -> Property
prop_roundtrip_legacytypes_local config =
    roundtrip_legacytypes
      mempty { projectConfigLocalPackages = config }

prop_roundtrip_legacytypes_specific :: Map PackageName PackageConfig -> Property
prop_roundtrip_legacytypes_specific config =
    roundtrip_legacytypes
      mempty { projectConfigSpecificPackage = MapMappend config }


--------------------------------------------
-- Round trip: printing and parsing config
--

roundtrip_printparse :: ProjectConfig -> Property
roundtrip_printparse config =
    case fmap convertLegacyProjectConfig (parseLegacyProjectConfig "unused" (toUTF8BS str)) of
      ParseOk _ x     -> counterexample ("shown:\n" ++ str) $
          x `ediffEq` config { projectConfigProvenance = mempty }
      ParseFailed err -> counterexample ("shown:\n" ++ str ++ "\nERROR: " ++ show err) False
  where
    str :: String
    str = showLegacyProjectConfig (convertToLegacyProjectConfig config)


prop_roundtrip_printparse_all :: ProjectConfig -> Property
prop_roundtrip_printparse_all config =
    roundtrip_printparse config {
      projectConfigBuildOnly =
        hackProjectConfigBuildOnly (projectConfigBuildOnly config),

      projectConfigShared =
        hackProjectConfigShared (projectConfigShared config)
    }

prop_roundtrip_printparse_packages :: [PackageLocationString]
                                   -> [PackageLocationString]
                                   -> [SourceRepoList]
                                   -> [PackageVersionConstraint]
                                   -> Property
prop_roundtrip_printparse_packages pkglocstrs1 pkglocstrs2 repos named =
    roundtrip_printparse
      mempty {
        projectPackages         = map getPackageLocationString pkglocstrs1,
        projectPackagesOptional = map getPackageLocationString pkglocstrs2,
        projectPackagesRepo     = repos,
        projectPackagesNamed    = named
      }

prop_roundtrip_printparse_buildonly :: ProjectConfigBuildOnly -> Property
prop_roundtrip_printparse_buildonly config =
    roundtrip_printparse
      mempty {
        projectConfigBuildOnly = hackProjectConfigBuildOnly config
      }

hackProjectConfigBuildOnly :: ProjectConfigBuildOnly -> ProjectConfigBuildOnly
hackProjectConfigBuildOnly config =
    config {
      -- These fields are only command line transitory things, not
      -- something to be recorded persistently in a config file
      projectConfigOnlyDeps     = mempty,
      projectConfigOnlyDownload = mempty,
      projectConfigDryRun       = mempty
    }

prop_roundtrip_printparse_shared :: ProjectConfigShared -> Property
prop_roundtrip_printparse_shared config =
    roundtrip_printparse
      mempty {
        projectConfigShared = hackProjectConfigShared config
      }

hackProjectConfigShared :: ProjectConfigShared -> ProjectConfigShared
hackProjectConfigShared config =
    config {
      projectConfigProjectFile = mempty, -- not present within project files
      projectConfigConfigFile  = mempty, -- ditto
      projectConfigConstraints =
      --TODO: [required eventually] parse ambiguity in constraint
      -- "pkgname -any" as either any version or disabled flag "any".
        let ambiguous (UserConstraint _ (PackagePropertyFlags flags), _) =
              (not . null) [ () | (name, False) <- unFlagAssignment flags
                                , "any" `isPrefixOf` unFlagName name ]
            ambiguous _ = False
         in filter (not . ambiguous) (projectConfigConstraints config)
    }


prop_roundtrip_printparse_local :: PackageConfig -> Property
prop_roundtrip_printparse_local config =
    roundtrip_printparse
      mempty {
        projectConfigLocalPackages = config
      }

prop_roundtrip_printparse_specific :: Map PackageName (NonMEmpty PackageConfig)
                                   -> Property
prop_roundtrip_printparse_specific config =
    roundtrip_printparse
      mempty {
        projectConfigSpecificPackage = MapMappend (fmap getNonMEmpty config)
      }


----------------------------
-- Individual Parser tests
--

-- | Helper to parse a given string
--
-- Succeeds only if there is a unique complete parse
runReadP :: Parse.ReadP a a -> String -> Maybe a
runReadP parser s = case [ x | (x,"") <- Parse.readP_to_S parser s ] of
                      [x'] -> Just x'
                      _    -> Nothing

prop_parsePackageLocationTokenQ :: PackageLocationString -> Bool
prop_parsePackageLocationTokenQ (PackageLocationString str) =
    runReadP parsePackageLocationTokenQ (renderPackageLocationToken str) == Just str

prop_roundtrip_printparse_RelaxedDep :: RelaxedDep -> Property
prop_roundtrip_printparse_RelaxedDep rdep =
    counterexample (prettyShow rdep) $
    eitherParsec (prettyShow rdep) == Right rdep

prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Property
prop_roundtrip_printparse_RelaxDeps rdep =
    counterexample (prettyShow rdep) $
    Right rdep `ediffEq` eitherParsec (prettyShow rdep)

prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Property
prop_roundtrip_printparse_RelaxDeps' rdep =
    counterexample rdep' $
    Right rdep `ediffEq` eitherParsec rdep'
  where
    rdep' = go (prettyShow rdep)

    -- replace 'all' tokens by '*'
    go :: String -> String
    go [] = []
    go "all" = "*"
    go ('a':'l':'l':c:rest) | c `elem` ":," = '*' : go (c:rest)
    go rest = let (x,y) = break (`elem` ":,") rest
                  (x',y') = span (`elem` ":,^") y
              in x++x'++go y'

------------------------
-- Arbitrary instances
--

instance Arbitrary ProjectConfig where
    arbitrary =
      ProjectConfig
        <$> (map getPackageLocationString <$> arbitrary)
        <*> (map getPackageLocationString <$> arbitrary)
        <*> shortListOf 3 arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> (MapMappend . fmap getNonMEmpty . Map.fromList
               <$> shortListOf 3 arbitrary)
        -- package entries with no content are equivalent to
        -- the entry not existing at all, so exclude empty

    shrink ProjectConfig { projectPackages = x0
                         , projectPackagesOptional = x1
                         , projectPackagesRepo = x2
                         , projectPackagesNamed = x3
                         , projectConfigBuildOnly = x4
                         , projectConfigShared = x5
                         , projectConfigProvenance = x6
                         , projectConfigLocalPackages = x7
                         , projectConfigSpecificPackage = x8
                         , projectConfigAllPackages = x9 } =
      [ ProjectConfig { projectPackages = x0'
                      , projectPackagesOptional = x1'
                      , projectPackagesRepo = x2'
                      , projectPackagesNamed = x3'
                      , projectConfigBuildOnly = x4'
                      , projectConfigShared = x5'
                      , projectConfigProvenance = x6'
                      , projectConfigLocalPackages = x7'
                      , projectConfigSpecificPackage = (MapMappend
                                                         (fmap getNonMEmpty x8'))
                      , projectConfigAllPackages = x9' }
      | ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8', x9'))
          <- shrink ((x0, x1, x2, x3),
                      (x4, x5, x6, x7, fmap NonMEmpty (getMapMappend x8), x9))
      ]

newtype PackageLocationString
      = PackageLocationString { getPackageLocationString :: String }
  deriving Show

instance Arbitrary PackageLocationString where
  arbitrary =
    PackageLocationString <$>
    oneof
      [ show . getNonEmpty <$> (arbitrary :: Gen (NonEmptyList String))
      , arbitraryGlobLikeStr
      , show <$> (arbitrary :: Gen URI)
      ]
      `suchThat` (\xs -> not ("{" `isPrefixOf` xs))

arbitraryGlobLikeStr :: Gen String
arbitraryGlobLikeStr = outerTerm
  where
    outerTerm  = concat <$> shortListOf1 4
                  (frequency [ (2, token)
                             , (1, braces <$> innerTerm) ])
    innerTerm  = intercalate "," <$> shortListOf1 3
                  (frequency [ (3, token)
                             , (1, braces <$> innerTerm) ])
    token      = shortListOf1 4 (elements (['#'..'~'] \\ "{,}"))
    braces s   = "{" ++ s ++ "}"


instance Arbitrary ClientInstallFlags where
    arbitrary =
      ClientInstallFlags
        <$> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken

instance Arbitrary ProjectConfigBuildOnly where
    arbitrary =
      ProjectConfigBuildOnly
        <$> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> (toNubList <$> shortListOf 2 arbitrary)
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> (fmap getShortToken <$> arbitrary)
        <*> arbitraryNumJobs
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> (fmap getShortToken <$> arbitrary)
        <*> arbitrary
        <*> (fmap getShortToken <$> arbitrary)
        <*> (fmap getShortToken <$> arbitrary)
        <*> arbitrary
      where
        arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary

    shrink ProjectConfigBuildOnly { projectConfigVerbosity = x00
                                  , projectConfigDryRun = x01
                                  , projectConfigOnlyDeps = x02
                                  , projectConfigOnlyDownload = x18
                                  , projectConfigSummaryFile = x03
                                  , projectConfigLogFile = x04
                                  , projectConfigBuildReports = x05
                                  , projectConfigReportPlanningFailure = x06
                                  , projectConfigSymlinkBinDir = x07
                                  , projectConfigNumJobs = x09
                                  , projectConfigKeepGoing = x10
                                  , projectConfigOfflineMode = x11
                                  , projectConfigKeepTempFiles = x12
                                  , projectConfigHttpTransport = x13
                                  , projectConfigIgnoreExpiry = x14
                                  , projectConfigCacheDir = x15
                                  , projectConfigLogsDir = x16
                                  , projectConfigClientInstallFlags = x17 } =
      [ ProjectConfigBuildOnly { projectConfigVerbosity = x00'
                               , projectConfigDryRun = x01'
                               , projectConfigOnlyDeps = x02'
                               , projectConfigOnlyDownload = x18'
                               , projectConfigSummaryFile = x03'
                               , projectConfigLogFile = x04'
                               , projectConfigBuildReports = x05'
                               , projectConfigReportPlanningFailure = x06'
                               , projectConfigSymlinkBinDir = x07'
                               , projectConfigNumJobs = postShrink_NumJobs x09'
                               , projectConfigKeepGoing = x10'
                               , projectConfigOfflineMode = x11'
                               , projectConfigKeepTempFiles = x12'
                               , projectConfigHttpTransport = x13
                               , projectConfigIgnoreExpiry = x14'
                               , projectConfigCacheDir = x15
                               , projectConfigLogsDir = x16
                               , projectConfigClientInstallFlags = x17' }
      | ((x00', x01', x02', x03', x04'),
         (x05', x06', x07',       x09'),
         (x10', x11', x12',       x14'),
         (            x17', x18'      ))
          <- shrink
               ((x00, x01, x02, x03, x04),
                (x05, x06, x07,      preShrink_NumJobs x09),
                (x10, x11, x12,      x14),
                (          x17, x18     ))
      ]
      where
        preShrink_NumJobs  = fmap (fmap Positive)
        postShrink_NumJobs = fmap (fmap getPositive)

instance Arbitrary ProjectConfigShared where
    arbitrary = do
        projectConfigDistDir              <- arbitraryFlag arbitraryShortToken
        projectConfigConfigFile           <- arbitraryFlag arbitraryShortToken
        projectConfigProjectFile          <- arbitraryFlag arbitraryShortToken
        projectConfigIgnoreProject        <- arbitrary
        projectConfigHcFlavor             <- arbitrary
        projectConfigHcPath               <- arbitraryFlag arbitraryShortToken
        projectConfigHcPkg                <- arbitraryFlag arbitraryShortToken
        projectConfigHaddockIndex         <- arbitrary
        projectConfigInstallDirs          <- fixInstallDirs <$> arbitrary
        projectConfigPackageDBs           <- shortListOf 2 arbitrary
        projectConfigRemoteRepos          <- arbitrary
        projectConfigLocalNoIndexRepos    <- arbitrary
        projectConfigActiveRepos          <- arbitrary
        projectConfigIndexState           <- arbitrary
        projectConfigStoreDir             <- arbitraryFlag arbitraryShortToken
        projectConfigConstraints          <- arbitraryConstraints
        projectConfigPreferences          <- shortListOf 2 arbitrary
        projectConfigCabalVersion         <- arbitrary
        projectConfigSolver               <- arbitrary
        projectConfigAllowOlder           <- arbitrary
        projectConfigAllowNewer           <- arbitrary
        projectConfigWriteGhcEnvironmentFilesPolicy <- arbitrary
        projectConfigMaxBackjumps         <- arbitrary
        projectConfigReorderGoals         <- arbitrary
        projectConfigCountConflicts       <- arbitrary
        projectConfigFineGrainedConflicts <- arbitrary
        projectConfigMinimizeConflictSet  <- arbitrary
        projectConfigStrongFlags          <- arbitrary
        projectConfigAllowBootLibInstalls <- arbitrary
        projectConfigOnlyConstrained      <- arbitrary
        projectConfigPerComponent         <- arbitrary
        projectConfigIndependentGoals     <- arbitrary
        projectConfigPreferOldest         <- arbitrary
        projectConfigProgPathExtra        <- toNubList <$> listOf arbitraryShortToken
        return ProjectConfigShared {..}
      where
        arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)]
        arbitraryConstraints =
            fmap (\uc -> (uc, projectConfigConstraintSource)) <$> arbitrary
        fixInstallDirs x = x {InstallDirs.includedir = mempty, InstallDirs.mandir = mempty, InstallDirs.flibdir = mempty}

    shrink ProjectConfigShared {..} = runShrinker $ pure ProjectConfigShared
        <*> shrinker projectConfigDistDir
        <*> shrinker projectConfigConfigFile
        <*> shrinker projectConfigProjectFile
        <*> shrinker projectConfigIgnoreProject
        <*> shrinker projectConfigHcFlavor
        <*> shrinkerAla (fmap NonEmpty) projectConfigHcPath
        <*> shrinkerAla (fmap NonEmpty) projectConfigHcPkg
        <*> shrinker projectConfigHaddockIndex
        <*> shrinker projectConfigInstallDirs
        <*> shrinker projectConfigPackageDBs
        <*> shrinker projectConfigRemoteRepos
        <*> shrinker projectConfigLocalNoIndexRepos
        <*> shrinker projectConfigActiveRepos
        <*> shrinker projectConfigIndexState
        <*> shrinker projectConfigStoreDir
        <*> shrinkerPP preShrink_Constraints postShrink_Constraints projectConfigConstraints
        <*> shrinker projectConfigPreferences
        <*> shrinker projectConfigCabalVersion
        <*> shrinker projectConfigSolver
        <*> shrinker projectConfigAllowOlder
        <*> shrinker projectConfigAllowNewer
        <*> shrinker projectConfigWriteGhcEnvironmentFilesPolicy
        <*> shrinker projectConfigMaxBackjumps
        <*> shrinker projectConfigReorderGoals
        <*> shrinker projectConfigCountConflicts
        <*> shrinker projectConfigFineGrainedConflicts
        <*> shrinker projectConfigMinimizeConflictSet
        <*> shrinker projectConfigStrongFlags
        <*> shrinker projectConfigAllowBootLibInstalls
        <*> shrinker projectConfigOnlyConstrained
        <*> shrinker projectConfigPerComponent
        <*> shrinker projectConfigIndependentGoals
        <*> shrinker projectConfigPreferOldest
        <*> shrinker projectConfigProgPathExtra
      where
        preShrink_Constraints  = map fst
        postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource))

projectConfigConstraintSource :: ConstraintSource
projectConfigConstraintSource =
    ConstraintSourceProjectConfig "unused"

instance Arbitrary ProjectConfigProvenance where
    arbitrary = elements [Implicit, Explicit "cabal.project"]

instance Arbitrary PackageConfig where
    arbitrary =
      PackageConfig
        <$> (MapLast . Map.fromList <$> shortListOf 10
              ((,) <$> arbitraryProgramName
                   <*> arbitraryShortToken))
        <*> (MapMappend . Map.fromList <$> shortListOf 10
              ((,) <$> arbitraryProgramName
                   <*> listOf arbitraryShortToken))
        <*> (toNubList <$> listOf arbitraryShortToken)
        <*> arbitrary
        <*> arbitrary <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> shortListOf 5 arbitraryShortToken
        <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> shortListOf 5 arbitraryShortToken
        <*> shortListOf 5 arbitraryShortToken
        <*> shortListOf 5 arbitraryShortToken
        <*> shortListOf 5 arbitraryShortToken
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary <*> arbitrary
        <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitraryFlag arbitraryShortToken
        <*> arbitrary
        <*> shortListOf 5 arbitrary
        <*> shortListOf 5 arbitrary
      where
        arbitraryProgramName :: Gen String
        arbitraryProgramName =
          elements [ programName prog
                   | (prog, _) <- knownPrograms (defaultProgramDb) ]

    shrink PackageConfig { packageConfigProgramPaths = x00
                         , packageConfigProgramArgs = x01
                         , packageConfigProgramPathExtra = x02
                         , packageConfigFlagAssignment = x03
                         , packageConfigVanillaLib = x04
                         , packageConfigSharedLib = x05
                         , packageConfigStaticLib = x42
                         , packageConfigDynExe = x06
                         , packageConfigFullyStaticExe = x50
                         , packageConfigProf = x07
                         , packageConfigProfLib = x08
                         , packageConfigProfExe = x09
                         , packageConfigProfDetail = x10
                         , packageConfigProfLibDetail = x11
                         , packageConfigConfigureArgs = x12
                         , packageConfigOptimization = x13
                         , packageConfigProgPrefix = x14
                         , packageConfigProgSuffix = x15
                         , packageConfigExtraLibDirs = x16
                         , packageConfigExtraLibDirsStatic = x53
                         , packageConfigExtraFrameworkDirs = x17
                         , packageConfigExtraIncludeDirs = x18
                         , packageConfigGHCiLib = x19
                         , packageConfigSplitSections = x20
                         , packageConfigSplitObjs = x20_1
                         , packageConfigStripExes = x21
                         , packageConfigStripLibs = x22
                         , packageConfigTests = x23
                         , packageConfigBenchmarks = x24
                         , packageConfigCoverage = x25
                         , packageConfigRelocatable = x26
                         , packageConfigDebugInfo = x27
                         , packageConfigDumpBuildInfo = x27_1
                         , packageConfigRunTests = x28
                         , packageConfigDocumentation = x29
                         , packageConfigHaddockHoogle = x30
                         , packageConfigHaddockHtml = x31
                         , packageConfigHaddockHtmlLocation = x32
                         , packageConfigHaddockForeignLibs = x33
                         , packageConfigHaddockExecutables = x33_1
                         , packageConfigHaddockTestSuites = x34
                         , packageConfigHaddockBenchmarks = x35
                         , packageConfigHaddockInternal = x36
                         , packageConfigHaddockCss = x37
                         , packageConfigHaddockLinkedSource = x38
                         , packageConfigHaddockQuickJump = x43
                         , packageConfigHaddockHscolourCss = x39
                         , packageConfigHaddockContents = x40
                         , packageConfigHaddockForHackage = x41
                         , packageConfigHaddockIndex = x54
                         , packageConfigHaddockBaseUrl = x55
                         , packageConfigHaddockLib = x56
                         , packageConfigTestHumanLog = x44
                         , packageConfigTestMachineLog = x45
                         , packageConfigTestShowDetails = x46
                         , packageConfigTestKeepTix = x47
                         , packageConfigTestWrapper = x48
                         , packageConfigTestFailWhenNoTestSuites = x49
                         , packageConfigTestTestOptions = x51
                         , packageConfigBenchmarkOptions = x52 } =
      [ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00'
                      , packageConfigProgramArgs = postShrink_Args x01'
                      , packageConfigProgramPathExtra = x02'
                      , packageConfigFlagAssignment = x03'
                      , packageConfigVanillaLib = x04'
                      , packageConfigSharedLib = x05'
                      , packageConfigStaticLib = x42'
                      , packageConfigDynExe = x06'
                      , packageConfigFullyStaticExe = x50'
                      , packageConfigProf = x07'
                      , packageConfigProfLib = x08'
                      , packageConfigProfExe = x09'
                      , packageConfigProfDetail = x10'
                      , packageConfigProfLibDetail = x11'
                      , packageConfigConfigureArgs = map getNonEmpty x12'
                      , packageConfigOptimization = x13'
                      , packageConfigProgPrefix = x14'
                      , packageConfigProgSuffix = x15'
                      , packageConfigExtraLibDirs = map getNonEmpty x16'
                      , packageConfigExtraLibDirsStatic = map getNonEmpty x53'
                      , packageConfigExtraFrameworkDirs = map getNonEmpty x17'
                      , packageConfigExtraIncludeDirs = map getNonEmpty x18'
                      , packageConfigGHCiLib = x19'
                      , packageConfigSplitSections = x20'
                      , packageConfigSplitObjs = x20_1'
                      , packageConfigStripExes = x21'
                      , packageConfigStripLibs = x22'
                      , packageConfigTests = x23'
                      , packageConfigBenchmarks = x24'
                      , packageConfigCoverage = x25'
                      , packageConfigRelocatable = x26'
                      , packageConfigDebugInfo = x27'
                      , packageConfigDumpBuildInfo = x27_1'
                      , packageConfigRunTests = x28'
                      , packageConfigDocumentation = x29'
                      , packageConfigHaddockHoogle = x30'
                      , packageConfigHaddockHtml = x31'
                      , packageConfigHaddockHtmlLocation = x32'
                      , packageConfigHaddockForeignLibs = x33'
                      , packageConfigHaddockExecutables = x33_1'
                      , packageConfigHaddockTestSuites = x34'
                      , packageConfigHaddockBenchmarks = x35'
                      , packageConfigHaddockInternal = x36'
                      , packageConfigHaddockCss = fmap getNonEmpty x37'
                      , packageConfigHaddockLinkedSource = x38'
                      , packageConfigHaddockQuickJump = x43'
                      , packageConfigHaddockHscolourCss = fmap getNonEmpty x39'
                      , packageConfigHaddockContents = x40'
                      , packageConfigHaddockForHackage = x41'
                      , packageConfigHaddockIndex = x54'
                      , packageConfigHaddockBaseUrl = x55'
                      , packageConfigHaddockLib = x56'
                      , packageConfigTestHumanLog = x44'
                      , packageConfigTestMachineLog = x45'
                      , packageConfigTestShowDetails = x46'
                      , packageConfigTestKeepTix = x47'
                      , packageConfigTestWrapper = x48'
                      , packageConfigTestFailWhenNoTestSuites = x49'
                      , packageConfigTestTestOptions = x51'
                      , packageConfigBenchmarkOptions = x52' }
      |  (((x00', x01', x02', x03', x04'),
          (x05', x42', x06', x50', x07', x08', x09'),
          (x10', x11', x12', x13', x14'),
          (x15', x16', x53', x17', x18', x19')),
         ((x20', x20_1', x21', x22', x23', x24'),
          (x25', x26', x27', x27_1', x28', x29'),
          (x30', x31', x32', (x33', x33_1'), x34'),
          (x35', x36', x37', x38', x43', x39'),
          (x40', x41'),
          (x44', x45', x46', x47', x48', x49', x51', x52', x54', x55'),
          x56'))
          <- shrink
             (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04),
                (x05, x42, x06, x50, x07, x08, x09),
                (x10, x11, map NonEmpty x12, x13, x14),
                (x15, map NonEmpty x16, map NonEmpty x53,
                  map NonEmpty x17,
                  map NonEmpty x18,
                  x19)),
               ((x20, x20_1, x21, x22, x23, x24),
                 (x25, x26, x27, x27_1, x28, x29),
                 (x30, x31, x32, (x33, x33_1), x34),
                 (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39),
                 (x40, x41),
                 (x44, x45, x46, x47, x48, x49, x51, x52, x54, x55), x56))
      ]
      where
        preShrink_Paths  = Map.map NonEmpty
                         . Map.mapKeys NoShrink
                         . getMapLast
        postShrink_Paths = MapLast
                         . Map.map getNonEmpty
                         . Map.mapKeys getNoShrink
        preShrink_Args   = Map.map (NonEmpty . map NonEmpty)
                         . Map.mapKeys NoShrink
                         . getMapMappend
        postShrink_Args  = MapMappend
                         . Map.map (map getNonEmpty . getNonEmpty)
                         . Map.mapKeys getNoShrink



instance f ~ [] => Arbitrary (SourceRepositoryPackage f) where
    arbitrary = SourceRepositoryPackage
        <$> arbitrary
        <*> (getShortToken <$> arbitrary)
        <*> (fmap getShortToken <$> arbitrary)
        <*> (fmap getShortToken <$> arbitrary)
        <*> (fmap getShortToken <$> shortListOf 3 arbitrary)
        <*> (fmap getShortToken <$> shortListOf 3 arbitrary)

    shrink SourceRepositoryPackage {..} = runShrinker $ pure SourceRepositoryPackage
        <*> shrinker srpType
        <*> shrinkerAla ShortToken srpLocation
        <*> shrinkerAla (fmap ShortToken) srpTag
        <*> shrinkerAla (fmap ShortToken) srpBranch
        <*> shrinkerAla (fmap ShortToken) srpSubdir
        <*> shrinkerAla (fmap ShortToken) srpCommand

instance Arbitrary RemoteRepo where
    arbitrary =
      RemoteRepo
        <$> arbitrary
        <*> arbitrary  -- URI
        <*> arbitrary
        <*> listOf arbitraryRootKey
        <*> fmap getNonNegative arbitrary
        <*> pure False
      where
        arbitraryRootKey =
          shortListOf1 5 (oneof [ choose ('0', '9')
                                , choose ('a', 'f') ])

instance Arbitrary LocalRepo where
    arbitrary = LocalRepo
        <$> arbitrary
        <*> elements ["/tmp/foo", "/tmp/bar"] -- TODO: generate valid absolute paths
        <*> arbitrary

instance Arbitrary PreSolver where
    arbitrary = elements [minBound..maxBound]

instance Arbitrary ReorderGoals where
    arbitrary = ReorderGoals <$> arbitrary

instance Arbitrary CountConflicts where
    arbitrary = CountConflicts <$> arbitrary

instance Arbitrary FineGrainedConflicts where
    arbitrary = FineGrainedConflicts <$> arbitrary

instance Arbitrary MinimizeConflictSet where
    arbitrary = MinimizeConflictSet <$> arbitrary

instance Arbitrary IndependentGoals where
    arbitrary = IndependentGoals <$> arbitrary

instance Arbitrary PreferOldest where
    arbitrary = PreferOldest <$> arbitrary

instance Arbitrary StrongFlags where
    arbitrary = StrongFlags <$> arbitrary

instance Arbitrary AllowBootLibInstalls where
    arbitrary = AllowBootLibInstalls <$> arbitrary

instance Arbitrary OnlyConstrained where
    arbitrary = oneof [ pure OnlyConstrainedAll
                      , pure OnlyConstrainedNone
                      ]