-
Notifications
You must be signed in to change notification settings - Fork 681
/
ProjectPlanning.hs
4667 lines (4311 loc) · 189 KB
/
ProjectPlanning.hs
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
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
-- | Planning how to build everything in a project.
module Distribution.Client.ProjectPlanning
( -- * elaborated install plan types
ElaboratedInstallPlan
, ElaboratedConfiguredPackage (..)
, ElaboratedPlanPackage
, ElaboratedSharedConfig (..)
, ElaboratedReadyPackage
, BuildStyle (..)
, CabalFileText
-- * Producing the elaborated install plan
, rebuildProjectConfig
, rebuildInstallPlan
-- * Build targets
, availableTargets
, AvailableTarget (..)
, AvailableTargetStatus (..)
, TargetRequested (..)
, ComponentTarget (..)
, SubComponentTarget (..)
, showComponentTarget
, nubComponentTargets
-- * Selecting a plan subset
, pruneInstallPlanToTargets
, TargetAction (..)
, pruneInstallPlanToDependencies
, CannotPruneDependencies (..)
-- * Utils required for building
, pkgHasEphemeralBuildTargets
, elabBuildTargetWholeComponents
, configureCompiler
-- * Setup.hs CLI flags for building
, setupHsScriptOptions
, setupHsConfigureFlags
, setupHsConfigureArgs
, setupHsBuildFlags
, setupHsBuildArgs
, setupHsReplFlags
, setupHsReplArgs
, setupHsTestFlags
, setupHsTestArgs
, setupHsBenchFlags
, setupHsBenchArgs
, setupHsCopyFlags
, setupHsRegisterFlags
, setupHsHaddockFlags
, setupHsHaddockArgs
, packageHashInputs
-- * Path construction
, binDirectoryFor
, binDirectories
, storePackageInstallDirs
, storePackageInstallDirs'
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.HashValue
import Distribution.Client.HttpUtils
import Distribution.Client.PackageHash
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Legacy
import Distribution.Client.ProjectPlanOutput
import Distribution.Client.ProjectPlanning.Types as Ty
import Distribution.Client.RebuildMonad
import Distribution.Client.Store
import Distribution.Client.Config
import Distribution.Client.Dependency
import Distribution.Client.DistDirLayout
import Distribution.Client.FetchUtils
import qualified Distribution.Client.IndexUtils as IndexUtils
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.JobControl
import Distribution.Client.Setup hiding (cabalVersion, packageName)
import Distribution.Client.SetupWrapper
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.Targets (userToPackageConstraint)
import Distribution.Client.Types
import Distribution.Client.Utils (incVersion)
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum
import Distribution.Utils.NubList
import qualified Hackage.Security.Client as Sec
import qualified Distribution.Client.BuildReports.Storage as BuildReports
( fromPlanningFailure
, storeLocal
)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb
import Distribution.Solver.Types.ResolverPackage
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
import Distribution.CabalSpecVersion
-- TODO: [code cleanup] eliminate
-- TODO: [code cleanup] eliminate
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.ModuleName
import Distribution.Package
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.Simple.Compiler
import qualified Distribution.Simple.Configure as Cabal
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
( Component (..)
, componentBuildInfo
, componentName
, pkgComponents
)
import qualified Distribution.Simple.LocalBuildInfo as Cabal
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Program
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Find
import Distribution.Simple.Setup
( Flag (..)
, flagToList
, flagToMaybe
, fromFlagOrDefault
, toFlag
)
import qualified Distribution.Simple.Setup as Cabal
import Distribution.System
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentName
import Distribution.Types.DumpBuildInfo
( DumpBuildInfo (..)
)
import Distribution.Types.GivenComponent
( GivenComponent (GivenComponent)
)
import Distribution.Types.LibraryName
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.PkgconfigDependency
import Distribution.Types.UnqualComponentName
import Distribution.Backpack
import Distribution.Backpack.ComponentsGraph
import Distribution.Backpack.ConfiguredComponent
import Distribution.Backpack.FullUnitId
import Distribution.Backpack.LinkedComponent
import Distribution.Backpack.ModuleShape
import Distribution.Types.ComponentInclude
import Distribution.Simple.Utils
import Distribution.Version
import Distribution.Compat.Graph (IsNode (..))
import qualified Distribution.Compat.Graph as Graph
import Control.Exception (assert)
import Control.Monad (forM, sequence)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State as State (State, execState, runState, state)
import Data.Foldable (fold)
import Data.List (deleteBy, groupBy)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.Client.Errors
import System.FilePath
import Text.PrettyPrint (colon, comma, fsep, hang, punctuate, quotes, text, vcat, ($$))
import qualified Text.PrettyPrint as Disp
------------------------------------------------------------------------------
-- * Elaborated install plan
------------------------------------------------------------------------------
-- "Elaborated" -- worked out with great care and nicety of detail;
-- executed with great minuteness: elaborate preparations;
-- elaborate care.
--
-- So here's the idea:
--
-- Rather than a miscellaneous collection of 'ConfigFlags', 'InstallFlags' etc
-- all passed in as separate args and which are then further selected,
-- transformed etc during the execution of the build. Instead we construct
-- an elaborated install plan that includes everything we will need, and then
-- during the execution of the plan we do as little transformation of this
-- info as possible.
--
-- So we're trying to split the work into two phases: construction of the
-- elaborated install plan (which as far as possible should be pure) and
-- then simple execution of that plan without any smarts, just doing what the
-- plan says to do.
--
-- So that means we need a representation of this fully elaborated install
-- plan. The representation consists of two parts:
--
-- * A 'ElaboratedInstallPlan'. This is a 'GenericInstallPlan' with a
-- representation of source packages that includes a lot more detail about
-- that package's individual configuration
--
-- * A 'ElaboratedSharedConfig'. Some package configuration is the same for
-- every package in a plan. Rather than duplicate that info every entry in
-- the 'GenericInstallPlan' we keep that separately.
--
-- The division between the shared and per-package config is /not set in stone
-- for all time/. For example if we wanted to generalise the install plan to
-- describe a situation where we want to build some packages with GHC and some
-- with GHCJS then the platform and compiler would no longer be shared between
-- all packages but would have to be per-package (probably with some sanity
-- condition on the graph structure).
--
-- Refer to ProjectPlanning.Types for details of these important types:
-- type ElaboratedInstallPlan = ...
-- type ElaboratedPlanPackage = ...
-- data ElaboratedSharedConfig = ...
-- data ElaboratedConfiguredPackage = ...
-- data BuildStyle =
-- | Check that an 'ElaboratedConfiguredPackage' actually makes
-- sense under some 'ElaboratedSharedConfig'.
sanityCheckElaboratedConfiguredPackage
:: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> a
-> a
sanityCheckElaboratedConfiguredPackage
_sharedConfig
elab@ElaboratedConfiguredPackage{..} =
( case elabPkgOrComp of
ElabPackage pkg -> sanityCheckElaboratedPackage elab pkg
ElabComponent comp -> sanityCheckElaboratedComponent elab comp
)
-- The assertion below fails occasionally for unknown reason
-- so it was muted until we figure it out, otherwise it severely
-- hinders our ability to share and test development builds of cabal-install.
-- Tracking issue: https://github.com/haskell/cabal/issues/6006
--
-- either a package is being built inplace, or the
-- 'installedPackageId' we assigned is consistent with
-- the 'hashedInstalledPackageId' we would compute from
-- the elaborated configured package
-- . assert (isInplaceBuildStyle elabBuildStyle ||
-- elabComponentId == hashedInstalledPackageId
-- (packageHashInputs sharedConfig elab))
-- the stanzas explicitly disabled should not be available
. assert
( optStanzaSetNull $
optStanzaKeysFilteredByValue (maybe False not) elabStanzasRequested `optStanzaSetIntersection` elabStanzasAvailable
)
-- either a package is built inplace, or we are not attempting to
-- build any test suites or benchmarks (we never build these
-- for remote packages!)
. assert
( isInplaceBuildStyle elabBuildStyle
|| optStanzaSetNull elabStanzasAvailable
)
sanityCheckElaboratedComponent
:: ElaboratedConfiguredPackage
-> ElaboratedComponent
-> a
-> a
sanityCheckElaboratedComponent
ElaboratedConfiguredPackage{..}
ElaboratedComponent{..} =
-- Should not be building bench or test if not inplace.
assert
( isInplaceBuildStyle elabBuildStyle
|| case compComponentName of
Nothing -> True
Just (CLibName _) -> True
Just (CExeName _) -> True
-- This is interesting: there's no way to declare a dependency
-- on a foreign library at the moment, but you may still want
-- to install these to the store
Just (CFLibName _) -> True
Just (CBenchName _) -> False
Just (CTestName _) -> False
)
sanityCheckElaboratedPackage
:: ElaboratedConfiguredPackage
-> ElaboratedPackage
-> a
-> a
sanityCheckElaboratedPackage
ElaboratedConfiguredPackage{..}
ElaboratedPackage{..} =
-- we should only have enabled stanzas that actually can be built
-- (according to the solver)
assert (pkgStanzasEnabled `optStanzaSetIsSubset` elabStanzasAvailable)
-- the stanzas that the user explicitly requested should be
-- enabled (by the previous test, they are also available)
. assert
( optStanzaKeysFilteredByValue (fromMaybe False) elabStanzasRequested
`optStanzaSetIsSubset` pkgStanzasEnabled
)
-- Note [reading project configuration]
--
-- The project configuration is assembled into a ProjectConfig as follows:
--
-- CLI arguments are converted using commandLineFlagsToProjectConfig in the
-- v2 command entrypoints and passed to establishProjectBaseContext which
-- then calls rebuildProjectConfig.
--
-- rebuildProjectConfig then calls readProjectConfig to read the project
-- files. Because of conditionals, this output is in the form of a
-- ProjectConfigSkeleton and will be resolved by rebuildProjectConfig using
-- instantiateProjectConfigSkeletonFetchingCompiler.
--
-- readProjectConfig also loads the global configuration, which is read with
-- loadConfig and convertd to a ProjectConfig with convertLegacyGlobalConfig.
--
-- * Important *
--
-- You can notice how some project config options are needed to read the
-- project config! This is evident by the fact that rebuildProjectConfig
-- takes HttpTransport and DistDirLayout as parameters. Two arguments are
-- infact determined from the CLI alone (in establishProjectBaseContext).
-- Consequently, project files (including global configuration) cannot
-- affect those parameters.
--
-- Furthermore, the project configuration can specify a compiler to use,
-- which we need to resolve the conditionals in the project configuration!
-- To solve this, we configure the compiler from what is obtained by applying
-- the CLI configuration over the the configuration obtained by "flattening"
-- ProjectConfigSkeleton. This means collapsing all conditionals by taking
-- both branches.
-- | Return the up-to-date project config and information about the local
-- packages within the project.
rebuildProjectConfig
:: Verbosity
-> HttpTransport
-> DistDirLayout
-> ProjectConfig
-> IO
( ProjectConfig
, [PackageSpecifier UnresolvedSourcePackage]
)
rebuildProjectConfig
verbosity
httpTransport
distDirLayout@DistDirLayout
{ distProjectRootDirectory
, distDirectory
, distProjectCacheFile
, distProjectCacheDirectory
, distProjectFile
}
cliConfig = do
progsearchpath <- liftIO $ getSystemSearchPath
let fileMonitorProjectConfig = newFileMonitor (distProjectCacheFile "config")
fileMonitorProjectConfigKey <- do
configPath <- getConfigFilePath projectConfigConfigFile
return
( configPath
, distProjectFile ""
, (projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg)
, progsearchpath
, packageConfigProgramPaths
, packageConfigProgramPathExtra
)
(projectConfig, localPackages) <-
runRebuild distProjectRootDirectory
$ rerunIfChanged
verbosity
fileMonitorProjectConfig
fileMonitorProjectConfigKey -- todo check deps too?
$ do
liftIO $ info verbosity "Project settings changed, reconfiguring..."
projectConfigSkeleton <- phaseReadProjectConfig
let fetchCompiler = do
-- have to create the cache directory before configuring the compiler
liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
(compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
pure (os, arch, compilerInfo compiler)
projectConfig <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
when (projectConfigDistDir (projectConfigShared $ projectConfig) /= NoFlag) $
liftIO $
warn verbosity "The builddir option is not supported in project and config files. It will be ignored."
localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)
return (projectConfig, localPackages)
info verbosity $
unlines $
("this build was affected by the following (project) config files:" :) $
[ "- " ++ path
| Explicit path <- Set.toList $ projectConfigProvenance projectConfig
]
return (projectConfig <> cliConfig, localPackages)
where
ProjectConfigShared{projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg, projectConfigIgnoreProject, projectConfigConfigFile} =
projectConfigShared cliConfig
PackageConfig{packageConfigProgramPaths, packageConfigProgramPathExtra} =
projectConfigLocalPackages cliConfig
-- Read the cabal.project (or implicit config) and combine it with
-- arguments from the command line
--
phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton
phaseReadProjectConfig = do
readProjectConfig verbosity httpTransport projectConfigIgnoreProject projectConfigConfigFile distDirLayout
-- Look for all the cabal packages in the project
-- some of which may be local src dirs, tarballs etc
--
phaseReadLocalPackages
:: ProjectConfig
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages
projectConfig@ProjectConfig
{ projectConfigShared
, projectConfigBuildOnly
} = do
pkgLocations <- findProjectPackages distDirLayout projectConfig
-- Create folder only if findProjectPackages did not throw a
-- BadPackageLocations exception.
liftIO $ do
createDirectoryIfMissingVerbose verbosity True distDirectory
createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
fetchAndReadSourcePackages
verbosity
distDirLayout
projectConfigShared
projectConfigBuildOnly
pkgLocations
configureCompiler
:: Verbosity
-> DistDirLayout
-> ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
configureCompiler
verbosity
DistDirLayout
{ distProjectCacheFile
}
ProjectConfig
{ projectConfigShared =
ProjectConfigShared
{ projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
}
, projectConfigLocalPackages =
PackageConfig
{ packageConfigProgramPaths
, packageConfigProgramPathExtra
}
} = do
let fileMonitorCompiler = newFileMonitor . distProjectCacheFile $ "compiler"
progsearchpath <- liftIO $ getSystemSearchPath
rerunIfChanged
verbosity
fileMonitorCompiler
( hcFlavor
, hcPath
, hcPkg
, progsearchpath
, packageConfigProgramPaths
, packageConfigProgramPathExtra
)
$ do
liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
result@(_, _, progdb') <-
liftIO $
Cabal.configCompilerEx
hcFlavor
hcPath
hcPkg
progdb
verbosity
-- Note that we added the user-supplied program locations and args
-- for /all/ programs, not just those for the compiler prog and
-- compiler-related utils. In principle we don't know which programs
-- the compiler will configure (and it does vary between compilers).
-- We do know however that the compiler will only configure the
-- programs it cares about, and those are the ones we monitor here.
monitorFiles (programsMonitorFiles progdb')
return result
where
hcFlavor = flagToMaybe projectConfigHcFlavor
hcPath = flagToMaybe projectConfigHcPath
hcPkg = flagToMaybe projectConfigHcPkg
progdb =
userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))
. modifyProgramSearchPath
( [ ProgramSearchPathDir dir
| dir <- fromNubList packageConfigProgramPathExtra
]
++
)
$ defaultProgramDb
------------------------------------------------------------------------------
-- * Deciding what to do: making an 'ElaboratedInstallPlan'
------------------------------------------------------------------------------
-- | Return an up-to-date elaborated install plan.
--
-- Two variants of the install plan are returned: with and without packages
-- from the store. That is, the \"improved\" plan where source packages are
-- replaced by pre-existing installed packages from the store (when their ids
-- match), and also the original elaborated plan which uses primarily source
-- packages.
-- The improved plan is what we use for building, but the original elaborated
-- plan is useful for reporting and configuration. For example the @freeze@
-- command needs the source package info to know about flag choices and
-- dependencies of executables and setup scripts.
--
rebuildInstallPlan
:: Verbosity
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> Maybe InstalledPackageIndex
-> IO
( ElaboratedInstallPlan -- with store packages
, ElaboratedInstallPlan -- with source packages
, ElaboratedSharedConfig
, IndexUtils.TotalIndexState
, IndexUtils.ActiveRepos
)
-- ^ @(improvedPlan, elaboratedPlan, _, _, _)@
rebuildInstallPlan
verbosity
distDirLayout@DistDirLayout
{ distProjectRootDirectory
, distProjectCacheFile
}
CabalDirLayout
{ cabalStoreDirLayout
} = \projectConfig localPackages mbInstalledPackages ->
runRebuild distProjectRootDirectory $ do
progsearchpath <- liftIO $ getSystemSearchPath
let projectConfigMonitored = projectConfig{projectConfigBuildOnly = mempty}
-- The overall improved plan is cached
rerunIfChanged
verbosity
fileMonitorImprovedPlan
-- react to changes in the project config,
-- the package .cabal files and the path
(projectConfigMonitored, localPackages, progsearchpath)
$ do
-- And so is the elaborated plan that the improved plan based on
(elaboratedPlan, elaboratedShared, totalIndexState, activeRepos) <-
rerunIfChanged
verbosity
fileMonitorElaboratedPlan
( projectConfigMonitored
, localPackages
, progsearchpath
)
$ do
compilerEtc <- phaseConfigureCompiler projectConfig
_ <- phaseConfigurePrograms projectConfig compilerEtc
(solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
phaseRunSolver
projectConfig
compilerEtc
localPackages
(fromMaybe mempty mbInstalledPackages)
( elaboratedPlan
, elaboratedShared
) <-
phaseElaboratePlan
projectConfig
compilerEtc
pkgConfigDB
solverPlan
localPackages
phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
return (elaboratedPlan, elaboratedShared, totalIndexState, activeRepos)
-- The improved plan changes each time we install something, whereas
-- the underlying elaborated plan only changes when input config
-- changes, so it's worth caching them separately.
improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
return (improvedPlan, elaboratedPlan, elaboratedShared, totalIndexState, activeRepos)
where
fileMonitorSolverPlan = newFileMonitorInCacheDir "solver-plan"
fileMonitorSourceHashes = newFileMonitorInCacheDir "source-hashes"
fileMonitorElaboratedPlan = newFileMonitorInCacheDir "elaborated-plan"
fileMonitorImprovedPlan = newFileMonitorInCacheDir "improved-plan"
newFileMonitorInCacheDir :: Eq a => FilePath -> FileMonitor a b
newFileMonitorInCacheDir = newFileMonitor . distProjectCacheFile
-- Configure the compiler we're using.
--
-- This is moderately expensive and doesn't change that often so we cache
-- it independently.
--
phaseConfigureCompiler
:: ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
phaseConfigureCompiler = configureCompiler verbosity distDirLayout
-- Configuring other programs.
--
-- Having configred the compiler, now we configure all the remaining
-- programs. This is to check we can find them, and to monitor them for
-- changes.
--
-- TODO: [required eventually] we don't actually do this yet.
--
-- We rely on the fact that the previous phase added the program config for
-- all local packages, but that all the programs configured so far are the
-- compiler program or related util programs.
--
phaseConfigurePrograms
:: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> Rebuild ()
phaseConfigurePrograms projectConfig (_, _, compilerprogdb) = do
-- Users are allowed to specify program locations independently for
-- each package (e.g. to use a particular version of a pre-processor
-- for some packages). However they cannot do this for the compiler
-- itself as that's just not going to work. So we check for this.
liftIO $
checkBadPerPackageCompilerPaths
(configuredPrograms compilerprogdb)
(getMapMappend (projectConfigSpecificPackage projectConfig))
-- TODO: [required eventually] find/configure other programs that the
-- user specifies.
-- TODO: [required eventually] find/configure all build-tools
-- but note that some of them may be built as part of the plan.
-- Run the solver to get the initial install plan.
-- This is expensive so we cache it independently.
--
phaseRunSolver
:: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> InstalledPackageIndex
-> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
phaseRunSolver
projectConfig@ProjectConfig
{ projectConfigShared
, projectConfigBuildOnly
}
(compiler, platform, progdb)
localPackages
installedPackages =
rerunIfChanged
verbosity
fileMonitorSolverPlan
( solverSettings
, localPackages
, localPackagesEnabledStanzas
, compiler
, platform
, programDbSignature progdb
)
$ do
installedPkgIndex <-
getInstalledPackages
verbosity
compiler
progdb
platform
corePackageDbs
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
withRepoCtx
(solverSettingIndexState solverSettings)
(solverSettingActiveRepos solverSettings)
pkgConfigDB <- getPkgConfigDb verbosity progdb
-- TODO: [code cleanup] it'd be better if the Compiler contained the
-- ConfiguredPrograms that it needs, rather than relying on the progdb
-- since we don't need to depend on all the programs here, just the
-- ones relevant for the compiler.
liftIO $ do
notice verbosity "Resolving dependencies..."
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
verbosity
compiler
platform
solverSettings
(installedPackages <> installedPkgIndex)
sourcePkgDb
pkgConfigDB
localPackages
localPackagesEnabledStanzas
case planOrError of
Left msg -> do
reportPlanningFailure projectConfig compiler platform localPackages
dieWithException verbosity $ PhaseRunSolverErr msg
Right plan -> return (plan, pkgConfigDB, tis, ar)
where
corePackageDbs :: [PackageDB]
corePackageDbs =
applyPackageDbFlags
[GlobalPackageDB]
(projectConfigPackageDBs projectConfigShared)
withRepoCtx =
projectConfigWithSolverRepoContext
verbosity
projectConfigShared
projectConfigBuildOnly
solverSettings = resolveSolverSettings projectConfig
logMsg message rest = debugNoWrap verbosity message >> rest
localPackagesEnabledStanzas =
Map.fromList
[ (pkgname, stanzas)
| pkg <- localPackages
, -- TODO: misnomer: we should separate
-- builtin/global/inplace/local packages
-- and packages explicitly mentioned in the project
--
let pkgname = pkgSpecifierTarget pkg
testsEnabled =
lookupLocalPackageConfig
packageConfigTests
projectConfig
pkgname
benchmarksEnabled =
lookupLocalPackageConfig
packageConfigBenchmarks
projectConfig
pkgname
isLocal = isJust (shouldBeLocal pkg)
stanzas
| isLocal =
Map.fromList $
[ (TestStanzas, enabled)
| enabled <- flagToList testsEnabled
]
++ [ (BenchStanzas, enabled)
| enabled <- flagToList benchmarksEnabled
]
| otherwise = Map.fromList [(TestStanzas, False), (BenchStanzas, False)]
]
-- Elaborate the solver's install plan to get a fully detailed plan. This
-- version of the plan has the final nix-style hashed ids.
--
phaseElaboratePlan
:: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
-> Rebuild
( ElaboratedInstallPlan
, ElaboratedSharedConfig
)
phaseElaboratePlan
ProjectConfig
{ projectConfigShared
, projectConfigAllPackages
, projectConfigLocalPackages
, projectConfigSpecificPackage
, projectConfigBuildOnly
}
(compiler, platform, progdb)
pkgConfigDB
solverPlan
localPackages = do
liftIO $ debug verbosity "Elaborating the install plan..."
sourcePackageHashes <-
rerunIfChanged
verbosity
fileMonitorSourceHashes
(packageLocationsSignature solverPlan)
$ getPackageSourceHashes verbosity withRepoCtx solverPlan
defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler
let installDirs = fmap Cabal.fromFlag $ (fmap Flag defaultInstallDirs) <> (projectConfigInstallDirs projectConfigShared)
(elaboratedPlan, elaboratedShared) <-
liftIO . runLogProgress verbosity $
elaborateInstallPlan
verbosity
platform
compiler
progdb
pkgConfigDB
distDirLayout
cabalStoreDirLayout
solverPlan
localPackages
sourcePackageHashes
installDirs
projectConfigShared
projectConfigAllPackages
projectConfigLocalPackages
(getMapMappend projectConfigSpecificPackage)
let instantiatedPlan =
instantiateInstallPlan
cabalStoreDirLayout
installDirs
elaboratedShared
elaboratedPlan
liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan instantiatedPlan)
return (instantiatedPlan, elaboratedShared)
where
withRepoCtx =
projectConfigWithSolverRepoContext
verbosity
projectConfigShared
projectConfigBuildOnly
-- Update the files we maintain that reflect our current build environment.
-- In particular we maintain a JSON representation of the elaborated
-- install plan (but not the improved plan since that reflects the state
-- of the build rather than just the input environment).
--
phaseMaintainPlanOutputs
:: ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> Rebuild ()
phaseMaintainPlanOutputs elaboratedPlan elaboratedShared = liftIO $ do
debug verbosity "Updating plan.json"
writePlanExternalRepresentation
distDirLayout
elaboratedPlan
elaboratedShared
-- Improve the elaborated install plan. The elaborated plan consists
-- mostly of source packages (with full nix-style hashed ids). Where
-- corresponding installed packages already exist in the store, replace
-- them in the plan.
--
-- Note that we do monitor the store's package db here, so we will redo
-- this improvement phase when the db changes -- including as a result of
-- executing a plan and installing things.
--
phaseImprovePlan
:: ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> Rebuild ElaboratedInstallPlan
phaseImprovePlan elaboratedPlan elaboratedShared = do
liftIO $ debug verbosity "Improving the install plan..."
storePkgIdSet <- getStoreEntries cabalStoreDirLayout compid
let improvedPlan =
improveInstallPlanWithInstalledPackages
storePkgIdSet
elaboratedPlan
liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan improvedPlan)
-- TODO: [nice to have] having checked which packages from the store
-- we're using, it may be sensible to sanity check those packages
-- by loading up the compiler package db and checking everything
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
where
compid = compilerId (pkgConfigCompiler elaboratedShared)
-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
reportPlanningFailure :: ProjectConfig -> Compiler -> Platform -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()
reportPlanningFailure projectConfig comp platform pkgSpecifiers =
when reportFailure $
BuildReports.storeLocal
(compilerInfo comp)
(fromNubList $ projectConfigSummaryFile . projectConfigBuildOnly $ projectConfig)
buildReports
platform
where
-- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?
reportFailure = Cabal.fromFlag . projectConfigReportPlanningFailure . projectConfigBuildOnly $ projectConfig
pkgids = mapMaybe theSpecifiedPackage pkgSpecifiers
buildReports =
BuildReports.fromPlanningFailure
platform
(compilerId comp)
pkgids
-- TODO we may want to get more flag assignments and merge them here?
(packageConfigFlagAssignment . projectConfigAllPackages $ projectConfig)
theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
PackageIdentifier name <$> trivialRange version
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
-- \| If a range includes only a single version, return Just that version.
trivialRange :: VersionRange -> Maybe Version
trivialRange =
foldVersionRange
Nothing
Just -- "== v"
(\_ -> Nothing)
(\_ -> Nothing)
(\_ _ -> Nothing)
(\_ _ -> Nothing)
programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
programsMonitorFiles progdb =
[ monitor
| prog <- configuredPrograms progdb
, monitor <-
monitorFileSearchPath
(programMonitorFiles prog)
(programPath prog)
]
-- | Select the bits of a 'ProgramDb' to monitor for value changes.
-- Use 'programsMonitorFiles' for the files to monitor.
programDbSignature :: ProgramDb -> [ConfiguredProgram]
programDbSignature progdb =
[ prog
{ programMonitorFiles = []
, programOverrideEnv =
filter
((/= "PATH") . fst)
(programOverrideEnv prog)
}
| prog <- configuredPrograms progdb
]
getInstalledPackages
:: Verbosity
-> Compiler
-> ProgramDb
-> Platform
-> PackageDBStack
-> Rebuild InstalledPackageIndex
getInstalledPackages verbosity compiler progdb platform packagedbs = do
monitorFiles . map monitorFileOrDirectory
=<< liftIO
( IndexUtils.getInstalledPackagesMonitorFiles
verbosity
compiler
packagedbs
progdb
platform
)
liftIO $
IndexUtils.getInstalledPackages
verbosity
compiler