hwm 0.3.0 → 0.4.0

raw patch · 32 files changed

+810/−427 lines, 32 filesdep ~hwmPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hwm

API changes (from Hackage documentation)

Files

• hwm.cabal +4/−3
• src/HWM/CLI/App.hs +12/−0
• src/HWM/CLI/Command.hs +7/−1
• src/HWM/CLI/Command/Environment/Add.hs +6/−10
• src/HWM/CLI/Command/Environment/SetDefault.hs +1/−1
• src/HWM/CLI/Command/Init.hs +4/−4
• src/HWM/CLI/Command/Registry/Add.hs +4/−4
• src/HWM/CLI/Command/Registry/Audit.hs +4/−4
• src/HWM/CLI/Command/Release/Artifacts.hs +14/−16
• src/HWM/CLI/Command/Release/Publish.hs +5/−6
• src/HWM/CLI/Command/Run.hs +59/−90
• src/HWM/CLI/Command/Sync.hs +1/−1
• src/HWM/CLI/Command/Workspace/Add.hs +6/−6
• src/HWM/Core/Formatting.hs +16/−7
• src/HWM/Core/Options.hs +5/−1
• src/HWM/Core/Pkg.hs +1/−1
• src/HWM/Domain/Bounds.hs +6/−6
• src/HWM/Domain/Build.hs +127/−39
• src/HWM/Domain/Config.hs +9/−6
• src/HWM/Domain/ConfigT.hs +1/−1
• src/HWM/Domain/Dispatcher.hs +67/−0
• src/HWM/Domain/Environments.hs +83/−45
• src/HWM/Domain/Workspace.hs +8/−8
• src/HWM/Integrations/Toolchain/Cabal.hs +21/−8
• src/HWM/Integrations/Toolchain/Nix.hs +75/−44
• src/HWM/Integrations/Toolchain/Stack.hs +29/−33
• src/HWM/Runtime/Files.hs +19/−3
• src/HWM/Runtime/Logging.hs +51/−18
• src/HWM/Runtime/Network.hs +1/−1
• src/HWM/Runtime/Platform.hs +9/−0
• src/HWM/Runtime/Process.hs +90/−31
• src/HWM/Runtime/UI.hs +65/−29

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.1.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           hwm-version:        0.3.0+version:        0.4.0 synopsis:       Haskell Workspace Manager - Orchestrates Stack, Cabal, and HLS description:    HWM (Haskell Workspace Manager) manages multi-package Haskell projects by                 generating and synchronizing configuration files for Stack, Cabal, Hpack, and HLS@@ -65,6 +65,7 @@       HWM.Domain.Config       HWM.Domain.ConfigT       HWM.Domain.Dependencies+      HWM.Domain.Dispatcher       HWM.Domain.Environments       HWM.Domain.Registry       HWM.Domain.Release@@ -147,7 +148,7 @@     , hpack >=0.34.6 && <=0.39.3     , http-client >=0.6.4.1 && <=0.7.19     , http-types >=0.12.3.0 && <=0.12.4-    , hwm >=0.3.0 && <0.4.0+    , hwm >=0.4.0 && <0.5.0     , modern-uri >=0.3.4.3 && <=0.3.6.1     , mtl >2.0.0 && <2.6.0     , optparse-applicative >=0.16.1.0 && <=0.19.0.0

@@ -83,6 +83,18 @@         "Display the current workspace version or bump it (patch, minor, major).",         Version <$> parseCLI       ),+      ( "build",+        "Build the current workspace or specific targets.",+        Build <$> parseCLI+      ),+      ( "install",+        "Install the current workspace or specific targets.",+        Install <$> parseCLI+      ),+      ( "test",+        "Test the current workspace or specific targets.",+        Test <$> parseCLI+      ),       ( "release",         "Manage delivery: build artifacts or publish release trains.",         Release <$> parseCLI

@@ -16,7 +16,7 @@ import HWM.CLI.Command.Init (InitOptions (..), initWorkspace) import HWM.CLI.Command.Registry.Root (RegistryCommand, runRegistry) import HWM.CLI.Command.Release.Root (ReleaseCommand (..), runRelease)-import HWM.CLI.Command.Run (ScriptOptions, runScript)+import HWM.CLI.Command.Run (ScriptOptions, TaskCommandOptions, runBuild, runInstall, runScript, runTest) import HWM.CLI.Command.Status (showStatus) import HWM.CLI.Command.Sync (sync) import HWM.CLI.Command.Version (VersionOptions, runVersion)@@ -39,6 +39,9 @@   | Env EnvCommand   | Workspace WorkspaceCommand   | Release ReleaseCommand+  | Install TaskCommandOptions+  | Build TaskCommandOptions+  | Test TaskCommandOptions   deriving (Show)  currentVersion :: String@@ -50,6 +53,9 @@ command (Version options) = runVersion options command Sync {tag} = sync tag command Run {scriptName, runOptions} = runScript scriptName runOptions+command (Build options) = runBuild options+command (Install options) = runInstall options+command (Test options) = runTest options command Status = showStatus command Init {} = pure () command (Registry options) = runRegistry options

@@ -5,15 +5,14 @@ module HWM.CLI.Command.Environment.Add (EnvAddOptions, runEnvAdd) where  import Control.Monad.Except (throwError)-import qualified Data.Map as Map import HWM.Core.Common (Name)-import HWM.Core.Formatting (Format (..), padDots)+import HWM.Core.Formatting (Format (..)) import HWM.Core.Parsing (Parse (..), ParseCLI (..)) import HWM.Core.Version (Version) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, updateConfig)-import HWM.Domain.Environments (Environments (..), existsEnviroment, newEnv, printEnvironments)-import HWM.Runtime.UI (putLine, section)+import HWM.Domain.Environments (addProfile, existsEnviroment, mkEnvironment, printEnvironments)+import HWM.Runtime.UI (minRowSize, section, uiRow) import Options.Applicative (help, metavar, strArgument) import Options.Applicative.Builder (argument, str) import Relude@@ -30,9 +29,6 @@       <$> strArgument (metavar "NAME" <> help "Name of the environment to add")       <*> argument (str >>= parse) (metavar "GHC" <> help "GHC version (e.g. 8.10.7)") -size :: Int-size = 16- runEnvAdd :: EnvAddOptions -> ConfigT () runEnvAdd EnvAddOptions {..} = do   exists <- existsEnviroment envName@@ -41,10 +37,10 @@       printEnvironments Nothing       throwError $ fromString $ "Environment '" <> toString envName <> "' already exists."     else section "new environment" $ do-      putLine $ padDots size "name" <> envName+      uiRow minRowSize "name" envName       updateConfig         ( \cfg@Config {..} -> do-            putLine $ padDots size "ghc" <> format envGHC-            pure cfg {cfgEnvironments = cfgEnvironments {envProfiles = Map.insert envName (newEnv envGHC) (envProfiles cfgEnvironments)}}+            uiRow minRowSize "ghc" (format envGHC)+            pure cfg {cfgEnvironments = addProfile envName (mkEnvironment envGHC) cfgEnvironments}         )         (pure ())

@@ -20,5 +20,5 @@ runEnvSetDefault :: EnvSetDefaultOptions -> ConfigT () runEnvSetDefault EnvSetDefaultOptions {..} = do   _ <- getBuildEnvironment (Just envName)-  let setDefaultEnv cfg = cfg {cfgEnvironments = (cfgEnvironments cfg) {envDefault = envName}}+  let setDefaultEnv cfg = cfg {cfgEnvironments = (cfgEnvironments cfg) {envsDefault = envName}}   updateConfig (pure . setDefaultEnv) $ printEnvironments Nothing

@@ -10,7 +10,7 @@ import Control.Monad.Except (MonadError (..)) import Data.List import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (Cyan), Format (format), chalk, padDots)+import HWM.Core.Formatting (Color (Cyan), Format (format), chalk) import HWM.Core.Options (Options (..)) import HWM.Core.Parsing (ParseCLI (..), flag) import HWM.Core.Pkg (IsPkg (..), scanPkgs)@@ -23,7 +23,7 @@ import HWM.Integrations.Toolchain.Cabal (readCabalPackage) import HWM.Integrations.Toolchain.Stack (buildMatrix, scanStackFiles) import HWM.Runtime.Files (forbidOverride)-import HWM.Runtime.UI (MonadUI, putLine, runUI, section)+import HWM.Runtime.UI (MonadUI, runUI, section, uiRow) import Options.Applicative (argument, help, metavar, str) import Relude hiding (exitWith, notElem) import System.Directory (getCurrentDirectory)@@ -77,10 +77,10 @@           ..         }       opts-    putLine $ padDots size "save (config)" <> chalk Cyan "hwm.yaml"+    uiRow size "save (config)" (chalk Cyan "hwm.yaml")  scanning :: (MonadUI m, Foldable t) => Text -> t a -> m ()-scanning name ls = putLine (padDots size ("scan (" <> name <> ")") <> format (length ls) <> " found")+scanning name ls = uiRow size ("scan (" <> name <> ")") (format (length ls) <> " found")  deriveName :: FilePath -> Name deriveName path =

@@ -5,7 +5,7 @@ module HWM.CLI.Command.Registry.Add (runRegistryAdd, RegistryAddOptions (..)) where  import qualified Data.Text as T-import HWM.Core.Formatting (Color (..), Format (..), chalk, padDots)+import HWM.Core.Formatting (Color (..), Format (..), chalk) import HWM.Core.Parsing (ParseCLI (..), parse, parseOptions) import HWM.Core.Pkg (PkgName (..)) import HWM.Domain.Bounds (deriveBounds)@@ -16,7 +16,7 @@ import HWM.Domain.Registry (addDependency, lookupBounds) import HWM.Domain.Workspace (forWorkspaceTuple, resolveWorkspaces) import HWM.Integrations.Toolchain.Package-import HWM.Runtime.UI (putLine, section, sectionTableM)+import HWM.Runtime.UI (minRowSize, section, sectionTableM, uiRow) import Options.Applicative (argument, help, long, metavar, short, str) import Relude @@ -41,7 +41,7 @@     Nothing -> do       range <- getTestedRange       section "discovery" $ do-        putLine $ padDots 16 "registry" <> "missing (initiating lookup)"+        uiRow minRowSize "registry" "missing (initiating lookup)"        bounds <- deriveBounds opsPkgName range       let dependency = Dependency opsPkgName bounds@@ -49,7 +49,7 @@       ((\cf -> pure cf {cfgRegistry = Just $ addDependency dependency (fromMaybe mempty (cfgRegistry cf))}) `updateConfig`) $ addDepToPackage workspaces dependency     Just bounds -> do       section "discovery" $ do-        putLine $ padDots 16 "registry" <> format bounds <> " (already registered)"+        uiRow minRowSize "registry" (format bounds <> " (already registered)")       addDepToPackage workspaces (Dependency opsPkgName bounds)   where     addDepToPackage ws dependency = unless (null ws) $ forWorkspaceTuple ws $ addPkgDependency dependency

@@ -13,7 +13,7 @@ import HWM.Domain.Environments (getTestedRange) import HWM.Domain.Registry (askRegistry, mapDeps, mapWithName) import HWM.Integrations.Toolchain.Package (syncPackages)-import HWM.Runtime.UI (indent, printGenTable, putLine, section, sectionTableM)+import HWM.Runtime.UI (putLine, section, sectionTableM, uiFormatTable) import Options.Applicative import Relude @@ -32,13 +32,13 @@   sectionTableM "audit" [("mode", pure (if auditFix then if auditForce then chalk Yellow "fix (force)" else chalk Cyan "fix" else "check"))]    let dependencyAudits = filter (auditHasAny (/= Valid)) $ mapWithName (auditBounds range) originalRegistry-  section "registry" $ printGenTable $ formatAudit <$> dependencyAudits-  let errorCount = length $ filter (auditHasAny (== Conflict)) dependencyAudits    if null dependencyAudits     then do-      indent 1 $ putLine "all dependencies are up to date."+      section "registry" $ putLine "all dependencies are up to date."     else do+      section "registry" $ uiFormatTable $ formatAudit <$> dependencyAudits+      let errorCount = length $ filter (auditHasAny (== Conflict)) dependencyAudits       if auditFix         then ((\cf -> pure $ cf {cfgRegistry = Just $ mapDeps (updateDepBounds auditForce range) originalRegistry}) `updateConfig`) $ do           syncPackages

@@ -13,20 +13,20 @@ import qualified Data.Text as T import Data.Traversable (for) import HWM.Core.Common (Name)-import HWM.Core.Formatting (Format (format), Status (..), formatList, statusIcon, subPathSign)+import HWM.Core.Formatting (Format (format), Status (..), formatList, statusIcon) import HWM.Core.Parsing (Parse (..), ParseCLI (..), parseLS)-import HWM.Core.Pkg (Pkg (..)) import HWM.Core.Result (fromEither)-import HWM.Domain.Build (Builder (..), buildBinary)+import HWM.Domain.Build (BuildFlag (GHCOptionsFlag), Builder (..), BuilderCommand (..), TargetScope (ScopePkgs)) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, Env (..), getArchiveConfigs)-import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment)+import HWM.Domain.Dispatcher (DispatcheCommand (..), dispatch)+import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment, overrideBuilder) import HWM.Domain.Release (ArchiveFormat, ArtifactConfig (..), ReleaseArtifactConfigs, selectedArtifacts) import HWM.Domain.Workspace (resolveWorkspaces) import HWM.Integrations.Toolchain.Github (ensureIsLatestTag) import HWM.Runtime.Archive (ArchiveInfo (..), ArchivingPlan (..), createArchive) import HWM.Runtime.Network (getGHUploadUrl, uploadToGitHub)-import HWM.Runtime.UI (forTable, indent, putLine, section, sectionTableM)+import HWM.Runtime.UI (indent, section, sectionTableM, uiSpace, uiSubPath) import Options.Applicative (argument, help, long, metavar, option, showDefault, str, strOption, switch, value) import Relude import System.Directory (createDirectoryIfMissing, removePathForcibly)@@ -67,10 +67,6 @@   prepeareDir path   pure path -ghcOptions :: [Text] -> [Text]-ghcOptions [] = []-ghcOptions xs = ["--ghc-options=" <> T.unwords xs]- defaultOutputDir :: FilePath defaultOutputDir = ".hwm/dist" @@ -112,7 +108,8 @@       ("builder", pure $ format builder)     ] -  plans <- forTable "build" cfgs (\x -> (fst x, buildPkg outputDir builder x))+  plans <- section "build" $ traverse (buildPkg outputDir builder) cfgs+  uiSpace    section "archive" $ pure ()   artifacts <- for plans $ \(name, plan) -> do@@ -121,23 +118,24 @@       $ section name       $ for_ archives       $ \ArchiveInfo {..} -> do-        putLine $ subPathSign <> format archivePath-        putLine $ subPathSign <> format sha256Path+        uiSubPath archivePath+        uiSubPath sha256Path     pure (name, archives)    for_ uploadUrl $ \url -> section "publish (Github)"     $ for_ artifacts     $ \(name, archives) -> section name $ for_ archives $ \ArchiveInfo {..} -> do       uploadToGitHub url archivePath-      putLine $ subPathSign <> format archivePath+      uiSubPath archivePath       uploadToGitHub url sha256Path-      putLine $ subPathSign <> format sha256Path+      uiSubPath sha256Path  buildPkg :: FilePath -> Builder -> (Name, ArtifactConfig) -> ConfigT (Text, ArchivingPlan) buildPkg outputDir builder (name, ArtifactConfig {..}) = do   binaryDir <- genBindaryDir name   let (workspaceId, executableName) = second (T.drop 1) (T.breakOn ":" arcSource)   optTarget <- listToMaybe . concatMap snd <$> resolveWorkspaces [workspaceId]-  Pkg {..} <- maybe (throwError $ fromString $ toString $ "Package \"" <> workspaceId <> "\" not found in any workspace. Check package name and workspace configuration.") pure optTarget-  buildBinary builder pkgName binaryDir (ghcOptions arcGhcOptions)+  pkg <- maybe (throwError $ fromString $ toString $ "Package \"" <> workspaceId <> "\" not found in any workspace. Check package name and workspace configuration.") pure optTarget+  env <- overrideBuilder builder <$> getBuildEnvironment Nothing+  dispatch (DispatcheCommand (Install binaryDir) (ScopePkgs [pkg]) (map GHCOptionsFlag arcGhcOptions)) env   pure (statusIcon Checked, ArchivingPlan {nameTemplate = arcNameTemplate, outDir = outputDir, sourceDir = binaryDir, name = executableName, archiveFormats = arcFormats})

@@ -19,7 +19,6 @@     Status (Checked, Invalid),     chalk,     genMaxLen,-    padDots,     statusIcon,   ) import HWM.Core.Parsing (ParseCLI (..))@@ -33,7 +32,7 @@ import HWM.Integrations.Toolchain.Cabal (nativeSdist) import HWM.Integrations.Toolchain.Package (deriveDependencyGraph) import HWM.Runtime.Network (getHackageToken, uploadToHackage)-import HWM.Runtime.UI (printSummary, putLine, section, sectionTableM)+import HWM.Runtime.UI (printSummary, sectionTableM, section_, uiSubPathRow) import Options.Applicative (argument, help, metavar, str) import Relude hiding (intercalate) import System.Directory (getCurrentDirectory)@@ -99,14 +98,14 @@    let size = genMaxLen (map (\((pkg, _), n) -> show n <> ". " <> printPkgWSRef pkg) ls) -  section "publishing plan (topological sort)" $ do+  section_ "publishing plan (topological sort)" $ do     for_ ls $ \((pkg, filePath), idx) -> do-      putLine $ "└── " <> padDots size (show idx <> ". " <> printPkgWSRef pkg) <> fromString (makeRelative cwd filePath)+      uiSubPathRow size (show idx <> ". " <> printPkgWSRef pkg) (format $ makeRelative cwd filePath)    token <- getHackageToken-  section "publishing" $ do+  section_ "publishing" $ do     for_ releasePkgs $ \(pkg, filePath) -> do       issues <- uploadToHackage token pkg filePath       let status = if null issues then Checked else Invalid-      putLine $ "└── " <> padDots size (printPkgWSRef pkg) <> statusIcon status+      uiSubPathRow size (printPkgWSRef pkg) (statusIcon status)       failIssues issues

@@ -6,28 +6,24 @@ module HWM.CLI.Command.Run   ( runScript,     ScriptOptions,+    TaskCommandOptions,+    runBuild,+    runInstall,+    runTest,   ) where -import Control.Concurrent.Async-import Control.Monad.Error.Class (MonadError (..))-import Data.List (intersect)-import qualified Data.Map as M-import qualified Data.Text as T-import Data.Traversable (for) import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (..), Format (..), Status (Checked, Invalid), chalk, genMaxLen, padDots, statusIcon) import HWM.Core.Parsing (ParseCLI (..), parseOptions)-import HWM.Core.Pkg (Pkg (..))-import HWM.Core.Result (Issue (..), IssueDetails (..), Severity (..))-import HWM.Domain.Config (Config (..))+import HWM.Domain.Build (BuildFlag (..), BuilderCommand (..), TargetScope (..))+import HWM.Domain.Config (getScript) import HWM.Domain.ConfigT (ConfigT, config)-import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment, getBuildEnvironments)-import HWM.Domain.Workspace (resolveWorkspaces)-import HWM.Integrations.Toolchain.Stack (createEnvYaml, stackPath)-import HWM.Runtime.Logging (logIssue)-import HWM.Runtime.Process (inheritRun, silentRun)-import HWM.Runtime.UI (putLine, runSpinner, sectionEnvironments, sectionWorkspace, statusIndicator)+import HWM.Domain.Dispatcher (DispatcheCommand (..), dispatchForEach)+import HWM.Domain.Environments (selectEnvironments)+import HWM.Domain.Workspace (printPkgWSRef, resolveWorkspaces)+import HWM.Runtime.Files (getLocalBinDir, warnBindDir)+import HWM.Runtime.Process (Exec (..), inheritRun)+import HWM.Runtime.UI (minRowSize, putLine, sectionWorkspace, uiRow, uiSubPath) import Options.Applicative   ( argument,     help,@@ -36,88 +32,61 @@     short,     str,   )+import Options.Applicative.Builder (switch) import Relude -data ScriptOptions = ScriptOptions-  { scriptTargets :: [Name],-    scriptEnvs :: [Name],-    scriptOptions :: [Text]-  }-  deriving (Show)+newtype ScriptOptions = ScriptOptions {scriptOptions :: [Text]} deriving (Show)  instance ParseCLI ScriptOptions where-  parseCLI =-    ScriptOptions-      <$> parseOptions (long "target" <> short 't' <> metavar "TARGET" <> help "Limit to package (core) or group (libs)")-      <*> parseOptions (long "env" <> short 'e' <> metavar "ENV" <> help "Run in specific env (use 'all' for full matrix)")-      <*> many (argument str (metavar "ARGS..." <> help "Arguments to forward to the script"))--getEnvs :: [Name] -> ConfigT [BuildEnvironment]-getEnvs ["all"] = getBuildEnvironments-getEnvs names = for names (getBuildEnvironment . Just)+  parseCLI = ScriptOptions <$> many (argument str (metavar "ARGS..." <> help "Arguments to forward to the script"))  runScript :: Name -> ScriptOptions -> ConfigT () runScript scriptName ScriptOptions {..} = do   cfg <- asks config-  case cfgScripts cfg >>= M.lookup scriptName of-    Just script -> do-      envs <- getEnvs scriptEnvs-      targets <- concatMap snd <$> resolveWorkspaces scriptTargets-      for_ envs (createEnvYaml . buildName)-      let multi = length envs > 1-      let cmdTemplate = if null scriptOptions then script else T.unwords (script : scriptOptions)-      let padding = genMaxLen (map format envs)-      let run = runCommand padding multi cmdTemplate targets+  script <- getScript scriptName cfg+  putLine ("❯ " <> script)+  inheritRun Exec {execCmd = script, execArgs = scriptOptions, execEnv = [], postCommand = Nothing} -      if multi-        then do-          when multi $ do-            sectionWorkspace $ do-              putLine $ padDots 16 "targets" <> if null scriptTargets then chalk Yellow "None (Global Scope)" else chalk Cyan (T.unwords scriptTargets)-            sectionEnvironments Nothing (for_ (map buildName envs) (run . Just))-        else run Nothing-    Nothing -> throwError $ fromString $ toString $ "Script not found: " <> scriptName+data TaskCommandOptions = TaskCommandOptions+  { opsEnviroments :: [Name],+    opsWorkspaces :: [Name],+    opsFast :: Bool+  }+  deriving (Show) -runCommand :: Int -> Bool -> Text -> [Pkg] -> Maybe Name -> ConfigT ()-runCommand padding multi scripts targets envName = do-  benv@BuildEnvironment {..} <- getBuildEnvironment envName-  let supported = targets `intersect` buildPkgs-  cmd <- resolveCommand scripts supported-  yamlPath <- stackPath envName-  if multi-    then do-      let env = format benv-      (success, content) <- silentRun yamlPath cmd (async (runSpinner padding env))-      statusIndicator padding env (statusIcon (if success then Checked else Invalid))-      unless success $ do-        path <- logIssue buildName SeverityError [("ENVIRONMENT", format benv), ("COMMAND", format cmd)] content-        throwError-          Issue-            { issueTopic = buildName,-              issueMessage = "Command failed",-              issueSeverity = SeverityError,-              issueDetails = Just CommandIssue {issueCommand = format cmd, issueLogFile = path}-            }-      putLine ""-    else do-      sectionWorkspace $ do-        putLine $ padDots 16 "targets" <> if null supported then chalk Yellow "None (Global Scope)" else chalk Cyan (T.unwords $ format . pkgName <$> supported)-      sectionEnvironments Nothing $ putLine $ format benv-      putLine ""-      putLine ("❯ " <> cmd)-      inheritRun yamlPath cmd-      putLine ""+instance ParseCLI TaskCommandOptions where+  parseCLI =+    TaskCommandOptions+      <$> parseOptions (long "env" <> short 'e' <> metavar "ENV" <> help "Run in specific env (use 'all' for full matrix)")+      <*> many (argument str (metavar "WORKSPACE" <> help "Limit to package (core) or group (libs)"))+      <*> switch (long "fast" <> help "Enable fast mode") -resolveCommand :: Text -> [Pkg] -> ConfigT Text-resolveCommand cmd targets = do-  let hasPlaceholder = "{TARGET}" `T.isInfixOf` cmd-      hasTargets = not (null targets)-      targetsStr = T.unwords (map (format . pkgName) targets)-  let result = case (hasPlaceholder, hasTargets) of-        (True, True) -> Right $ T.replace "{TARGET}" targetsStr cmd-        (True, False) -> Left "Missing Target! This command requires specific targets (e.g. --target app1)."-        (False, True) -> Left "Target Not Allowed! This command is Global-only and does not support specific targets."-        (False, False) -> Right cmd-  case result of-    Left err -> throwError $ fromString err-    Right c -> pure c+parseTargets :: [Name] -> ConfigT TargetScope+parseTargets names = case names of+  [] -> do+    sectionWorkspace $ uiRow minRowSize "scope" "Global"+    pure ScopeGlobal+  _ -> do+    pkgs <- concatMap snd <$> resolveWorkspaces names+    sectionWorkspace $ for_ pkgs $ \pkg -> uiSubPath (printPkgWSRef pkg)+    pure $ ScopePkgs pkgs++runBuild :: TaskCommandOptions -> ConfigT ()+runBuild TaskCommandOptions {..} = do+  scope <- parseTargets opsWorkspaces+  envs <- selectEnvironments opsEnviroments+  dispatchForEach (DispatcheCommand Build scope [BuildFastFlag | opsFast]) envs++runInstall :: TaskCommandOptions -> ConfigT ()+runInstall TaskCommandOptions {..} = do+  scope <- parseTargets opsWorkspaces+  envs <- selectEnvironments opsEnviroments+  binDir <- getLocalBinDir+  warnBindDir binDir+  dispatchForEach (DispatcheCommand (Install binDir) scope [BuildFastFlag | opsFast]) envs++runTest :: TaskCommandOptions -> ConfigT ()+runTest TaskCommandOptions {..} = do+  scope <- parseTargets opsWorkspaces+  envs <- selectEnvironments opsEnviroments+  dispatchForEach (DispatcheCommand Test scope [BuildFastFlag | opsFast]) envs

@@ -29,6 +29,6 @@     ( [("cabal.project", syncCabalProject)]         <> [("stack.yaml", syncStackYaml) | buildStack env]         <> [("flake.nix", syncNixFile) | buildNix env]-        <> [("hie.yaml", syncHie)]+        <> [("hie.yaml", syncHie) | buildHie env]     )   syncPackages

@@ -6,7 +6,7 @@  import Control.Monad.Error.Class (MonadError (throwError)) import qualified Data.Map as Map-import HWM.Core.Formatting (Color (..), Status (Checked), chalk, displayStatusM, padDots, subPathSign)+import HWM.Core.Formatting (Color (..), Status (Checked), chalk, displayStatusM) import HWM.Core.Parsing (ParseCLI (..)) import HWM.Core.Pkg (PkgName (..), mkPkgDirPath, resolvePrefix) import HWM.Core.Result (Issue (..), MonadIssue (injectIssue), Severity (SeverityError, SeverityWarning))@@ -16,7 +16,7 @@ import HWM.Integrations.Scaffold (scaffoldPackage) import HWM.Integrations.Toolchain.Hie (syncHie) import HWM.Integrations.Toolchain.Stack (syncStackYaml)-import HWM.Runtime.UI (putLine, sectionWorkspace)+import HWM.Runtime.UI (minRowSize, putLine, sectionWorkspace, uiLabel, uiSpace, uiSubPathRow) import Options.Applicative (help, long, metavar, strArgument, strOption) import Relude @@ -48,7 +48,7 @@     else do       let ws = Map.insert groupId (WorkGroup opsWorkspaceDir [] opsPrefix) wss       sectionWorkspace $ do-        putLine ""+        uiSpace         displayStatusM [("added", pure Checked)] >>= putLine . (("• " <> chalk Bold groupId <> " ") <>)       updateConfig (\cfg -> pure $ cfg {cfgWorkspace = ws}) (pure ()) runWorkspaceAdd (WorkspaceAddOptions {opsWorkspaceId = WorkspaceRef groupId (Just memberId), ..}) = do@@ -57,10 +57,10 @@   (ws, w) <- addWorkgroupMember groupId memberId   sectionWorkspace     $ do-      putLine ""-      putLine $ "• " <> chalk Bold groupId+      uiSpace+      uiLabel groupId       xs <- scaffoldPackage (mkPkgDirPath (dir w) (prefix w) memberId) (PkgName $ resolvePrefix (prefix w) memberId)-      displayStatusM xs >>= putLine . ((subPathSign <> padDots 16 memberId) <>)+      displayStatusM xs >>= uiSubPathRow minRowSize memberId    updateConfigM (\cfg -> pure $ cfg {cfgWorkspace = ws}) [("stack.yaml", syncStackYaml), ("hie.yaml", syncHie)] $ pure ()   where

@@ -29,11 +29,15 @@     toCamelCase,     formatTableRow,     StatusM,+    slugifyList,+    andMore,+    minRowSize,   ) where  import Data.Aeson (Value, encode) import Data.ByteString.Lazy.Char8 (unpack)+import Data.Char (isAlphaNum) import Data.Foldable (maximum) import qualified Data.List as List import Data.Text (pack)@@ -140,8 +144,11 @@   where     formatItem (label, s) = statusIcon s <> " " <> chalk (labelColor s) label +minRowSize :: Int+minRowSize = 16+ genMaxLen :: [Text] -> Int-genMaxLen names = if null names then 16 else maximum (map T.length names) + 4+genMaxLen names = if null names then minRowSize else maximum (map T.length names) + 4  separator :: Int -> Text separator size = chalk Gray $ T.replicate size "─"@@ -178,16 +185,15 @@ renderSummaryStatus _ = boxed BrightGreen "success"  subPathSign :: Text-subPathSign = chalk Dim "└─- "+subPathSign = chalk Dim "└── " +slugifyList :: [Text] -> Text+slugifyList = T.intercalate "-" . map slugify+ slugify :: Text -> Text slugify = T.map replaceChar . T.toLower   where-    replaceChar c-      | c == ' ' = '-'-      | c == '_' = '-'-      | c == '.' = '-'-      | otherwise = c+    replaceChar c | isAlphaNum c = c | otherwise = '-'  commonPrefix :: [Text] -> (Maybe Text, [Text]) commonPrefix [] = (Nothing, [])@@ -270,3 +276,6 @@       case T.uncons t of         Nothing -> ""         Just (c, rest) -> T.toUpper (T.singleton c) <> rest++andMore :: Text -> [Text] -> Text+andMore x xs = x <> if null xs then "" else " and " <> show (length xs) <> " more"

@@ -7,6 +7,7 @@     defaultOptions,     askOptions,     whenCI,+    isCI,     whenDebug,   ) where@@ -39,9 +40,12 @@       optionDebug = False     } +isCI :: (MonadIO m) => m Bool+isCI = liftIO $ isJust <$> lookupEnv "CI"+ whenCI :: (MonadIO m) => m () -> m () whenCI action = do-  ci <- liftIO $ isJust <$> lookupEnv "CI"+  ci <- isCI   when ci action  whenDebug :: (MonadIO m) => m () -> m ()

@@ -109,7 +109,7 @@   let cabalFile = joinPath [pkgDirPath, cabal]   let hpackFile = if "package.yaml" `elem` files then Just (joinPath [pkgDirPath, "package.yaml"]) else Nothing   let pkgName = PkgName (toText $ dropExtension cabal)-  pure $ Pkg {pkgMemberId = if memberName == "." then "(root)" else memberName, ..}+  pure $ Pkg {pkgMemberId = if memberName == "." then "_root_" else memberName, ..}  scanPkgs :: (MonadIO m, MonadError Issue m) => FilePath -> m [Pkg] scanPkgs root = do

@@ -33,7 +33,7 @@     ToJSON (..),     Value (..),   )-import HWM.Core.Formatting (Color (..), Format (..), chalk, formatList, padDots)+import HWM.Core.Formatting (Color (..), Format (..), chalk, formatList) import HWM.Core.Has (Has) import HWM.Core.Parsing (Parse (..), fromToString, removeHead, sepBy, unconsM) import HWM.Core.Pkg (PkgName)@@ -215,11 +215,11 @@    newUpper <- maybe (head <$> getVersions name) pure upper -  section "discovery" $ do-    putLine $ padDots 16 "registry" <> "missing (initiating lookup)"-    putLine $ padDots 16 "legacy" <> maybe (chalk Red "missing") (chalk Green . format) lower <> " (min)"-    putLine $ padDots 16 "nightly" <> maybe (chalk Red "missing") ((<> " (max)") . chalk Green . format) upper-    unless (isJust lower || isJust upper) $ putLine $ padDots 16 "hackage" <> chalk Green (format newUpper) <> " (max)"+  section_ "discovery" $ do+    uiRow minRowSize "registry" "missing (initiating lookup)"+    uiRow minRowSize "legacy" (maybe (chalk Red "missing") (chalk Green . format) lower <> " (min)")+    uiRow minRowSize "nightly" (maybe (chalk Red "missing") ((<> " (max)") . chalk Green . format) upper)+    unless (isJust lower || isJust upper) $ uiRow minRowSize "hackage" (chalk Green (format newUpper) <> " (max)")    pure     Bounds

@@ -1,11 +1,16 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Domain.Build   ( Builder (..),-    buildBinary,+    BuilderCommand (..),+    TargetScope (..),+    BuildFlag (..),+    toExec,+    comandLabel,   ) where @@ -13,17 +18,18 @@ import Control.Monad.Except (throwError) import Data.Aeson (FromJSON (..), ToJSON (toJSON)) import Data.Aeson.Types (Value (..))-import HWM.Core.Formatting (Format (..))+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Format (..), toCamelCase) import HWM.Core.Parsing (Parse (..))-import HWM.Core.Pkg (PkgName)+import HWM.Core.Pkg (Pkg (..), PkgName) import HWM.Core.Result (Issue)-import HWM.Runtime.Process (exec)+import HWM.Runtime.Process (EnvVars, Exec (..), mkExec) import Relude-import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, doesPathExist, emptyPermissions, removeFile, setOwnerExecutable, setOwnerReadable, setOwnerWritable, setPermissions)+import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, doesPathExist, emptyPermissions, listDirectory, removeFile, removePathForcibly, setOwnerExecutable, setOwnerReadable, setOwnerWritable, setPermissions) import System.FilePath ((</>))  data Builder-  = CabalBuilder+  = CabalBuilder {inNixDevelopment :: Bool}   | StackBuilder   | NixBuilder   deriving (Generic, Show, Ord, Eq)@@ -33,7 +39,8 @@   parseJSON _ = fail "Invalid builder. Expected 'cabal', 'stack', or 'nix'."  instance Parse Builder where-  parse "cabal" = pure CabalBuilder+  parse "cabal" = pure CabalBuilder {inNixDevelopment = False}+  parse "nix/cabal" = pure CabalBuilder {inNixDevelopment = True}   parse "stack" = pure StackBuilder   parse "nix" = pure NixBuilder   parse _ = fail "Invalid builder. Expected 'cabal', 'stack', or 'nix'."@@ -42,34 +49,19 @@   toJSON = String . format  instance Format Builder where-  format CabalBuilder = "cabal"+  format (CabalBuilder False) = "cabal"+  format (CabalBuilder True) = "nix/cabal"   format StackBuilder = "stack"   format NixBuilder = "nix" -buildBinary :: (MonadError Issue m, MonadIO m) => Builder -> PkgName -> FilePath -> [Text] -> m ()-buildBinary builder pkgName dirPath args = do-  (success, buildOut) <- command-  unless success $ throwError (fromString $ "Build failed: " <> buildOut)-  when (builder == NixBuilder) (extractNixArtifact pkgName dirPath)-  where-    command = case builder of-      StackBuilder ->-        exec "stack" $ ["install", format pkgName, "--local-bin-path", format dirPath] <> args-      CabalBuilder ->-        exec "cabal"-          $ [ "install",-              format pkgName,-              "--install-method=copy",-              "--installdir",-              format dirPath,-              "--overwrite-policy=always"-            ]-          <> args-      NixBuilder ->-        -- WARNING: We DO NOT append 'args' here.-        -- Nix does not accept '--ghc-options' via CLI; it must be set in the flake.-        exec "nix" ["build", ".#" <> format pkgName, "-o", format (dirPath </> "result")]+data Cmd = ExecCmd Text [Text] EnvVars | CusomCmd Text+  deriving (Eq, Show) +comandLabel :: BuilderCommand -> Text+comandLabel Build {} = "build"+comandLabel Test {} = "test"+comandLabel Install {} = "build"+ extractNixArtifact :: (MonadIO m, MonadError Issue m) => PkgName -> FilePath -> m () extractNixArtifact pkgName distDir = do   let resultLink = distDir </> "result"@@ -103,14 +95,110 @@         setPermissions finalDest properPerms       -- Cleanup: Remove the 'result' symlink to keep the folder clean       liftIO $ removeFile resultLink-    Nothing ->-      throwError-        $ fromString-        $ "Nix build succeeded, but binary '"-        <> pkgStr-        <> "' not found inside the Nix store path.\n"+    Nothing -> throwError $ fromString $ "Nix build succeeded, but binary '" <> pkgStr <> "' not found inside the Nix store path.\n" +extractGlobalNixArtifacts :: (MonadIO m, MonadError Issue m) => FilePath -> m ()+extractGlobalNixArtifacts distDir = do+  let resultLink = distDir </> "result-global"+      binDir = resultLink </> "bin"++  isLink <- liftIO $ doesPathExist resultLink+  unless isLink $ throwError "Nix global build failed to produce a result symlink."++  hasBin <- liftIO $ doesPathExist binDir+  if hasBin+    then do+      -- Copy everything inside result-global/bin/+      files <- liftIO $ listDirectory binDir+      for_ files $ \file -> do+        let sourcePath = binDir </> file+        let destPath = distDir </> file+        liftIO $ copyFile sourcePath destPath+    -- (Apply the same executable permissions here as before)+    else+      -- Fallback if the default package is just a single binary at the root+      throwError "Global Nix install succeeded, but no 'bin/' directory was found in the output."++  -- Clean up the symlink+  liftIO $ removePathForcibly resultLink+ findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a) findM _ [] = pure Nothing-findM p (x : xs) = do-  ifM (p x) (pure $ Just x) (findM p xs)+findM p (x : xs) = ifM (p x) (pure $ Just x) (findM p xs)++data TargetScope+  = ScopeGlobal -- User typed: hwm build (Build everything)+  | ScopePkgs [Pkg] -- User typed: hwm build -w=libs/... (Build these)+  deriving (Eq, Show)++data BuilderCommand+  = Build+  | Test+  | Install {dirPath :: FilePath}+  deriving (Eq, Show)++data BuildFlag+  = CustomBuildFlag Text+  | BuildFastFlag+  | GHCOptionsFlag Text+  deriving (Eq, Show)++formatFlag :: Builder -> BuildFlag -> [Text]+-- WARNING: Nix does not accept '--ghc-options' via CLI; it must be set in the flake.+formatFlag NixBuilder _ = []+formatFlag CabalBuilder {} BuildFastFlag = ["--disable-optimization"]+formatFlag StackBuilder BuildFastFlag = ["--fast"]+formatFlag _ (GHCOptionsFlag xs) = ["--ghc-options=" <> xs]+formatFlag _ (CustomBuildFlag txt) = [txt]++toExec :: (MonadIO m, MonadError Issue m) => Name -> Builder -> BuilderCommand -> TargetScope -> [BuildFlag] -> [(String, String)] -> m (Exec m)+toExec envName builder cmd scope flags envs = do+  Exec {..} <- toAction (Env envName) builder cmd scope+  pure $ inNixDevelop envName nixEnabled $ Exec execCmd (execArgs <> concatMap (formatFlag builder) flags) envs postCommand+  where+    nixEnabled = CabalBuilder {inNixDevelopment = True} == builder++toNixEnv :: Text -> Text+toNixEnv name = ".#" <> toCamelCase name++inNixDevelop :: Name -> Bool -> Exec m -> Exec m+inNixDevelop envName True (Exec cmd ops env post) = Exec "nix" (["develop", toNixEnv envName, "--command", cmd] <> ops) env post+inNixDevelop _ False e = e++nixScope :: (Format p) => p -> TargetScope -> [Text]+nixScope envName ScopeGlobal =+  let envSuffix = toCamelCase (format envName)+   in [".#env-" <> envSuffix <> "-all"]+nixScope envName (ScopePkgs pkgs) =+  let envSuffix = toCamelCase (format envName)+   in map (\pkg -> ".#" <> format (pkgName pkg) <> "-" <> envSuffix) pkgs++handleScope :: Bool -> TargetScope -> [Text]+handleScope isCabal ScopeGlobal = ["all" | isCabal]+handleScope _ (ScopePkgs pkgs) = map (format . pkgName) pkgs++mkStack :: (Applicative m) => Text -> TargetScope -> [Text] -> m (Exec m)+mkStack cmd scope ops = mkExec "stack" ([cmd] <> handleScope False scope <> ops)++mkCabal :: (Applicative m) => Text -> TargetScope -> [Text] -> m (Exec m)+mkCabal cmd scope ops = mkExec "cabal" ([cmd] <> handleScope True scope <> ops)++newtype Env = Env {envName :: Name}++toAction :: (MonadError Issue m, MonadIO m) => Env -> Builder -> BuilderCommand -> TargetScope -> m (Exec m)+-- Stack+toAction _ StackBuilder Build scope = mkStack "build" scope []+toAction _ StackBuilder Install {..} scope = mkStack "install" scope ["--local-bin-path", format dirPath]+toAction _ StackBuilder Test scope = mkStack "test" scope []+-- Cabal+toAction _ CabalBuilder {} Install {..} scope = mkCabal "install" scope ["--install-method=copy", "--installdir", format dirPath, "--overwrite-policy=always"]+toAction _ CabalBuilder {} Build scope = mkCabal "build" scope []+toAction _ CabalBuilder {} Test scope = mkCabal "test" scope []+-- Nix+toAction ctx NixBuilder Build scope = mkExec "nix" $ ["build", "--no-link"] <> nixScope (envName ctx) scope+toAction ctx NixBuilder Test scope = mkExec "nix" $ ["build", "--no-link"] <> nixScope (envName ctx) scope+toAction _ NixBuilder Install {..} scope =+  case scope of+    ScopeGlobal -> pure $ Exec "nix" ["build", ".#", "-o", format (dirPath </> "result-global")] [] (Just $ extractGlobalNixArtifacts dirPath)+    ScopePkgs [pkg] -> pure $ Exec "nix" ["build", ".#" <> format (pkgName pkg), "-o", format (dirPath </> "result")] [] (Just $ extractNixArtifact (pkgName pkg) dirPath)+    ScopePkgs _ -> throwError "Multiple package install is not supported with Nix builder."

@@ -12,10 +12,11 @@   ( Config (..),     getRegistryBounds,     defaultScripts,+    getScript,   ) where -import Control.Monad.Except (MonadError)+import Control.Monad.Except (MonadError (..)) import Data.Aeson (FromJSON (..), ToJSON (toJSON), genericParseJSON, genericToJSON) import qualified Data.Map as Map import HWM.Core.Common (Check (..), Name)@@ -84,8 +85,10 @@ defaultScripts :: Map Name Text defaultScripts =   Map.fromList-    [ ("build", "stack build --fast"),-      ("test", "stack test {TARGET} --fast"),-      ("install", "stack install"),-      ("lint", "curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .")-    ]+    [("lint", "curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .")]++getScript :: (MonadError e f, IsString e) => Name -> Config -> f Text+getScript name cfg =+  case cfgScripts cfg >>= Map.lookup name of+    Just script -> pure script+    Nothing -> throwError $ fromString $ toString $ "Script not found: " <> name

@@ -135,7 +135,7 @@ runConfigT :: ConfigT () -> Options -> IO () runConfigT m opts@Options {..} = do   config <- resolveResultTSilent (readYaml optionsHwm)-  cache <- loadCache (envDefault (cfgEnvironments config))+  cache <- loadCache (envsDefault (cfgEnvironments config))   fileSignature <- getFileSignature optionsHwm   let currentSignature = environmentHash (cfgEnvironments config)   pkgs <- resolveResultTSilent (pkgRegistry (cfgWorkspace config))

@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Domain.Dispatcher+  ( dispatchForEach,+    dispatch,+    DispatcheCommand (..),+  )+where++import Data.List (intersect, (\\))+import HWM.Core.Formatting (Color (..), Format (..), andMore, chalk, indentBlockNum, padDots)+import HWM.Core.Options (isCI)+import HWM.Core.Pkg (Pkg (..))+import HWM.Domain.Build (BuildFlag (..), Builder (..), BuilderCommand (..), TargetScope (..), comandLabel, toExec)+import HWM.Domain.ConfigT (ConfigT)+import HWM.Domain.Environments (BuildEnvironment (..))+import HWM.Domain.Workspace (printPkgWSRef)+import HWM.Integrations.Toolchain.Cabal (setupCabalMatrixEnvironment)+import HWM.Integrations.Toolchain.Stack (setupStackMatrixEnvironment)+import HWM.Runtime.Process (EnvVars, ExecOptions (..), execInBackground)+import HWM.Runtime.UI (MonadUI (..), minRowSize, sectionEnvironments, section_, uiRow)+import Relude++data DispatcheCommand = DispatcheCommand+  { builderCommand :: BuilderCommand,+    scope :: TargetScope,+    commandFlags :: [BuildFlag]+  }++setupEnvironment :: BuildEnvironment -> ConfigT EnvVars+setupEnvironment env =+  case buildBuilder env of+    StackBuilder -> setupStackMatrixEnvironment env+    CabalBuilder {} -> setupCabalMatrixEnvironment env+    NixBuilder -> pure mempty++dispatch :: DispatcheCommand -> BuildEnvironment -> ConfigT ()+dispatch (DispatcheCommand cmd tscope flags) env@BuildEnvironment {..} = do+  envs <- setupEnvironment env+  scope <- excludePackages buildPkgs tscope+  exec <- toExec buildName buildBuilder cmd scope flags envs+  ci <- isCI+  ind <- uiIndentLevel+  execInBackground+    exec+    ExecOptions+      { envName = buildName,+        formatFX = \path icon -> indentBlockNum ind (padDots minRowSize (comandLabel cmd) <> icon <> chalk Dim (" logs: " <> path)),+        fxEnabled = not ci+      }++excludePackages :: [Pkg] -> TargetScope -> ConfigT TargetScope+excludePackages _ ScopeGlobal = pure ScopeGlobal+excludePackages supported (ScopePkgs pkgs) = do+  case pkgs \\ supported of+    [] -> pure ()+    (pkg : xs) -> uiRow minRowSize "excluded" (chalk Dim (andMore (printPkgWSRef pkg) (map printPkgWSRef xs)))+  pure $ ScopePkgs (pkgs `intersect` supported)++dispatchForEach :: (Foldable t) => DispatcheCommand -> t BuildEnvironment -> ConfigT ()+dispatchForEach dcmd envs = sectionEnvironments Nothing+  $ for_ envs+  $ \env -> section_ (format env) $ dispatch dcmd env

@@ -10,8 +10,8 @@ {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Domain.Environments-  ( Enviroment (..),-    Environments (..),+  ( Environments (..),+    EnviromentProfile (..),     BuildEnvironment (..),     StackEnvironment (..),     getBuildEnvironments,@@ -20,11 +20,15 @@     printEnvironments,     getTestedRange,     removeEnvironmentByName,-    newEnv,     existsEnviroment,     environmentHash,     NixEnvironment (..),     Feature (..),+    selectEnvironments,+    overrideBuilder,+    mkEnvironments,+    mkEnvironment,+    addProfile,   ) where @@ -56,34 +60,53 @@ type Extras = VersionMap  data Environments = Environments-  { envBuilder :: Maybe Builder,-    envDefault :: Name,-    envNix :: Maybe Bool,-    envStack :: Maybe Bool,-    envProfiles :: Map Name Enviroment+  { envsDefault :: Name,+    envsProfiles :: Map Name EnviromentProfile,+    envsBuilder :: Maybe Builder,+    -- generators,+    envsNix :: Maybe Bool,+    envsStack :: Maybe Bool,+    envsHie :: Maybe Bool   }   deriving     ( Generic,       Show     ) -newEnv :: Version -> Enviroment-newEnv ghc =-  Enviroment-    { ghc = ghc,-      exclude = Nothing,-      stack = Nothing,-      nix = Nothing+addProfile :: Name -> EnviromentProfile -> Environments -> Environments+addProfile name profile envs = envs {envsProfiles = Map.insert name profile (envsProfiles envs)}++mkEnvironment :: Version -> EnviromentProfile+mkEnvironment ghc =+  EnviromentProfile+    { profileGhc = ghc,+      profileExclude = Nothing,+      profileStack = Nothing,+      profileNix = Nothing,+      profileBuilder = Nothing,+      profileHie = Nothing     } +mkEnvironments :: Version -> Environments+mkEnvironments ghc =+  let defaultEnv = ("default", mkEnvironment ghc)+   in Environments+        { envsDefault = fst defaultEnv,+          envsProfiles = Map.fromList [defaultEnv],+          envsStack = Nothing,+          envsNix = Nothing,+          envsBuilder = Nothing,+          envsHie = Nothing+        }+ environmentHash :: Environments -> Signature environmentHash Environments {..} =-  genSignature $ Set.toList $ Set.fromList $ map toSig $ concatMap Map.toList $ mapMaybe (extraDeps <=< unfeature <=< stack) (toList envProfiles)+  genSignature $ Set.toList $ Set.fromList $ map toSig $ concatMap Map.toList $ mapMaybe (extraDeps <=< unfeature <=< profileStack) (toList envsProfiles)   where     toSig (pkg, v) = format pkg <> "-" <> format v  prefix :: String-prefix = "env"+prefix = "envs"  instance FromJSON Environments where   parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced prefix)@@ -104,15 +127,15 @@   where   check Environments {..} = do     fileSig <- askEnv-    traverse_ (checkTarget fileSig) envProfiles+    traverse_ (checkTarget fileSig) envsProfiles     where       signature = environmentHash Environments {..}-      checkTarget fileSig Enviroment {..}+      checkTarget fileSig EnviromentProfile {..}         | fileSig == signature = checkExclude         -- checking all hkgRefs is expensive, so we skip it if the signature matches-        | otherwise = sequence_ [traverse_ check (maybe [] hkgRefs (extraDeps =<< unfeature =<< stack)), checkExclude]+        | otherwise = sequence_ [traverse_ check (maybe [] hkgRefs (extraDeps =<< unfeature =<< profileStack)), checkExclude]         where-          checkExclude = checkWorkspaceRefs (fromMaybe [] exclude)+          checkExclude = checkWorkspaceRefs (fromMaybe [] profileExclude)  data Feature a = Enabled a | Disabled deriving (Generic, Show, Ord, Eq) @@ -146,11 +169,13 @@   parseJSON (Object _) = pure NixEnvironment   parseJSON _ = fail "Invalid Nix environment configuration. Expected an object or a boolean." -data Enviroment = Enviroment-  { ghc :: Version,-    exclude :: Maybe [WorkspaceRef],-    stack :: Maybe (Feature StackEnvironment),-    nix :: Maybe (Feature NixEnvironment)+data EnviromentProfile = EnviromentProfile+  { profileGhc :: Version,+    profileExclude :: Maybe [WorkspaceRef],+    profileStack :: Maybe (Feature StackEnvironment),+    profileNix :: Maybe (Feature NixEnvironment),+    profileBuilder :: Maybe Builder,+    profileHie :: Maybe Bool   }   deriving     ( Generic,@@ -159,12 +184,15 @@       Eq     ) -instance FromJSON Enviroment where-  parseJSON = genericParseJSON aesonYAMLOptions+profilePrefix :: String+profilePrefix = "profile" -instance ToJSON Enviroment where-  toJSON = genericToJSON aesonYAMLOptions+instance FromJSON EnviromentProfile where+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced profilePrefix) +instance ToJSON EnviromentProfile where+  toJSON = genericToJSON (aesonYAMLOptionsAdvanced profilePrefix)+ data StackEnvironment = StackEnvironment   { resolver :: Maybe Name,     extraDeps :: Maybe Extras,@@ -185,9 +213,10 @@     buildExtraDeps :: Maybe Extras,     buildResolver :: Name,     buildAllowNewer :: Maybe Bool,-    buildStack :: Bool,+    buildBuilder :: Builder,     buildNix :: Bool,-    buildBuilder :: Builder+    buildStack :: Bool,+    buildHie :: Bool   }   deriving     ( Generic,@@ -196,6 +225,9 @@       Eq     ) +overrideBuilder :: Builder -> BuildEnvironment -> BuildEnvironment+overrideBuilder builder env = env {buildBuilder = builder}+ instance Format BuildEnvironment where   format BuildEnvironment {..} = buildName <> " (" <> format buildGHC <> ")" @@ -209,24 +241,25 @@   m [BuildEnvironment] getBuildEnvironments = do   globalEnv <- askEnv-  envs <- envProfiles <$> askEnv+  envs <- envsProfiles <$> askEnv   for (Map.toList envs) $ \(name, env) -> do     pkgs <- allPackages     pure       BuildEnvironment         { buildPkgs = excludePkgs env pkgs,           buildName = name,-          buildExtraDeps = extraDeps =<< unfeature =<< stack env,-          buildResolver = fromMaybe (eraStackageResolverName $ selectEra (ghc env)) (resolver =<< unfeature =<< stack env),-          buildGHC = ghc env,-          buildAllowNewer = stack env >>= unfeature >>= allowNewer,-          buildStack = isEnabled (envStack globalEnv) (stack env),-          buildNix = isEnabled (envNix globalEnv) (nix env),-          buildBuilder = fromMaybe CabalBuilder (envBuilder globalEnv)+          buildExtraDeps = extraDeps =<< unfeature =<< profileStack env,+          buildResolver = fromMaybe (eraStackageResolverName $ selectEra (profileGhc env)) (resolver =<< unfeature =<< profileStack env),+          buildGHC = profileGhc env,+          buildAllowNewer = profileStack env >>= unfeature >>= allowNewer,+          buildBuilder = fromMaybe (CabalBuilder False) (profileBuilder env <|> envsBuilder globalEnv),+          buildStack = isEnabled (envsStack globalEnv) (profileStack env),+          buildNix = isEnabled (envsNix globalEnv) (profileNix env),+          buildHie = fromMaybe True (profileHie env <|> envsHie globalEnv)         }   where     excludePkgs build pkgs =-      let excluseion = fromMaybe [] (exclude build)+      let excluseion = fromMaybe [] (profileExclude build)        in filter (not . (\pkg -> any (`isMember` pkg) excluseion)) pkgs  getBuildEnvironment ::@@ -241,7 +274,7 @@   m BuildEnvironment getBuildEnvironment inputName = do   envs <- getBuildEnvironments-  defaultname <- envDefault <$> askEnv+  defaultname <- envsDefault <$> askEnv   case inputName of     Just name -> matchEnv envs name (select envs name)     Nothing -> do@@ -284,13 +317,13 @@  existsEnviroment :: (MonadReader env m, Has env Environments) => Name -> m Bool existsEnviroment n = do-  envs <- envProfiles <$> askEnv+  envs <- envsProfiles <$> askEnv   pure $ isJust $ Map.lookup n envs  printEnvironments :: (Monad m, MonadUI m, MonadReader env m, Has env Workspace, Has env Environments, MonadIO m, MonadError Issue m, Has env Cache) => Maybe Name -> m () printEnvironments name = do   active <- getBuildEnvironment name-  def <- envDefault <$> askEnv+  def <- envsDefault <$> askEnv   environments <- getBuildEnvironments   sectionEnvironments (Just $ format def) $ forTable_ environments $ \env ->     ( format env,@@ -310,4 +343,9 @@ -- | Remove an environment from the matrix by name removeEnvironmentByName :: Name -> Environments -> Environments removeEnvironmentByName envName matrix =-  matrix {envProfiles = Map.delete envName (envProfiles matrix)}+  matrix {envsProfiles = Map.delete envName (envsProfiles matrix)}++selectEnvironments :: (MonadError Issue m, MonadIO m, MonadReader env m, Has env Workspace, Has env Environments, Has env Cache) => [Name] -> m [BuildEnvironment]+selectEnvironments ["all"] = getBuildEnvironments+selectEnvironments [] = getBuildEnvironment Nothing >>= \env -> pure [env]+selectEnvironments names = for names (getBuildEnvironment . Just)

@@ -45,12 +45,12 @@ import qualified Data.Set as S import qualified Data.Text as T import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (..), StatusM, availableOptions, chalk, commonPrefix, displayStatusM, genMaxLen, padDots, slugify, subPathSign)+import HWM.Core.Formatting (StatusM, availableOptions, commonPrefix, displayStatusM, genMaxLen, slugify) import HWM.Core.Has (Has (..), askEnv) import HWM.Core.Pkg (Pkg (..), PkgName (..), makePkg) import HWM.Core.Result import HWM.Runtime.Files (cleanRelativePath)-import HWM.Runtime.UI (MonadUI, putLine, sectionWorkspace)+import HWM.Runtime.UI (MonadUI, sectionWorkspace, uiLabel, uiSpace, uiSubPathRow) import Relude  type Workspace = Map Name WorkGroup@@ -197,23 +197,23 @@   sectionWorkspace     $ for_ gs     $ \(name, wg) -> do-      putLine ""-      putLine $ "• " <> chalk Bold name+      uiSpace+      uiLabel name       pkgs <- memberPkgs (name, wg)       let maxLen = genMaxLen (map pkgMemberId pkgs)       for_ pkgs $ \pkg -> do         status <- displayStatusM (f pkg)-        putLine $ subPathSign <> padDots maxLen (pkgMemberId pkg) <> status+        uiSubPathRow maxLen (pkgMemberId pkg) status  forWorkspaceTuple :: (MonadUI m) => [(Text, [Pkg])] -> (Pkg -> StatusM m) -> m () forWorkspaceTuple ws f = sectionWorkspace $ do   let maxLen = genMaxLen (map pkgMemberId $ concatMap snd ws)   for_ ws $ \(name, pkgs) -> do-    putLine ""-    putLine $ "• " <> chalk Bold name+    uiSpace+    uiLabel name     for_ pkgs $ \pkg -> do       status <- displayStatusM (f pkg)-      putLine (subPathSign <> padDots maxLen (pkgMemberId pkg) <> status)+      uiSubPathRow maxLen (pkgMemberId pkg) status  addWorkgroupMember :: (MonadIO m, MonadUI m, MonadIssue m, MonadError Issue m, MonadReader env m, Has env Workspace) => Name -> Name -> m (Workspace, WorkGroup) addWorkgroupMember name memberId = do

@@ -14,6 +14,7 @@     newCabalPackage,     readCabalPackage,     nativeSdist,+    setupCabalMatrixEnvironment,   ) where @@ -45,15 +46,17 @@ import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (..), Status (..)) import HWM.Core.Options (Options (..))-import HWM.Core.Pkg (IsPkg (..), PackageIO, Pkg (Pkg, hpackFile), PkgName)+import HWM.Core.Pkg (IsPkg (..), PackageIO, Pkg (..), PkgName) import qualified HWM.Core.Pkg as P import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (..)) import HWM.Core.Version (Version, toCabalVersion)+import HWM.Domain.Build (Builder (CabalBuilder, NixBuilder)) import HWM.Domain.ConfigT (ConfigT) import qualified HWM.Domain.ConfigT as CT import HWM.Domain.Dependencies (Dependencies (..), HasDependencies (..), MapDeps (..), mkCabalDependency, toDependencyList) import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment) import HWM.Runtime.Files (syncFile)+import HWM.Runtime.Process (EnvVars) import Hpack (Force (..), Options (..), Result (..), defaultOptions, hpackResult, setProgramName, setTarget) import qualified Hpack as H import Hpack.Config (ProgramName (..))@@ -131,18 +134,28 @@     H.OutputUnchanged -> pure Checked     _ -> pure Updated -generateCabalProject :: [Pkg] -> Text -> Text-generateCabalProject packagePaths ghcVersion =+generateCabalProject :: Text -> BuildEnvironment -> Text+generateCabalProject prefix BuildEnvironment {..} =   T.unlines-    [ "with-compiler: ghc-" <> ghcVersion,-      "packages:\n" <> T.unlines (map (("  " <>) . format . P.pkgDirPath) packagePaths)-    ]+    $ ["with-compiler: ghc-" <> format buildGHC | not dependsOnNix]+    <> ("packages:" : map printPkg buildPkgs)+  where+    printPkg pkg = "  " <> prefix <> format (P.pkgDirPath pkg)+    dependsOnNix = buildBuilder == CabalBuilder True || buildBuilder == NixBuilder +setupCabalMatrixEnvironment :: BuildEnvironment -> ConfigT EnvVars+setupCabalMatrixEnvironment env = do+  matrixDir <- liftIO $ makeAbsolute ".hwm/matrix/"+  liftIO $ createDirectoryIfMissing True matrixDir+  let projectPath = matrixDir <> "cabal-" <> toString (buildName env) <> ".project"+  _ <- syncFile projectPath (generateCabalProject "../../" env)+  pure [("CABAL_PROJECT_FILE", projectPath)]+ syncCabalProject :: ConfigT Status syncCabalProject = do   cabalFilePath <- asks (optionsCabal . CT.options)-  BuildEnvironment {..} <- getBuildEnvironment Nothing-  syncFile cabalFilePath (generateCabalProject buildPkgs (toText buildGHC))+  env <- getBuildEnvironment Nothing+  syncFile cabalFilePath (generateCabalProject "" env)  data CabalPackage = CabalPackage   { cbDirectory :: FilePath,

@@ -1,6 +1,6 @@-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Integrations.Toolchain.Nix (syncNixFile) where@@ -10,10 +10,10 @@ import HWM.Core.Formatting (Status, format, toCamelCase) import HWM.Core.Options (Options (..)) import HWM.Core.Pkg (Pkg (..))-import HWM.Core.Version (Era (eraNixpkgs), Version, formatNixGhc, selectEra)+import HWM.Core.Version (Era (eraNixpkgs), formatNixGhc, selectEra) import HWM.Domain.Config (Config (Config, cfgName)) import HWM.Domain.ConfigT (ConfigT, Env (..))-import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment)+import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment, getBuildEnvironments) import HWM.Runtime.Files (syncFile) import Relude @@ -21,35 +21,41 @@ syncNixFile = do   Config {..} <- asks config   ops <- asks options-  BuildEnvironment {buildPkgs, buildGHC} <- getBuildEnvironment Nothing-  syncFile (optionsNix ops) (deriveFlakeNix cfgName buildGHC buildPkgs)+  benv <- getBuildEnvironment Nothing+  benvs <- filter buildNix <$> getBuildEnvironments+  syncFile (optionsNix ops) (deriveFlakeNix (cfgName, benv) (map (cfgName,) benvs)) -renderNixName :: Text -> Text-renderNixName name = toCamelCase name <> "WorkspacePackages"+renderName :: Context -> Text+renderName (name, BuildEnvironment {..}) = toCamelCase (name <> T.toTitle (format buildName) <> "WorkspacePackages") -pkgsNixName :: Text -> Text-pkgsNixName name = "pkgs." <> renderNixName name+pkgsNixName :: Context -> Text+pkgsNixName ctx = "pkgs." <> renderName ctx -generateOverlay :: Name -> Version -> [Pkg] -> [Text]-generateOverlay projectName ghc pkgs =-  [ "haskellOverlay = final: prev: {",-    "      " <> renderNixName projectName <> " = prev.haskell.packages." <> formatNixGhc ghc <> ".extend (hfinal: hprev: {"+type Context = (Name, BuildEnvironment)++generateOverlay :: [Context] -> [Text]+generateOverlay benvs =+  ["haskellOverlay = final: prev: {"]+    <> concatMap rendergOverlayItem benvs+    <> ["};"]++rendergOverlayItem :: Context -> [Text]+rendergOverlayItem ctx@(_, BuildEnvironment {..}) =+  [ "  " <> renderName ctx <> " = prev.haskell.packages." <> formatNixGhc buildGHC <> ".extend (hfinal: hprev: {"   ]-    <> map renderPackage pkgs-    <> [ "      });",-         "};"-       ]-  where-    renderPackage pkg =-      "        " <> format (pkgName pkg) <> " = hfinal.callCabal2nix \"" <> format (pkgName pkg) <> "\" ./" <> format (pkgDirPath pkg) <> " {};"+    <> map renderPackage buildPkgs+    <> ["  });"] -deriveFlakeNix :: Name -> Version -> [Pkg] -> Text-deriveFlakeNix projectName version pkgs =+renderPackage :: Pkg -> Text+renderPackage pkg = "    " <> format (pkgName pkg) <> " = hfinal.callCabal2nix \"" <> format (pkgName pkg) <> "\" ./" <> format (pkgDirPath pkg) <> " {};"++deriveFlakeNix :: Context -> [Context] -> Text+deriveFlakeNix ctx@(projectName, benv) ctxs =   T.unlines     $ braces       ( [ "description = \"A Haskell " <> projectName <> " workspace generated by HWM(Haskell Workspace Manager)\";",           "inputs = {",-          "  nixpkgs.url = \"github:NixOS/nixpkgs/" <> eraNixpkgs (selectEra version) <> "\";",+          "  nixpkgs.url = \"github:NixOS/nixpkgs/" <> eraNixpkgs (selectEra (buildGHC benv)) <> "\";",           "};",           "outputs = { self, nixpkgs }:"         ]@@ -57,10 +63,11 @@             ( [ "supportedSystems = [ \"x86_64-linux\" \"aarch64-linux\" \"x86_64-darwin\" \"aarch64-darwin\" ];",                 "forAllSystems = nixpkgs.lib.genAttrs supportedSystems;"               ]-                <> generateOverlay projectName version pkgs+                <> generateOverlay ctxs             )-            ( forAllSystems "packages" (generatePublicPackages projectName pkgs)-                <> forAllSystems "devShells" (generateDevShell projectName pkgs)+            ( forAllSystems "packages" (generatePublicPackages projectName benv (map snd ctxs))+                <> forAllSystems "devShells" (generateDevShell True ctx <> concatMap (generateDevShell False) ctxs)+                <> ["checks = forAllSystems (system: self.packages.${system});"]             )             False       )@@ -69,28 +76,52 @@ braces body =   ["{"] <> map ("  " <>) body <> ["}"] -generatePublicPackages :: Name -> [Pkg] -> [Text]-generatePublicPackages _ [] = []-generatePublicPackages projectName pkgs = map renderPublicPackage pkgs <> renderDefaultPackage+-- Notice the new signature: we pass the default environment, then all environments+generatePublicPackages :: Name -> BuildEnvironment -> [BuildEnvironment] -> [Text]+generatePublicPackages projectName defaultEnv allEnvs =+  defaultPkgAlias <> basePkgs <> matrixPkgs   where-    renderPublicPackage pkg = format (pkgName pkg) <> " = " <> pkgsNixName projectName <> "." <> format (pkgName pkg) <> ";"-    renderDefaultPackage =-      let defaultPkg = maybeToList $ find ((projectName ==) . format . pkgName) pkgs-       in map (\pkg -> "default = " <> pkgsNixName projectName <> "." <> format (pkgName pkg) <> ";") defaultPkg+    defaultOverlay = renderName (projectName, defaultEnv)+    defaultPkgAlias =+      let defaultPkg = filter ((projectName ==) . format . pkgName) (buildPkgs defaultEnv)+       in map (\pkg -> "default = pkgs." <> defaultOverlay <> "." <> format (pkgName pkg) <> ";") defaultPkg+    basePkgs =+      map (\pkg -> format (pkgName pkg) <> " = pkgs." <> defaultOverlay <> "." <> format (pkgName pkg) <> ";") (buildPkgs defaultEnv)+    matrixPkgs = concatMap (generateMatrixPkgs . (projectName,)) allEnvs -generateDevShell :: Name -> [Pkg] -> [Text]-generateDevShell _ [] = [] -- Handle empty workspace-generateDevShell projectName pkgs =-  [ "default = " <> pkgsNixName projectName <> ".shellFor {",-    "  packages = p: [ " <> renderPackageList pkgs <> " ];",-    "  buildInputs = with " <> pkgsNixName projectName <> "; [",-    "    cabal-install",-    "    haskell-language-server",-    "    hlint",-    "  ];",-    "};"+individualPkg :: Text -> Text -> Pkg -> Text+individualPkg overlay envName pkg = format (pkgName pkg) <> "-" <> envName <> " = pkgs." <> overlay <> "." <> format (pkgName pkg) <> ";"++generateMatrixPkgs :: (Name, BuildEnvironment) -> [Text]+generateMatrixPkgs (projectName, env) =+  let overlay = renderName (projectName, env)+      envRaw = format (buildName env)+      envName = toCamelCase envRaw+      pathList = map (\pkg -> "    pkgs." <> overlay <> "." <> format (pkgName pkg)) (buildPkgs env)+   in map (individualPkg overlay envName) (buildPkgs env)+        <> [ "env-" <> envName <> "-all = pkgs.symlinkJoin {",+             "  name = \"" <> envRaw <> "-workspace\";",+             "  paths = [ "+           ]+        <> pathList+        <> [ " ];",+             "};"+           ]++generateDevShell :: Bool -> Context -> [Text]+generateDevShell _ (_, BuildEnvironment {buildPkgs = []}) = [] -- Handle empty workspace+generateDevShell isDefault (projectName, benv@BuildEnvironment {..}) =+  [ name <> " = " <> pkgsNixName (projectName, benv) <> ".shellFor {",+    "  packages = p: [ " <> renderPackageList buildPkgs <> " ];",+    "  buildInputs = with " <> pkgsNixName (projectName, benv) <> "; ["   ]+    <> map ("    " <>) libs+    <> [ "  ];",+         "};"+       ]   where+    name = if isDefault then "default" else toCamelCase (format buildName)+    libs = ["cabal-install", "hlint"] <> ["stack" | buildStack] <> ["haskell-language-server" | buildHie]     renderPackageList = T.intercalate " " . map (\pkg -> "p." <> format (pkgName pkg))  letBlock :: [Text] -> [Text] -> Bool -> [Text]

@@ -9,9 +9,7 @@ module HWM.Integrations.Toolchain.Stack   ( Stack (..),     syncStackYaml,-    createEnvYaml,-    stackPath,-    parseExtraDeps,+    setupStackMatrixEnvironment,     scanStackFiles,     buildMatrix,   )@@ -35,10 +33,11 @@ import HWM.Core.Version (Version, latestGHCVersion, parseGHCVersion) import HWM.Domain.Build (Builder (StackBuilder)) import HWM.Domain.ConfigT (ConfigT)-import HWM.Domain.Environments (BuildEnvironment (..), Enviroment (..), Environments (..), Feature (..), StackEnvironment (..), getBuildEnvironment, hkgRefs)+import HWM.Domain.Environments (BuildEnvironment (..), EnviromentProfile (..), Environments (..), Feature (..), StackEnvironment (..), getBuildEnvironment, hkgRefs, mkEnvironment, mkEnvironments) import HWM.Domain.Workspace (toWorkspaceRef) import HWM.Runtime.Cache (getSnapshotGHC) import HWM.Runtime.Files (aesonYAMLOptions, readYaml, rewrite_)+import HWM.Runtime.Process (EnvVars) import Relude hiding (head, tail) import System.Directory (createDirectoryIfMissing, doesFileExist, makeAbsolute) import System.FilePath (dropExtension, (</>))@@ -98,18 +97,24 @@           ..         } -stackPath :: Maybe Name -> ConfigT FilePath-stackPath (Just name) = liftIO $ makeAbsolute $ ".hwm/matrix/stack-" <> toString name <> ".yaml"-stackPath Nothing = do-  options <- askOptions-  liftIO $ makeAbsolute $ optionsStack options+setupStackMatrixEnvironment :: BuildEnvironment -> ConfigT EnvVars+setupStackMatrixEnvironment env = do+  genStackMatrixConfig env+  getStackMatrixEnvVars (buildName env) -createEnvYaml :: Name -> ConfigT ()-createEnvYaml target = do-  path <- stackPath (Just target)+getStackMatrixEnvVars :: Name -> ConfigT EnvVars+getStackMatrixEnvVars envName = do+  yamlPath <- stackMatrixPath envName+  pure [("STACK_YAML", yamlPath)]++stackMatrixPath :: Name -> ConfigT FilePath+stackMatrixPath name = liftIO $ makeAbsolute $ ".hwm/matrix/stack-" <> toString name <> ".yaml"++genStackMatrixConfig :: BuildEnvironment -> ConfigT ()+genStackMatrixConfig BuildEnvironment {..} = do+  path <- stackMatrixPath buildName   liftIO $ createDirectoryIfMissing True ".hwm/matrix/"   _ <- rewrite_ path $ const $ do-    BuildEnvironment {..} <- getBuildEnvironment Nothing     pure       Stack         { saveHackageCreds = Just False,@@ -139,28 +144,19 @@  buildMatrix :: (MonadIO m, MonadError Issue m) => [Pkg] -> [(Name, Stack)] -> m Environments buildMatrix pkgs (defaultEnv : envs) = do-  environments <- sortOn (ghc . snd) <$> traverse (inferBuildEnv pkgs) (defaultEnv : envs)-  pure Environments {envDefault = fst defaultEnv, envProfiles = Map.fromList environments, envStack = Just True, envNix = Nothing, envBuilder = Just StackBuilder}-buildMatrix _ [] = do-  let defaultEnv = mkDefaultEnv-  pure Environments {envDefault = fst defaultEnv, envProfiles = Map.fromList [defaultEnv], envStack = Nothing, envNix = Nothing, envBuilder = Nothing}--mkDefaultEnv :: (Name, Enviroment)-mkDefaultEnv =-  ( "default",-    Enviroment-      { stack = Nothing,-        exclude = Nothing,-        ghc = latestGHCVersion,-        nix = Nothing,-        ..-      }-  )+  environments <- sortOn (profileGhc . snd) <$> traverse (inferBuildEnv pkgs) (defaultEnv : envs)+  pure Environments {envsDefault = fst defaultEnv, envsProfiles = Map.fromList environments, envsStack = Just True, envsNix = Nothing, envsBuilder = Just StackBuilder, envsHie = Nothing}+buildMatrix _ [] = pure $ mkEnvironments latestGHCVersion -inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m (Name, Enviroment)+inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m (Name, EnviromentProfile) inferBuildEnv allPkgs (name, Stack {extraDeps = deps, ..}) = do   ghc <- maybe (getSnapshotGHC resolver) (fromEither "GHC Parsing" . parseGHCVersion) compiler   extraDeps <- parseExtraDeps (fromMaybe [] deps)   let excludeList = filter ((`notElem` packages) . pkgDirPath) allPkgs-      exclude = if null excludeList then Nothing else Just (map toWorkspaceRef excludeList)-  pure (name, Enviroment {stack = Just (Enabled StackEnvironment {resolver = Just resolver, ..}), nix = Nothing, ..})+  pure+    ( name,+      (mkEnvironment ghc)+        { profileStack = Just (Enabled StackEnvironment {resolver = Just resolver, ..}),+          profileExclude = if null excludeList then Nothing else Just (map toWorkspaceRef excludeList)+        }+    )

@@ -20,6 +20,8 @@     prepareDir,     syncFile,     rewriteMaybe_,+    getLocalBinDir,+    warnBindDir,   ) where @@ -46,10 +48,10 @@ import Data.Yaml (decodeThrow) import Data.Yaml.Pretty (defConfig, encodePretty, setConfCompare, setConfDropNull) import HWM.Core.Formatting (Format (..), Status (..))-import HWM.Core.Result (Issue)+import HWM.Core.Result (Issue, MonadIssue (injectIssue)) import Relude hiding (readFile, writeFile)-import System.Directory (createDirectoryIfMissing, doesFileExist)-import System.FilePath (joinPath, splitDirectories)+import System.Directory (createDirectoryIfMissing, doesFileExist, getHomeDirectory)+import System.FilePath (dropTrailingPathSeparator, joinPath, splitDirectories, splitSearchPath, (</>))  data Signature = Signed Text | Unsigned   deriving (Ord, Show)@@ -265,3 +267,17 @@   if old == Just newFile     then pure Checked     else liftIO $ TIO.writeFile path newFile $> Updated++getLocalBinDir :: (MonadIssue m, MonadIO m) => m FilePath+getLocalBinDir = do+  home <- liftIO getHomeDirectory+  let dir = home </> ".local" </> "bin"+  liftIO $ createDirectoryIfMissing True dir+  pure dir++warnBindDir :: (MonadIssue m, MonadIO m) => FilePath -> m ()+warnBindDir dir = do+  pathStr <- concatMap splitSearchPath . maybeToList <$> liftIO (lookupEnv "PATH")+  let pathDirs = map dropTrailingPathSeparator pathStr+  unless (dropTrailingPathSeparator dir `elem` pathDirs) $ do+    injectIssue (fromString $ "Directory " <> dir <> " is not on your $PATH. Executables installed here will not be globally available.")

@@ -2,17 +2,19 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -module HWM.Runtime.Logging (logIssue, debug) where+module HWM.Runtime.Logging (logRoot, logCommandStart, logCommandEnd, debug, logPath, rotateLogs, genLogId) where -import Data.Time (getCurrentTime)+import Data.List (isSuffixOf)+import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (Cyan), chalk)-import HWM.Core.Options (whenCI, whenDebug)-import HWM.Core.Result (Severity)-import HWM.Runtime.Files (prepareDir)+import HWM.Core.Formatting (Color (Cyan), Format (..), chalk, slugifyList)+import HWM.Core.Options (whenDebug) import HWM.Runtime.UI (MonadUI, putLine) import Relude+import System.Directory (createDirectoryIfMissing, listDirectory, removeFile)+import System.FilePath ((</>)) import qualified System.IO as TIO+import System.Process.Typed (ExitCode (..))  logRoot :: FilePath logRoot = ".hwm/logs"@@ -20,19 +22,50 @@ logPath :: Name -> FilePath logPath name = logRoot <> "/" <> toString name <> ".log" -logIssue :: (MonadIO m, MonadUI m) => Name -> Severity -> [(Text, Text)] -> Text -> m FilePath-logIssue name severity table content = do-  prepareDir logRoot+logCommandStart :: TIO.Handle -> Text -> IO ()+logCommandStart logHandle cmd =+  writeLogEntry logHandle [("EVENT", "COMMAND_START"), ("COMMAND", cmd)]++logCommandEnd :: TIO.Handle -> ExitCode -> IO ()+logCommandEnd logHandle code =+  writeLogEntry logHandle [("EVENT", "COMMAND_END"), ("EXIT_CODE", exitCodeSummary code)]++debug :: (MonadIO m, MonadUI m) => Text -> m ()+debug msg = whenDebug $ putLine $ chalk Cyan "[DEBUG] " <> msg++writeLogEntry :: TIO.Handle -> [(Text, Text)] -> IO ()+writeLogEntry logHandle table = do   timestamp <- liftIO getCurrentTime-  let logInfo = [("TIMESTAMP", show timestamp), ("SEVERITY", show severity)]-  let path = logPath name+  TIO.hPutStr logHandle (toString (formatLogEntry (table <> [("TIMESTAMP", show timestamp)])))+  TIO.hFlush logHandle++formatLogEntry :: [(Text, Text)] -> Text+formatLogEntry table =   let boxTop = "┌──────────────────────────────────────────────────────────"       boxBottom = "└──────────────────────────────────────────────────────────"-      rows = map (\(k, v) -> "│ " <> k <> ": " <> v) (table <> logInfo)-      header = unlines (boxTop : rows <> [boxBottom, "", content, ""])-  liftIO $ TIO.appendFile path (toString header)-  whenCI $ putLine content-  pure path+      rows = map (\(k, v) -> "│ " <> k <> ": " <> v) table+   in unlines (boxTop : rows <> [boxBottom, ""]) -debug :: (MonadIO m, MonadUI m) => Text -> m ()-debug msg = whenDebug $ putLine $ chalk Cyan "[DEBUG] " <> msg+exitCodeSummary :: ExitCode -> Text+exitCodeSummary ExitSuccess = "0"+exitCodeSummary (ExitFailure code) = show code++-- 1. Generate the Timestamp once per CLI run+genLogId :: (MonadIO m) => Text -> m Text+genLogId prefix = liftIO $ do+  timestamp <- formatTime defaultTimeLocale "%Y%m%d-%H%M%S" <$> getCurrentTime+  pure $ slugifyList [format timestamp, prefix]++-- 2. The Cleanup Function+rotateLogs :: (MonadIO m) => m ()+rotateLogs = liftIO $ do+  createDirectoryIfMissing True logRoot+  files <- listDirectory logRoot+  -- Only look at .log files, sort them alphabetically (oldest first)+  let logFiles = sort $ filter (\f -> ".log" `isSuffixOf` f) files++  -- If we have 8 files and want to keep 5, we drop the first 3 (the oldest ones)+  let filesToDelete = take (length logFiles - 12) logFiles++  forM_ filesToDelete $ \f ->+    removeFile (logRoot </> f)

@@ -70,7 +70,7 @@  getGHUploadUrl :: (MonadIO m, MonadError Issue m) => Config -> Text -> m Text getGHUploadUrl Config {..} tag = do-  gh <- maybe (throwError "GitHub repository not configured") pure cfgGithub+  gh <- maybe (throwError "GitHub repository not configured. Please set github field in hwm.yaml file") pure cfgGithub   token <- getGitHubToken   liftIO $ runReq defaultHttpConfig $ do     (url, opts) <- withURI ("https://api.github.com/repos/" <> gh <> "/releases/tags/" <> tag)

@@ -7,6 +7,7 @@     Platform (..),     detectPlatform,     platformFilePath,+    toNixSystem,   ) where @@ -74,3 +75,11 @@   "arm64" -> Arm64   "aarch64" -> Arm64 -- GHC uses aarch64 for Apple Silicon/Linux ARM   _ -> UnknownArch++toNixSystem :: Platform -> Text+toNixSystem (Platform Linux X64) = "x86_64-linux"+toNixSystem (Platform Linux Arm64) = "aarch64-linux"+toNixSystem (Platform MacOS X64) = "x86_64-darwin"+toNixSystem (Platform MacOS Arm64) = "aarch64-darwin"+toNixSystem (Platform Windows _) = "x86_64-windows" -- Note: Nix on Windows usually implies WSL, but this is the standard triple+toNixSystem _ = "unknown-system"

@@ -1,22 +1,50 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Runtime.Process-  ( silentRun,-    inheritRun,+  ( inheritRun,     exec,+    Exec (..),+    ExecOptions (..),+    EnvVars,+    execInBackground,+    mkExec,   ) where  import Control.Concurrent.Async+import Control.Monad.Error.Class (MonadError (..)) import qualified Data.Text as T-import GHC.IO (evaluate)+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Status (..))+import HWM.Core.Result (Issue (..), IssueDetails (..), Severity (..))+import HWM.Runtime.Files (prepareDir)+import HWM.Runtime.Logging (genLogId, logCommandEnd, logCommandStart, logPath, logRoot)+import HWM.Runtime.UI import Relude import System.Environment (getEnvironment) import qualified System.IO as TIO import System.Process (readProcessWithExitCode) import System.Process.Typed+  ( ExitCode (..),+    Process,+    proc,+    runProcess_,+    setEnv,+    setStderr,+    setStdout,+    shell,+    useHandleOpen,+    waitExitCode,+    withProcessWait,+  ) +mkExec :: (Applicative m) => Text -> [Text] -> m (Exec m)+mkExec name args = pure $ Exec name args [] Nothing+ exec :: (MonadIO m) => Text -> [Text] -> m (Bool, String) exec name args = do   (code, _, out) <- liftIO (readProcessWithExitCode (toString name) (map toString args) "")@@ -24,34 +52,65 @@     ExitSuccess {} -> pure (True, out)     ExitFailure {} -> pure (False, out) -provideYamlPath :: (MonadIO m) => String -> m [(String, String)]-provideYamlPath yamlPath = do-  currentEnv <- liftIO getEnvironment-  pure (("STACK_YAML", yamlPath) : currentEnv)+data Exec m = Exec+  { execCmd :: Text,+    execArgs :: [Text],+    execEnv :: [(String, String)],+    postCommand :: Maybe (m ())+  } -silentRun :: (MonadIO m) => FilePath -> Text -> IO (Async a) -> m (Bool, Text)-silentRun yamlPath cmd spinnerM = do-  targetEnv <- provideYamlPath yamlPath-  let pc = setEnv targetEnv $ setStdout createPipe $ setStderr createPipe $ shell (toString cmd)-  liftIO-    $ withProcessWait pc-    $ \p -> do-      spinner <- spinnerM-      status <- waitExitCode p-      errCapture <- async $ do-        content <- TIO.hGetContents (getStderr p)-        evaluate (force content)-      cancel spinner-      rawLogsText <- wait errCapture-      let logsText = T.pack rawLogsText-      case status of-        ExitSuccess -> do-          pure (True, logsText)-        _ -> do-          pure (False, logsText)+type EnvVars = [(String, String)] -inheritRun :: (MonadIO m) => FilePath -> Text -> m ()-inheritRun yamlPath cmd = do-  targetEnv <- provideYamlPath yamlPath-  let processConfig = setEnv targetEnv $ proc "/bin/sh" ["-c", toString cmd]+data ExecOptions = ExecOptions+  { envName :: Name,+    formatFX :: Text -> Text -> Text,+    fxEnabled :: Bool+  }++processHandle :: IO a -> Bool -> Handle -> Process stdin stdout stderr -> IO ExitCode+processHandle f True logHandle p = do+  spinner <- async f+  status <- waitExitCode p+  cancel spinner+  logCommandEnd logHandle status+  pure status+processHandle _ False logHandle p = do+  status <- waitExitCode p+  logCommandEnd logHandle status+  pure status++execInBackground :: (MonadUI m, MonadError Issue m, MonadIO m) => Exec m -> ExecOptions -> m ()+execInBackground Exec {..} ExecOptions {..} = do+  logId <- genLogId envName+  let fx = formatFX (toText $ logPath logId)+  let processLogPath = logPath logId+  prepareDir logRoot+  let cmd = execCmd <> " " <> T.unwords execArgs+  currentEnv <- liftIO getEnvironment+  let targetEnv = execEnv <> currentEnv+  status <- liftIO $ TIO.withFile processLogPath TIO.WriteMode $ \logHandle -> do+    unless fxEnabled (uiIndicator fx fxEnabled Nothing)+    logCommandStart logHandle cmd+    let config = setEnv targetEnv $ setStdout (useHandleOpen logHandle) $ setStderr (useHandleOpen logHandle) $ shell (toString cmd)+    withProcessWait config $ processHandle (uiIndicator fx fxEnabled Nothing) fxEnabled logHandle+  case status of+    ExitSuccess -> do+      liftIO $ uiIndicator fx fxEnabled (Just Checked)+      sequence_ postCommand+    _ -> do+      liftIO $ uiIndicator fx fxEnabled (Just Invalid)+      throwError+        Issue+          { issueTopic = logId,+            issueMessage = "Command failed",+            issueSeverity = SeverityError,+            issueDetails = Just CommandIssue {issueCommand = cmd, issueLogFile = processLogPath}+          }++inheritRun :: (MonadIO m, MonadUI m) => Exec m -> m ()+inheritRun Exec {..} = do+  currentEnv <- liftIO getEnvironment+  let targetEnv = execEnv <> currentEnv+  let processConfig = setEnv targetEnv $ proc "/bin/sh" (["-c", toString execCmd] <> map toString execArgs)   liftIO (runProcess_ processConfig)+  sequence_ postCommand

@@ -15,18 +15,24 @@     runUI,     putLine,     indent,-    section,+    section_,     sectionWorkspace,     sectionEnvironments,     sectionConfig,     sectionTableM,     forTable_,     printSummary,-    statusIndicator,-    runSpinner,-    printGenTable,+    uiFormatTable,     forTable,     statusTableM,+    section,+    uiSpace,+    uiRow,+    uiSubPath,+    uiSubPathRow,+    uiLabel,+    minRowSize,+    uiIndicator,   ) where @@ -36,8 +42,10 @@ import Data.List (groupBy, maximum, (!!)) import qualified Data.Map.Strict as Map import qualified Data.Text as T+import qualified Data.Text.IO as T import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (..), Format (..), Status (..), chalk, indentBlockNum, padDots, renderSummaryStatus, statusIcon, subPathSign)+import HWM.Core.Formatting (Color (..), Format (..), Status (..), chalk, indentBlockNum, minRowSize, padDots, renderSummaryStatus, statusIcon, subPathSign)+import HWM.Core.Options (whenCI) import HWM.Core.Result   ( Issue (..),     IssueDetails (..),@@ -90,6 +98,21 @@   uiIndentLevel = lift uiIndentLevel   uiWithIndent f (ResultT action) = ResultT $ uiWithIndent f action +uiSpace :: (MonadUI m) => m ()+uiSpace = uiWrite "\n"++uiSubPath :: (MonadUI m, Format a) => a -> m ()+uiSubPath value = putLine $ subPathSign <> format value++uiSubPathRow :: (MonadUI m) => Int -> Text -> Text -> m ()+uiSubPathRow size key value = putLine $ subPathSign <> padDots size key <> value++uiRow :: (MonadUI m) => Int -> Text -> Text -> m ()+uiRow size key value = putLine $ padDots size key <> value++uiLabel :: (MonadUI m) => Text -> m ()+uiLabel name = putLine $ "• " <> chalk Bold name+ putLine :: (MonadUI m) => Text -> m () putLine txt = do   level <- uiIndentLevel@@ -100,27 +123,27 @@  sectionBase :: (MonadUI m) => Text -> Text -> m a -> m a sectionBase emoji title action = do-  putLine ""+  uiSpace   putLine (emoji <> " " <> chalk Bold title)   indent 1 action -section :: (MonadUI m) => Text -> m a -> m ()-section t m = sectionBase "•" t m $> ()+section_ :: (MonadUI m) => Text -> m a -> m ()+section_ t m = sectionBase "•" t m $> () +section :: (MonadUI m) => Text -> m a -> m a+section = sectionBase "•"+ sectionWorkspace :: (MonadUI m) => m a -> m () sectionWorkspace m = sectionBase "./" "workspace" m $> ()  sectionEnvironments :: (MonadUI m) => Maybe Text -> m a -> m ()-sectionEnvironments title = section ("environments" <> maybe "" (\name -> chalk Dim " (default: " <> chalk Magenta name <> chalk Dim ")") title)--minRawSize :: Int-minRawSize = 16+sectionEnvironments title = section_ ("environments" <> maybe "" (\name -> chalk Dim " (default: " <> chalk Magenta name <> chalk Dim ")") title)  forHLTable :: (MonadUI m) => [a] -> (a -> (Name, m (Name, b))) -> m [(Name, b)] forHLTable as f = traverse formatRow rows   where     rows = map f as-    maxLabelLen = maximum (minRawSize : map (T.length . fst) rows) + 2+    maxLabelLen = maximum (minRowSize : map (T.length . fst) rows) + 2     formatRow (label, valueM) = do       (value, mvalue) <- valueM       putLine $ padDots maxLabelLen label <> value@@ -141,15 +164,15 @@     render s = statusIcon <$> s  sectionTableM :: (MonadUI m) => Text -> [(Text, m Text)] -> m ()-sectionTableM title = section title . tableM_+sectionTableM title = section_ title . tableM_  sectionConfig :: (MonadUI m) => [(Text, m Status)] -> m ()-sectionConfig = section "config" . tableM_ . map (second render)+sectionConfig = section_ "config" . tableM_ . map (second render)   where     render s = statusIcon <$> s -printGenTable :: (MonadUI m) => [[Text]] -> m ()-printGenTable rows =+uiFormatTable :: (MonadUI m) => [[Text]] -> m ()+uiFormatTable rows =   let n = if null rows then 0 else maximum (map length rows)       padRow r = take n (r ++ repeat "")       paddedRows = map padRow rows@@ -209,21 +232,34 @@ levelColor SeverityError = Red levelColor SeverityWarning = Yellow -printSummary :: (MonadUI m) => [Issue] -> m ()-printSummary = traverse_ putLine . renderSummaryLines+printSummary :: (MonadUI m, MonadIO m) => [Issue] -> m ()+printSummary issues = do+  uiSpace+  traverse_ putLine (renderSummaryLines issues) >> whenCI (traverse_ extractLog issues)+  where+    extractLog Issue {issueDetails = Just (CommandIssue {issueLogFile})} = do+      content <- liftIO $ T.readFile (toString issueLogFile)+      putLine $ chalk Dim ("--- CI logs for " <> format issueLogFile <> " ---")+      putLine content+    extractLog _ = pure () -statusIndicator :: (MonadIO m) => Int -> Text -> Text -> m ()-statusIndicator padding prefix msg = do-  liftIO clearLine-  liftIO $ setCursorColumn 0-  liftIO $ putStr $ toString $ "  " <> padDots padding prefix <> msg-  liftIO $ hFlush stdout+refreshFrame :: Text -> IO ()+refreshFrame f = do+  clearLine+  setCursorColumn 0+  putStr $ toString f+  hFlush stdout -runSpinner :: (MonadIO m) => Int -> Text -> m ()-runSpinner padding prefix = loop ["◜", "◠", "◝", "◞", "◡", "◟"]+loopFrames :: (Text -> Text) -> [Text] -> IO ()+loopFrames g = loop   where     loop (f : fs) = do-      statusIndicator padding prefix f-      liftIO $ threadDelay 200000 -- 200ms+      refreshFrame (g f)+      threadDelay 200000       loop (fs ++ [f])     loop [] = pure ()++uiIndicator :: (MonadIO m) => (Text -> Text) -> Bool -> Maybe Status -> m ()+uiIndicator f False Nothing = liftIO $ refreshFrame $ f "►"+uiIndicator f True Nothing = liftIO $ loopFrames f ["◜", "◠", "◝", "◞", "◡", "◟"]+uiIndicator f _ (Just s) = liftIO $ refreshFrame $ f (statusIcon s)