Skip to content

Commit 0bbb16f

Browse files
andreabediniandreabedini
committed
feat: all of it, cabal-install part
1 parent 0f92a86 commit 0bbb16f

File tree

20 files changed

+937
-693
lines changed

20 files changed

+937
-693
lines changed

‎cabal-install/cabal-install.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -206,6 +206,7 @@ library
206206
Distribution.Client.TargetProblem
207207
Distribution.Client.TargetSelector
208208
Distribution.Client.Targets
209+
Distribution.Client.Toolchain
209210
Distribution.Client.Types
210211
Distribution.Client.Types.AllowNewer
211212
Distribution.Client.Types.BuildResults

‎cabal-install/src/Distribution/Client/CmdExec.hs‎

Lines changed: 93 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
11
-------------------------------------------------------------------------------
22
-------------------------------------------------------------------------------
33
{-# LANGUAGE RecordWildCards #-}
4+
{-# OPTIONS_GHC -Wno-unused-imports #-}
5+
{-# OPTIONS_GHC -Wno-unused-matches #-}
6+
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
47

58
-- |
69
-- Module : Distribution.Client.Exec
@@ -45,8 +48,8 @@ import Distribution.Client.ProjectOrchestration
4548
)
4649
import Distribution.Client.ProjectPlanOutput
4750
( PostBuildProjectStatus
48-
, argsEquivalentOfGhcEnvironmentFile
49-
, createPackageEnvironment
51+
-- , argsEquivalentOfGhcEnvironmentFile
52+
-- , createPackageEnvironment
5053
, updatePostBuildProjectStatus
5154
)
5255
import Distribution.Client.ProjectPlanning
@@ -55,7 +58,8 @@ import Distribution.Client.ProjectPlanning
5558
)
5659
import qualified Distribution.Client.ProjectPlanning as Planning
5760
import Distribution.Client.ProjectPlanning.Types
58-
( dataDirsEnvironmentForPlan
61+
( Toolchain (..)
62+
, dataDirsEnvironmentForPlan
5963
)
6064
import Distribution.Client.Setup
6165
( ConfigFlags (configCommonFlags)
@@ -108,6 +112,7 @@ import Prelude ()
108112
import qualified Data.Map as M
109113
import qualified Data.Set as S
110114
import Distribution.Client.Errors
115+
import Distribution.Solver.Types.Stage
111116

112117
execCommand :: CommandUI (NixStyleFlags ())
113118
execCommand =
@@ -170,7 +175,9 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
170175

171176
-- Some dependencies may have executables. Let's put those on the PATH.
172177
let extraPaths = pathAdditions baseCtx buildCtx
173-
pkgProgs = pkgConfigCompilerProgs (elaboratedShared buildCtx)
178+
-- NOTE: only build-stage dependencies make sense here
179+
pkgProgs = toolchainProgramDb $ getStage (pkgConfigToolchains (elaboratedShared buildCtx)) Build
180+
--
174181
extraEnvVars =
175182
dataDirsEnvironmentForPlan
176183
(distDirLayout baseCtx)
@@ -179,53 +186,57 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
179186
programDb <-
180187
prependProgramSearchPath verbosity extraPaths extraEnvVars pkgProgs
181188

182-
-- Now that we have the packages, set up the environment. We accomplish this
183-
-- by creating an environment file that selects the databases and packages we
184-
-- computed in the previous step, and setting an environment variable to
185-
-- point at the file.
186-
-- In case ghc is too old to support environment files,
187-
-- we pass the same info as arguments
188-
let compiler = pkgConfigCompiler $ elaboratedShared buildCtx
189-
envFilesSupported = supportsPkgEnvFiles (getImplInfo compiler)
190-
case extraArgs of
191-
[] -> dieWithException verbosity SpecifyAnExecutable
192-
exe : args -> do
193-
(program, _) <- requireProgram verbosity (simpleProgram exe) programDb
194-
let argOverrides =
195-
argsEquivalentOfGhcEnvironmentFile
196-
compiler
197-
(distDirLayout baseCtx)
198-
(elaboratedPlanOriginal buildCtx)
199-
buildStatus
200-
programIsConfiguredCompiler =
201-
matchCompilerPath
202-
(elaboratedShared buildCtx)
203-
program
204-
argOverrides' =
205-
if envFilesSupported
206-
|| not programIsConfiguredCompiler
207-
then []
208-
else argOverrides
189+
-- TODO
190+
error "Not implemented"
191+
where
192+
-- -- Now that we have the packages, set up the environment. We accomplish this
193+
-- -- by creating an environment file that selects the databases and packages we
194+
-- -- computed in the previous step, and setting an environment variable to
195+
-- -- point at the file.
196+
-- -- In case ghc is too old to support environment files,
197+
-- -- we pass the same info as arguments
198+
-- -- let compiler = toolchainCompiler $ buildToolchain $ pkgConfigToolchains $ elaboratedShared buildCtx
199+
-- -- envFilesSupported = supportsPkgEnvFiles (getImplInfo compiler)
200+
-- case extraArgs of
201+
-- [] -> dieWithException verbosity SpecifyAnExecutable
202+
-- exe : args -> do
203+
-- (program, _) <- requireProgram verbosity (simpleProgram exe) programDb
204+
-- let
205+
-- -- argOverrides =
206+
-- -- argsEquivalentOfGhcEnvironmentFile
207+
-- -- compiler
208+
-- -- (distDirLayout baseCtx)
209+
-- -- (elaboratedPlanOriginal buildCtx)
210+
-- -- buildStatus
211+
-- programIsConfiguredCompiler =
212+
-- matchCompilerPath
213+
-- (elaboratedShared buildCtx)
214+
-- program
215+
-- -- argOverrides' =
216+
-- -- if envFilesSupported
217+
-- -- || not programIsConfiguredCompiler
218+
-- -- then []
219+
-- -- else argOverrides
209220

210-
( if envFilesSupported
211-
then withTempEnvFile verbosity baseCtx buildCtx buildStatus
212-
else \f -> f []
213-
)
214-
$ \envOverrides -> do
215-
let program' =
216-
withOverrides
217-
envOverrides
218-
argOverrides'
219-
program
220-
invocation = programInvocation program' args
221-
dryRun =
222-
buildSettingDryRun (buildSettings baseCtx)
223-
|| buildSettingOnlyDownload (buildSettings baseCtx)
221+
-- -- ( if envFilesSupported
222+
-- -- then withTempEnvFile verbosity baseCtx buildCtx buildStatus
223+
-- -- else \f -> f []
224+
-- -- )
225+
-- -- $ \envOverrides -> do
226+
-- -- let program' =
227+
-- -- withOverrides
228+
-- -- envOverrides
229+
-- -- argOverrides'
230+
-- -- program
231+
-- -- invocation = programInvocation program' args
232+
-- -- dryRun =
233+
-- -- buildSettingDryRun (buildSettings baseCtx)
234+
-- -- || buildSettingOnlyDownload (buildSettings baseCtx)
235+
236+
-- -- if dryRun
237+
-- -- then notice verbosity "Running of executable suppressed by flag(s)"
238+
-- -- else runProgramInvocation verbosity invocation
224239

225-
if dryRun
226-
then notice verbosity "Running of executable suppressed by flag(s)"
227-
else runProgramInvocation verbosity invocation
228-
where
229240
verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
230241
cliConfig =
231242
commandLineFlagsToProjectConfig
@@ -238,40 +249,40 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
238249
, programDefaultArgs = programDefaultArgs program ++ args
239250
}
240251

241-
matchCompilerPath :: ElaboratedSharedConfig -> ConfiguredProgram -> Bool
242-
matchCompilerPath elaboratedShared program =
243-
programPath program
244-
`elem` (programPath <$> configuredCompilers)
245-
where
246-
configuredCompilers = configuredPrograms $ pkgConfigCompilerProgs elaboratedShared
252+
-- matchCompilerPath :: ElaboratedSharedConfig -> ConfiguredProgram -> Bool
253+
-- matchCompilerPath elaboratedShared program =
254+
-- programPath program
255+
-- `elem` (programPath <$> configuredCompilers)
256+
-- where
257+
-- configuredCompilers = configuredPrograms $ toolchainProgramDb $ buildToolchain $ pkgConfigToolchains elaboratedShared
247258

248-
-- | Execute an action with a temporary .ghc.environment file reflecting the
249-
-- current environment. The action takes an environment containing the env
250-
-- variable which points ghc to the file.
251-
withTempEnvFile
252-
:: Verbosity
253-
-> ProjectBaseContext
254-
-> ProjectBuildContext
255-
-> PostBuildProjectStatus
256-
-> ([(String, Maybe String)] -> IO a)
257-
-> IO a
258-
withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do
259-
let tmpDirTemplate = distTempDirectory (distDirLayout baseCtx)
260-
createDirectoryIfMissingVerbose verbosity True tmpDirTemplate
261-
withTempDirectory
262-
verbosity
263-
tmpDirTemplate
264-
"environment."
265-
( \tmpDir -> do
266-
envOverrides <-
267-
createPackageEnvironment
268-
verbosity
269-
tmpDir
270-
(elaboratedPlanToExecute buildCtx)
271-
(elaboratedShared buildCtx)
272-
buildStatus
273-
action envOverrides
274-
)
259+
-- -- | Execute an action with a temporary .ghc.environment file reflecting the
260+
-- -- current environment. The action takes an environment containing the env
261+
-- -- variable which points ghc to the file.
262+
-- withTempEnvFile
263+
-- :: Verbosity
264+
-- -> ProjectBaseContext
265+
-- -> ProjectBuildContext
266+
-- -> PostBuildProjectStatus
267+
-- -> ([(String, Maybe String)] -> IO a)
268+
-- -> IO a
269+
-- withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do
270+
-- let tmpDirTemplate = distTempDirectory (distDirLayout baseCtx)
271+
-- createDirectoryIfMissingVerbose verbosity True tmpDirTemplate
272+
-- withTempDirectory
273+
-- verbosity
274+
-- tmpDirTemplate
275+
-- "environment."
276+
-- ( \tmpDir -> do
277+
-- envOverrides <-
278+
-- createPackageEnvironment
279+
-- verbosity
280+
-- tmpDir
281+
-- (elaboratedPlanToExecute buildCtx)
282+
-- (elaboratedShared buildCtx)
283+
-- buildStatus
284+
-- action envOverrides
285+
-- )
275286

276287
-- | Get paths to all dependency executables to be included in PATH.
277288
pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath]

‎cabal-install/src/Distribution/Client/CmdHaddock.hs‎

Lines changed: 21 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -27,9 +27,6 @@ import Distribution.Client.ProjectConfig.Types
2727
, ProjectConfig (..)
2828
)
2929
import Distribution.Client.ProjectOrchestration
30-
import Distribution.Client.ProjectPlanning
31-
( ElaboratedSharedConfig (..)
32-
)
3330
import Distribution.Client.Setup
3431
( CommonSetupFlags (..)
3532
, ConfigFlags (..)
@@ -48,13 +45,6 @@ import Distribution.Simple.Command
4845
, usageAlternatives
4946
)
5047
import Distribution.Simple.Flag (Flag (..))
51-
import Distribution.Simple.Program.Builtin
52-
( haddockProgram
53-
)
54-
import Distribution.Simple.Program.Db
55-
( addKnownProgram
56-
, reconfigurePrograms
57-
)
5848
import Distribution.Simple.Setup
5949
( HaddockFlags (..)
6050
, fromFlagOrDefault
@@ -160,6 +150,7 @@ haddockAction relFlags targetStrings globalFlags = do
160150
projCtx{buildSettings = (buildSettings projCtx){buildSettingHaddockOpen = True}}
161151
| otherwise =
162152
projCtx
153+
163154
absProjectConfig <- mkConfigAbsolute relProjectConfig
164155
let baseCtx = relBaseCtx{projectConfig = absProjectConfig}
165156

@@ -188,28 +179,32 @@ haddockAction relFlags targetStrings globalFlags = do
188179
TargetActionHaddock
189180
targets
190181
elaboratedPlan
182+
191183
return (elaboratedPlan', targets)
192184

193185
printPlan verbosity baseCtx buildCtx
194186

195-
progs <-
196-
reconfigurePrograms
197-
verbosity
198-
(haddockProgramPaths haddockFlags)
199-
(haddockProgramArgs haddockFlags)
200-
-- we need to insert 'haddockProgram' before we reconfigure it,
201-
-- otherwise 'set
202-
. addKnownProgram haddockProgram
203-
. pkgConfigCompilerProgs
204-
. elaboratedShared
205-
$ buildCtx
187+
-- TODO
188+
-- progs <-
189+
-- reconfigurePrograms
190+
-- verbosity
191+
-- (haddockProgramPaths haddockFlags)
192+
-- (haddockProgramArgs haddockFlags)
193+
-- -- we need to insert 'haddockProgram' before we reconfigure it,
194+
-- -- otherwise 'set
195+
-- . addKnownProgram haddockProgram
196+
-- . pkgConfigCompilerProgs
197+
-- . elaboratedShared
198+
-- $ buildCtx
199+
200+
-- TODO
206201
let buildCtx' =
207202
buildCtx
208-
{ elaboratedShared =
209-
(elaboratedShared buildCtx)
210-
{ pkgConfigCompilerProgs = progs
211-
}
212-
}
203+
-- { elaboratedShared =
204+
-- (elaboratedShared buildCtx)
205+
-- { pkgConfigCompilerProgs = progs
206+
-- }
207+
-- }
213208

214209
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx'
215210
runProjectPostBuildPhase verbosity baseCtx buildCtx' buildOutcomes

0 commit comments

Comments
 (0)