Skip to content

Commit

Permalink
withContextAndSelectors taking verbosity
Browse files Browse the repository at this point in the history
  • Loading branch information
philderbeast committed Jan 3, 2025
1 parent 1082c0b commit ef2ab12
Show file tree
Hide file tree
Showing 6 changed files with 11 additions and 14 deletions.
2 changes: 1 addition & 1 deletion cabal-install/src/Distribution/Client/CmdBuild.hs
Original file line number Diff line number Diff line change
Expand Up @@ -135,7 +135,7 @@ defaultBuildFlags =
-- "Distribution.Client.ProjectOrchestration"
buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()
buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globalFlags =
withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do
withContextAndSelectors verbosity RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do
-- TODO: This flags defaults business is ugly
let onlyConfigure =
fromFlag
Expand Down
1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/CmdHaddockProject.hs
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
--

withContextAndSelectors
verbosity
RejectNoTargets
Nothing
(commandDefaultFlags CmdBuild.buildCommand)
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/src/Distribution/Client/CmdListBin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -94,7 +94,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do
_ -> dieWithException verbosity OneTargetRequired

-- configure and elaborate target selectors
withContextAndSelectors RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do
withContextAndSelectors verbosity RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do
baseCtx <- case targetCtx of
ProjectContext -> return ctx
GlobalContext -> return ctx
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/src/Distribution/Client/CmdPath.hs
Original file line number Diff line number Diff line change
Expand Up @@ -228,7 +228,7 @@ pathName ConfigPathInstallDir = "installdir"

-- | Entry point for the 'path' command.
pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO ()
pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do
pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors verbosity AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do
let pathFlags =
if pathCompiler pathFlags' == NoFlag && pathDirectories pathFlags' == NoFlag
then -- if not a single key to query is given, query everything!
Expand Down
5 changes: 3 additions & 2 deletions cabal-install/src/Distribution/Client/CmdRun.hs
Original file line number Diff line number Diff line change
Expand Up @@ -206,13 +206,13 @@ runCommand =
-- "Distribution.Client.ProjectOrchestration"
runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do
withContextAndSelectors (cfgVerbosity normal) RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do
(baseCtx, defaultVerbosity) <- case targetCtx of
ProjectContext -> return (ctx, normal)
GlobalContext -> return (ctx, normal)
ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta

let verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)
let verbosity = cfgVerbosity defaultVerbosity

buildCtx <-
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
Expand Down Expand Up @@ -360,6 +360,7 @@ runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
elaboratedPlan
}
where
cfgVerbosity v = fromFlagOrDefault v (setupVerbosity $ configCommonFlags configFlags)
(targetStr, args) = splitAt 1 targetAndArgs

-- | Used by the main CLI parser as heuristic to decide whether @cabal@ was
Expand Down
13 changes: 4 additions & 9 deletions cabal-install/src/Distribution/Client/ScriptUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -75,9 +75,7 @@ import Distribution.Client.RebuildMonad
( runRebuild
)
import Distribution.Client.Setup
( CommonSetupFlags (..)
, ConfigFlags (..)
, GlobalFlags (..)
( GlobalFlags (..)
)
import Distribution.Client.TargetSelector
( TargetSelectorProblem (..)
Expand Down Expand Up @@ -177,9 +175,6 @@ import Distribution.Types.UnqualComponentName
import Distribution.Utils.NubList
( fromNubList
)
import Distribution.Verbosity
( normal
)
import Language.Haskell.Extension
( Language (..)
)
Expand Down Expand Up @@ -281,7 +276,8 @@ data TargetContext
-- In the case that the context refers to a temporary directory,
-- delete it after the action finishes.
withContextAndSelectors
:: AcceptNoTargets
:: Verbosity
-> AcceptNoTargets
-- ^ What your command should do when no targets are found.
-> Maybe ComponentKind
-- ^ A target filter
Expand All @@ -296,7 +292,7 @@ withContextAndSelectors
-> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b)
-- ^ The body of your command action.
-> IO b
withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act =
withContextAndSelectors verbosity noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act =
withTemporaryTempDirectory $ \mkTmpDir -> do
(tc, ctx) <-
withProjectOrGlobalConfig
Expand Down Expand Up @@ -337,7 +333,6 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo

act tc' ctx' sels
where
verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
ignoreProject = flagIgnoreProject projectFlags
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
Expand Down

0 comments on commit ef2ab12

Please sign in to comment.