hwm 0.0.5 → 0.1.0

raw patch · 51 files changed

+2275/−894 lines, 51 filesdep +zip-archivedep ~Globdep ~aesondep ~asyncPVP ok

version bump matches the API change (PVP)

Dependencies added: zip-archive

Dependency ranges changed: Glob, aeson, async, base16-bytestring, cryptohash-sha256, hpack, hwm, modern-uri, mtl, optparse-applicative, relude, req, typed-process, unordered-containers, yaml

API changes (from Hackage documentation)

Files

• README.md +0/−78
• hwm.cabal +54/−33
• src/HWM/CLI/App.hs +41/−64
• src/HWM/CLI/Command.hs +21/−11
• src/HWM/CLI/Command/Environment.hs +42/−0
• src/HWM/CLI/Command/Environment/Add.hs +68/−0
• src/HWM/CLI/Command/Environment/Ls.hs +17/−0
• src/HWM/CLI/Command/Environment/Remove.hs +31/−0
• src/HWM/CLI/Command/Environment/SetDefault.hs +24/−0
• src/HWM/CLI/Command/Init.hs +17/−9
• src/HWM/CLI/Command/Outdated.hs +0/−48
• src/HWM/CLI/Command/Publish.hs +0/−66
• src/HWM/CLI/Command/Registry.hs +39/−0
• src/HWM/CLI/Command/Registry/Add.hs +60/−0
• src/HWM/CLI/Command/Registry/Audit.hs +63/−0
• src/HWM/CLI/Command/Registry/Ls.hs +26/−0
• src/HWM/CLI/Command/Release/Artifacts.hs +150/−0
• src/HWM/CLI/Command/Release/Publish.hs +95/−0
• src/HWM/CLI/Command/Release/Root.hs +32/−0
• src/HWM/CLI/Command/Run.hs +28/−15
• src/HWM/CLI/Command/Status.hs +9/−21
• src/HWM/CLI/Command/Sync.hs +1/−1
• src/HWM/CLI/Command/Version.hs +38/−12
• src/HWM/CLI/Command/Workspace.hs +34/−0
• src/HWM/CLI/Command/Workspace/Add.hs +77/−0
• src/HWM/CLI/Command/Workspace/Ls.hs +18/−0
• src/HWM/Core/Formatting.hs +12/−1
• src/HWM/Core/Parsing.hs +26/−2
• src/HWM/Core/Pkg.hs +7/−2
• src/HWM/Core/Version.hs +14/−2
• src/HWM/Domain/Bounds.hs +126/−46
• src/HWM/Domain/Config.hs +23/−18
• src/HWM/Domain/ConfigT.hs +27/−34
• src/HWM/Domain/Dependencies.hs +18/−3
• src/HWM/Domain/Environments.hs +265/−0
• src/HWM/Domain/Matrix.hs +0/−236
• src/HWM/Domain/Release.hs +113/−0
• src/HWM/Domain/Workspace.hs +137/−56
• src/HWM/Integrations/Scaffold.hs +28/−0
• src/HWM/Integrations/Toolchain/Hie.hs +4/−2
• src/HWM/Integrations/Toolchain/Lib.hs +25/−25
• src/HWM/Integrations/Toolchain/Package.hs +79/−65
• src/HWM/Integrations/Toolchain/Stack.hs +20/−18
• src/HWM/Runtime/Archive.hs +93/−0
• src/HWM/Runtime/Cache.hs +47/−17
• src/HWM/Runtime/Files.hs +14/−1
• src/HWM/Runtime/Network.hs +44/−0
• src/HWM/Runtime/Platform.hs +76/−0
• src/HWM/Runtime/Process.hs +9/−0
• src/HWM/Runtime/Snapshots.hs +51/−0
• src/HWM/Runtime/UI.hs +32/−8

@@ -2,85 +2,7 @@  **HWM is not a build tool.** It is the missing link that orchestrates the tools you already use. -Haskell has excellent build systems (`stack`, `cabal`, `nix`) and a powerful IDE (`hls`), but they don't talk to each other in a monorepo. HWM bridges this gap by acting as a **single source of truth**, automatically generating and synchronizing the configuration files those tools expect.--## The Problem--In a typical Haskell monorepo:--* **Dependency Drift:** Different packages use different versions of the same dependency-* **Matrix Complexity:** Testing multiple GHC versions requires maintaining separate config files-* **Broken IDEs:** Adding modules breaks HLS until you manually update `hie.yaml`-* **Release Friction:** Releasing requires manually bumping versions across dozens of files--## The Solution--You define the "what" in `hwm.yaml`. HWM handles the "how."--```yaml-name: my-project-version: 0.1.0--workspace:-  - name: libs-    prefix: my-app-    members: [core, api, client]--registry:-  - aeson >= 2.0 && < 3.0-  - text  >= 2.0 && < 3.0--matrix:-  default-environment: stable-  environments:-    - { name: stable, ghc: 9.6.3, resolver: lts-22.6 }-    - { name: nightly, ghc: 9.10.1, resolver: nightly-2024-05-22 }-```--One command regenerates everything:--```bash-hwm sync-```--HWM generates and keeps in sync:-* `stack.yaml` / `cabal.project`-* `package.yaml` files → `.cabal` files-* `hie.yaml` for HLS-* Build matrix configurations--## Quick Start--```bash-# Install-stack install hwm-# or-cabal install hwm--# In an existing Stack project-hwm init-hwm sync-hwm run build-```--## Key Commands--* `hwm status` - Check if generated files are in sync-* `hwm sync` - Regenerate all configuration files-* `hwm run <script>` - Run scripts across build matrix-* `hwm outdated` - Check for dependency updates-* `hwm version <bump>` - Atomically bump versions-* `hwm publish <group>` - Publish to Hackage--## Full Documentation- 📚 **[Complete Documentation & Examples →](https://github.com/nalchevanidze/hwm)**--Visit the GitHub repository for:-* Detailed configuration reference-* Architecture documentation-* Contributing guidelines-* Examples and use cases  ## Origin 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hwm-version:        0.0.5+version:        0.1.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@@ -32,13 +32,26 @@   exposed-modules:       HWM.CLI.App       HWM.CLI.Command+      HWM.CLI.Command.Environment+      HWM.CLI.Command.Environment.Add+      HWM.CLI.Command.Environment.Ls+      HWM.CLI.Command.Environment.Remove+      HWM.CLI.Command.Environment.SetDefault       HWM.CLI.Command.Init-      HWM.CLI.Command.Outdated-      HWM.CLI.Command.Publish+      HWM.CLI.Command.Registry+      HWM.CLI.Command.Registry.Add+      HWM.CLI.Command.Registry.Audit+      HWM.CLI.Command.Registry.Ls+      HWM.CLI.Command.Release.Artifacts+      HWM.CLI.Command.Release.Publish+      HWM.CLI.Command.Release.Root       HWM.CLI.Command.Run       HWM.CLI.Command.Status       HWM.CLI.Command.Sync       HWM.CLI.Command.Version+      HWM.CLI.Command.Workspace+      HWM.CLI.Command.Workspace.Add+      HWM.CLI.Command.Workspace.Ls       HWM.Core.Common       HWM.Core.Formatting       HWM.Core.Has@@ -51,17 +64,23 @@       HWM.Domain.Config       HWM.Domain.ConfigT       HWM.Domain.Dependencies-      HWM.Domain.Matrix+      HWM.Domain.Environments+      HWM.Domain.Release       HWM.Domain.Workspace+      HWM.Integrations.Scaffold       HWM.Integrations.Toolchain.Cabal       HWM.Integrations.Toolchain.Hie       HWM.Integrations.Toolchain.Lib       HWM.Integrations.Toolchain.Package       HWM.Integrations.Toolchain.Stack+      HWM.Runtime.Archive       HWM.Runtime.Cache       HWM.Runtime.Files       HWM.Runtime.Logging+      HWM.Runtime.Network+      HWM.Runtime.Platform       HWM.Runtime.Process+      HWM.Runtime.Snapshots       HWM.Runtime.UI   other-modules:       Paths_hwm@@ -70,31 +89,32 @@   ghc-options: -Wall   build-depends:       Cabal >=3.8 && <=3.16.1.0-    , Glob >=0.7.0 && <1.0.0-    , aeson >=1.4.4 && <3.0.0+    , Glob >=0.10.1 && <=0.10.2+    , aeson >=1.5.6.0 && <=2.2.3.0     , ansi-terminal >=0.11.3 && <=1.1.5-    , async >=2.2.4 && <2.3.0+    , async >2.2.3 && <=2.2.6     , base >=4.7.0 && <5.0.0-    , base16-bytestring >=1.0.0 && <2.0.0+    , base16-bytestring >=1.0.1.0 && <=1.0.2.0     , bytestring >=0.10.4 && <=0.12.2.0     , containers >=0.4.2.1 && <=0.8-    , cryptohash-sha256 >=0.11.100 && <=0.11.102.1+    , cryptohash-sha256 >=0.11.102.0 && <=0.11.102.1     , directory >=1.0 && <=1.3.10.1     , filepath >=1.1.0 && <=1.5.5.0-    , hpack >=0.36.0 && <=0.39.1-    , modern-uri >=0.1.0.0 && <1.0.0-    , mtl >=2.0.0 && <2.6.0-    , optparse-applicative >=0.12.0 && <0.20.0+    , hpack >0.34.4 && <=0.39.1+    , modern-uri >=0.3.4.1 && <=0.3.6.1+    , mtl >2.0.0 && <2.6.0+    , optparse-applicative >=0.16.1.0 && <=0.19.0.0     , process >=1.0.0 && <2.0.0-    , relude >=0.3.0 && <2.0.0-    , req >=3.0.0 && <=3.13.4+    , relude >=0.7.0.0 && <=1.2.2.2+    , req >=3.9.0 && <=3.13.4     , stm >=2.4 && <2.6.0     , text >=1.2.3 && <3.0.0     , time >=1.9.2 && <2.0.0     , transformers >=0.5.6 && <0.7.0-    , typed-process >=0.1.0 && <0.4.0-    , unordered-containers >=0.2.8 && <0.3.0-    , yaml >=0.8.32 && <1.0.0+    , typed-process >=0.2.6.1 && <=0.2.13.0+    , unordered-containers >=0.2.14.0 && <=0.2.21+    , yaml >=0.11.5.0 && <=0.11.11.2+    , zip-archive >=0.4.1 && <=0.4.3.2   default-language: Haskell2010  executable hwm@@ -106,30 +126,31 @@   ghc-options: -Wall   build-depends:       Cabal >=3.8 && <=3.16.1.0-    , Glob >=0.7.0 && <1.0.0-    , aeson >=1.4.4 && <3.0.0+    , Glob >=0.10.1 && <=0.10.2+    , aeson >=1.5.6.0 && <=2.2.3.0     , ansi-terminal >=0.11.3 && <=1.1.5-    , async >=2.2.4 && <2.3.0+    , async >2.2.3 && <=2.2.6     , base >=4.7.0 && <5.0.0-    , base16-bytestring >=1.0.0 && <2.0.0+    , base16-bytestring >=1.0.1.0 && <=1.0.2.0     , bytestring >=0.10.4 && <=0.12.2.0     , containers >=0.4.2.1 && <=0.8-    , cryptohash-sha256 >=0.11.100 && <=0.11.102.1+    , cryptohash-sha256 >=0.11.102.0 && <=0.11.102.1     , directory >=1.0 && <=1.3.10.1     , filepath >=1.1.0 && <=1.5.5.0-    , hpack >=0.36.0 && <=0.39.1-    , hwm >=0.0.0 && <0.1.0-    , modern-uri >=0.1.0.0 && <1.0.0-    , mtl >=2.0.0 && <2.6.0-    , optparse-applicative >=0.12.0 && <0.20.0+    , hpack >0.34.4 && <=0.39.1+    , hwm >=0.1.0 && <0.2.0+    , modern-uri >=0.3.4.1 && <=0.3.6.1+    , mtl >2.0.0 && <2.6.0+    , optparse-applicative >=0.16.1.0 && <=0.19.0.0     , process >=1.0.0 && <2.0.0-    , relude >=0.3.0 && <2.0.0-    , req >=3.0.0 && <=3.13.4+    , relude >=0.7.0.0 && <=1.2.2.2+    , req >=3.9.0 && <=3.13.4     , stm >=2.4 && <2.6.0     , text >=1.2.3 && <3.0.0     , time >=1.9.2 && <2.0.0     , transformers >=0.5.6 && <0.7.0-    , typed-process >=0.1.0 && <0.4.0-    , unordered-containers >=0.2.8 && <0.3.0-    , yaml >=0.8.32 && <1.0.0+    , typed-process >=0.2.6.1 && <=0.2.13.0+    , unordered-containers >=0.2.14.0 && <=0.2.21+    , yaml >=0.11.5.0 && <=0.11.11.2+    , zip-archive >=0.4.1 && <=0.4.3.2   default-language: Haskell2010

@@ -9,18 +9,9 @@   ) where -import Data.Text (pack)-import HWM.CLI.Command-  ( Command (..),-    Options (..),-    currentVersion,-    defaultOptions,-    runCommand,-  )-import HWM.CLI.Command.Init (InitOptions (..))-import HWM.CLI.Command.Run (ScriptOptions (..))-import HWM.Core.Common (Name)-import HWM.Core.Parsing (Parse (..), parseOptions)+import qualified Data.Text as T+import HWM.CLI.Command (Command (..), Options (..), currentVersion, defaultOptions, runCommand)+import HWM.Core.Parsing (ParseCLI (..), flag) import Options.Applicative   ( Parser,     argument,@@ -30,32 +21,17 @@     help,     helper,     info,-    long,     metavar,     prefs,     progDesc,-    short,     showHelpOnError,-    strArgument,+    str,     subparser,-    switch,   )-import Options.Applicative.Builder (str, strOption)-import Relude hiding (ByteString, fix)+import Relude  -- Helper for building commands (unchanged, just added type signature clarity)-commands :: [(String, String, Parser a)] -> Parser a-commands =-  subparser-    . mconcat-    . map-      ( \(name, desc, value) ->-          command name (info (helper <*> value) (fullDesc <> progDesc desc))-      ) -flag :: Char -> String -> String -> Parser Bool-flag s l h = switch (long l <> short s <> help h)- run :: Parser a -> IO a run app =   customExecParser@@ -65,53 +41,54 @@         (fullDesc <> progDesc "HWM - Haskell Workspace Manager for Monorepos")     ) -parseScriptOptions :: Parser Name -> Parser ScriptOptions-parseScriptOptions name =-  ScriptOptions-    <$> name-    <*> fmap parseOptions (many (strOption (long "target" <> short 't' <> metavar "TARGET" <> help "Limit to package (core) or group (libs)")))-    <*> fmap parseOptions (many (strOption (long "env" <> short 'e' <> metavar "ENV" <> help "Run in specific env (use 'all' for full matrix)")))-    <*> many (argument (pack <$> str) (metavar "ARGS..." <> help "Arguments to forward to the script"))--parseInitOptions :: Parser InitOptions-parseInitOptions =-  InitOptions-    <$> flag 'f' "force" "Force override existing hwm.yaml"-    <*> optional (argument str (metavar "NAME" <> help "Optional project name (defaults to current directory name)"))+commands :: [(String, String, Parser a)] -> Parser a+commands =+  subparser+    . mconcat+    . map+      (\(name, desc, value) -> command name (info (helper <*> value) (fullDesc <> progDesc desc)))  parseCommand :: Parser Command parseCommand =   commands-    [ ( "sync",-        "Regenerate stack.yaml and .cabal files. Optional: switch environment.",-        Sync <$> optional (argument str (metavar "ENV" <> help "Switch to a specific environment (e.g., legacy, stable)"))-      ),-      ( "version",-        "Show version or bump it (patch | minor | major).",-        Version <$> optional (argument (str >>= parse) (metavar "BUMP" <> help "Version bump type or specific version number"))+    [ ( "init",+        "Initialize a new HWM workspace by scanning the directory structure.",+        Init <$> parseCLI       ),-      ( "outdated",-        "Check for newer dependencies on Hackage.",-        Outdated <$> switch (long "fix" <> short 'f' <> help "Write changes to hwm.yaml")+      ( "status",+        "Show current project version, active environment, and sync state.",+        pure Status       ),-      ( "publish",-        "Upload packages to Hackage/Registry.",-        Publish <$> optional (argument str (metavar "GROUP" <> help "Name of the workspace group to publish (default: all)"))+      ( "sync",+        "Generate stack.yaml/cabal files for a specific environment (defaults to 'default').",+        Sync <$> optional (argument str (metavar "ENV" <> help "Environment name or 'all' for the full matrix"))       ),       ( "run",-        "Run a script defined in hwm.yaml",-        Run <$> parseScriptOptions (argument (pack <$> str) (metavar "SCRIPT" <> help "Name of the script to run"))+        "Execute a script defined in hwm.yaml (e.g., build, test, lint).",+        Run <$> argument (T.pack <$> str) (metavar "SCRIPT" <> help "Script name") <*> parseCLI       ),-      ( "status",-        "Show the current environment, version, and sync status.",-        pure Status+      ( "workspace",+        "Manage workspace groups and package members.",+        Workspace <$> parseCLI       ),-      ( "init",-        "Initialize a new HWM workspace by scanning the current directory.",-        Init <$> parseInitOptions+      ( "environment",+        "Manage GHC toolchains and resolver targets.",+        Env <$> parseCLI+      ),+      ( "registry",+        "Audit and manage the dependency registry and version bounds.",+        Registry <$> parseCLI+      ),+      ( "version",+        "Display the current workspace version or bump it (patch, minor, major).",+        Version <$> parseCLI+      ),+      ( "release",+        "Manage delivery: build artifacts or publish release trains.",+        Release <$> parseCLI       )     ]-    <|> (Run <$> parseScriptOptions (strArgument (metavar "SCRIPT")))+    <|> (Run <$> argument (T.pack <$> str) mempty <*> parseCLI)  data Input = Input   { v :: Bool,

@@ -12,13 +12,15 @@ where  import Data.Version (showVersion)+import HWM.CLI.Command.Environment (EnvCommand, runEnv) import HWM.CLI.Command.Init (InitOptions (..), initWorkspace)-import HWM.CLI.Command.Outdated (runOutdated)-import HWM.CLI.Command.Publish (publish)+import HWM.CLI.Command.Registry (RegistryCommand, runRegistry)+import HWM.CLI.Command.Release.Root (ReleaseCommand (..), runRelease) import HWM.CLI.Command.Run (ScriptOptions, runScript) import HWM.CLI.Command.Status (showStatus) import HWM.CLI.Command.Sync (sync)-import HWM.CLI.Command.Version (runVersion)+import HWM.CLI.Command.Version (VersionOptions, runVersion)+import HWM.CLI.Command.Workspace (WorkspaceCommand, runWorkspace) import HWM.Core.Common (Name) import HWM.Core.Options (Options (..), defaultOptions) import HWM.Core.Version (Bump (..))@@ -28,25 +30,33 @@  data Command   = Sync {tag :: Maybe Name}-  | Publish {groupName :: Maybe Name}-  | Version {bump :: Maybe Bump}-  | Outdated {fix :: Bool}-  | Run {runOptions :: ScriptOptions}+  | Version VersionOptions+  | Run {scriptName :: Name, runOptions :: ScriptOptions}   | Status   | Init {initOptions :: InitOptions}+  | -- Domain-specific commands+    Registry RegistryCommand+  | Env EnvCommand+  | Workspace WorkspaceCommand+  | Release ReleaseCommand   deriving (Show)  currentVersion :: String currentVersion = showVersion CLI.version +-- | Run the top-level command command :: Command -> ConfigT ()-command Publish {groupName} = publish groupName-command Version {bump} = runVersion bump-command Outdated {fix} = runOutdated fix+command (Release cmd) = runRelease cmd+command (Version options) = runVersion options command Sync {tag} = sync tag-command Run {runOptions} = runScript runOptions+command Run {scriptName, runOptions} = runScript scriptName runOptions command Status = showStatus command Init {} = pure ()+command (Registry options) = runRegistry options+command (Env options) = runEnv options+command (Workspace options) = runWorkspace options++-- EnvCommand and runEnv are now defined in Command.Environment  runCommand :: Command -> Options -> IO () runCommand Init {initOptions} ops = initWorkspace initOptions ops >> runConfigT showStatus ops

@@ -0,0 +1,42 @@+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Environment+  ( EnvCommand (..),+    runEnv,+  )+where++import HWM.CLI.Command.Environment.Add (EnvAddOptions, runEnvAdd)+import HWM.CLI.Command.Environment.Ls (EnvLsOptions, runEnvLs)+import HWM.CLI.Command.Environment.Remove (EnvRemoveOptions, runEnvRemove)+import HWM.CLI.Command.Environment.SetDefault (EnvSetDefaultOptions, runEnvSetDefault)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import Options.Applicative (command, info, progDesc, subparser)+import Relude++-- | Subcommands for `hwm environment`+data EnvCommand+  = EnvAdd EnvAddOptions+  | EnvRemove EnvRemoveOptions+  | EnvSetDefault EnvSetDefaultOptions+  | EnvLs EnvLsOptions+  deriving (Show)++runEnv :: EnvCommand -> ConfigT ()+runEnv cmd = case cmd of+  EnvAdd opts -> runEnvAdd opts+  EnvRemove opts -> runEnvRemove opts+  EnvSetDefault opts -> runEnvSetDefault opts+  EnvLs opts -> runEnvLs opts++instance ParseCLI EnvCommand where+  parseCLI =+    subparser+      ( mconcat+          [ command "add" (info (EnvAdd <$> parseCLI) (progDesc "Add a new environment.")),+            command "remove" (info (EnvRemove <$> parseCLI) (progDesc "Remove an environment.")),+            command "set-default" (info (EnvSetDefault <$> parseCLI) (progDesc "Set the default environment.")),+            command "ls" (info (EnvLs <$> parseCLI) (progDesc "List all environments."))+          ]+      )

@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Environment.Add (EnvAddOptions, runEnvAdd) where++import Control.Monad.Except (throwError)+import qualified Data.Map as M+import qualified Data.Map as Map+import qualified Data.Text as T+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Format (..), padDots)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, updateConfig)+import HWM.Domain.Environments (Environments (..), existsEnviroment, newEnv, printEnvironments)+import HWM.Runtime.Cache (getSnapshotGHC)+import HWM.Runtime.Snapshots (SnapshotInfo (..), fetchLtsSuggestions, fetchStackageSnapshots)+import HWM.Runtime.UI (putLine, section)+import Options.Applicative (help, metavar, strArgument)+import Relude++data EnvAddOptions = EnvAddOptions+  { envName :: Name,+    envResolver :: Name+  }+  deriving (Show)++instance ParseCLI EnvAddOptions where+  parseCLI =+    EnvAddOptions+      <$> strArgument (metavar "NAME" <> help "Name of the environment to add")+      <*> strArgument (metavar "RESOLVER" <> help "Stackage resolver (e.g. lts-21.24)")++printSuggestions :: [Text] -> [Text] -> Text+printSuggestions [] alt+  | null alt = ""+  | otherwise = " Here are some available snapshots: " <> T.intercalate ", " alt <> "."+printSuggestions [s] _ = " Did you mean '" <> s <> "'?"+printSuggestions suggestions _ = " Did you mean one of: " <> T.intercalate ", " suggestions <> "?"++size :: Int+size = 16++runEnvAdd :: EnvAddOptions -> ConfigT ()+runEnvAdd EnvAddOptions {..} = do+  exists <- existsEnviroment envName+  if exists+    then do+      printEnvironments Nothing+      throwError $ fromString $ "Environment '" <> toString envName <> "' already exists."+    else section "new environment" $ do+      putLine $ padDots size "name" <> envName+      ltsMap <- fetchLtsSuggestions+      snapshots <- map snapshotName <$> fetchStackageSnapshots+      let suggestions = M.elems ltsMap <> take 12 (filter (not . isPrefixOf "nightly" . toString) snapshots)+      let prefixMatches = filter (isPrefixOf (toString envResolver) . toString) snapshots+      case M.lookup envResolver ltsMap <|> find (== envResolver) snapshots of+        Nothing -> throwError $ fromString $ "Resolver '" <> toString envResolver <> "' is not a valid Stackage snapshot." <> toString (printSuggestions prefixMatches suggestions)+        Just resolver -> do+          putLine $ padDots size "resolver" <> envName+          updateConfig+            ( \cfg@Config {..} -> do+                ghc <- getSnapshotGHC resolver+                putLine $ padDots size "ghc" <> format ghc+                pure cfg {cfgEnvironments = cfgEnvironments {envTargets = Map.insert envName (newEnv ghc resolver) (envTargets cfgEnvironments)}}+            )+            (pure ())

@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Environment.Ls (EnvLsOptions, runEnvLs) where++import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import HWM.Domain.Environments (printEnvironments)+import Relude++data EnvLsOptions = EnvLsOptions+  deriving (Show)++instance ParseCLI EnvLsOptions where+  parseCLI = pure EnvLsOptions++runEnvLs :: EnvLsOptions -> ConfigT ()+runEnvLs _ = printEnvironments Nothing

@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Environment.Remove (EnvRemoveOptions, runEnvRemove) where++import Control.Monad.Except (MonadError (throwError))+import HWM.Core.Common (Name)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, updateConfig)+import HWM.Domain.Environments (existsEnviroment, printEnvironments, removeEnvironmentByName)+import Options.Applicative (help, metavar, strArgument)+import Relude++newtype EnvRemoveOptions = EnvRemoveOptions+  {envName :: Name}+  deriving (Show)++instance ParseCLI EnvRemoveOptions where+  parseCLI =+    EnvRemoveOptions+      <$> strArgument (metavar "ENVIRONMENT" <> help "Name of the environment to remove")++runEnvRemove :: EnvRemoveOptions -> ConfigT ()+runEnvRemove EnvRemoveOptions {..} = do+  exists <- existsEnviroment envName+  unless exists $ throwError $ fromString $ "Environment '" <> toString envName <> "' does not exist."+  updateConfig+    (\cfg@Config {..} -> pure cfg {cfgEnvironments = removeEnvironmentByName envName cfgEnvironments})+    (printEnvironments Nothing)

@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Environment.SetDefault (EnvSetDefaultOptions, runEnvSetDefault) where++import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, updateConfig)+import HWM.Domain.Environments (Environments (..), getBuildEnvironment, printEnvironments)+import Options.Applicative (help, metavar, strArgument)+import Relude++newtype EnvSetDefaultOptions = EnvSetDefaultOptions {envName :: Text}+  deriving (Show)++instance ParseCLI EnvSetDefaultOptions where+  parseCLI = EnvSetDefaultOptions <$> strArgument (metavar "ENV" <> help "Name of the environment to set as default")++runEnvSetDefault :: EnvSetDefaultOptions -> ConfigT ()+runEnvSetDefault EnvSetDefaultOptions {..} = do+  _ <- getBuildEnvironment (Just envName)+  let setDefaultEnv cfg = cfg {cfgEnvironments = (cfgEnvironments cfg) {envDefault = envName}}+  updateConfig (pure . setDefaultEnv) $ printEnvironments Nothing

@@ -12,17 +12,18 @@ import HWM.Core.Common (Name) import HWM.Core.Formatting (Color (Cyan), Format (format), chalk, padDots) import HWM.Core.Options (Options (..))+import HWM.Core.Parsing (ParseCLI (..), flag) import HWM.Core.Pkg (Pkg (..), scanPkgs) import HWM.Core.Result (Issue) import HWM.Core.Version (Version)-import HWM.Domain.Bounds (versionBounds) import HWM.Domain.Config (Config (..), defaultScripts) import HWM.Domain.ConfigT (resolveResultUI, saveConfig)-import HWM.Domain.Workspace (buildWorkspaceGroups)+import HWM.Domain.Workspace (buildWorkspace) import HWM.Integrations.Toolchain.Package (deriveRegistry) import HWM.Integrations.Toolchain.Stack (buildMatrix, scanStackFiles) import HWM.Runtime.Files (forbidOverride) import HWM.Runtime.UI (MonadUI, putLine, runUI, section)+import Options.Applicative (argument, help, metavar, str) import Relude hiding (exitWith, notElem) import System.Directory (getCurrentDirectory) import System.FilePath@@ -40,10 +41,16 @@   }   deriving (Show) +instance ParseCLI InitOptions where+  parseCLI =+    InitOptions+      <$> flag 'f' "force" "Force override existing hwm.yaml"+      <*> optional (argument str (metavar "NAME" <> help "Optional project name (defaults to current directory name)"))+ initWorkspace :: InitOptions -> Options -> IO () initWorkspace InitOptions {..} opts = runUI $ resolveResultUI $ do   root <- liftIO getCurrentDirectory-  let name = fromMaybe (deriveName root) projectName+  let cfgName = fromMaybe (deriveName root) projectName   section "init" $ do     unless forceOverride $ forbidOverride (normalise (root </> hwm opts))     stacks <- scanStackFiles opts root@@ -51,14 +58,15 @@     pkgs <- scanPkgs root     scanning "packages" pkgs     when (null pkgs) $ throwError "No packages listed in stack.yaml. Add at least one package before running 'hwm init'"-    (registry, graph) <- deriveRegistry pkgs-    version <- deriveVersion (map pkgVersion pkgs)-    matrix <- buildMatrix pkgs stacks-    workspace <- buildWorkspaceGroups graph pkgs+    (cfgRegistry, graph) <- deriveRegistry pkgs+    cfgVersion <- deriveVersion (map pkgVersion pkgs)+    cfgEnvironments <- buildMatrix pkgs stacks+    cfgWorkspace <- buildWorkspace graph pkgs     saveConfig       Config-        { bounds = versionBounds version,-          scripts = defaultScripts,+        { cfgBounds = Nothing,+          cfgScripts = defaultScripts,+          cfgRelease = Nothing,           ..         }       opts

@@ -1,48 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NoImplicitPrelude #-}--module HWM.CLI.Command.Outdated (runOutdated) where--import HWM.Core.Formatting (Color (..), Format (..), chalk, genMaxLen, padDots)-import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (SeverityWarning))-import HWM.Domain.Bounds (printUpperBound, updateDepBounds)-import HWM.Domain.Config (Config (registry))-import HWM.Domain.ConfigT (ConfigT, config, updateConfig)-import HWM.Domain.Dependencies (Dependency (..), toDependencyList, traverseDeps)-import HWM.Integrations.Toolchain.Package (syncPackages)-import HWM.Runtime.Cache (clearVersions)-import HWM.Runtime.UI (indent, putLine, section, sectionConfig, sectionTableM)-import Relude--runOutdated :: Bool -> ConfigT ()-runOutdated autoFix = do-  sectionTableM 0 "update dependencies" [("mode", pure $ chalk Cyan (if autoFix then "auto-fix" else "check"))]--  clearVersions-  originalRegistry <- asks (registry . config)-  section "registry" $ pure ()-  registry' <- traverseDeps updateDepBounds originalRegistry--  let updates = map snd $ filter (uncurry (/=)) (zip (toDependencyList originalRegistry) (toDependencyList registry'))-  let maxLen = genMaxLen (map (format . name) updates)--  if null updates-    then do-      indent 1 $ putLine "all dependencies are up to date."-    else do-      indent 1 $ for_ updates $ \Dependency {..} -> putLine $ padDots maxLen (format name) <> "↑ " <> printUpperBound bounds--      if autoFix-        then ((\cf -> pure $ cf {registry = registry'}) `updateConfig`) $ do-          sectionConfig 0 [("hwm.yaml", pure $ chalk Green "✓")]-          syncPackages-        else-          injectIssue-            ( Issue-                { issueDetails = Nothing,-                  issueMessage = "Found " <> show (length updates) <> " outdated dependencies: Run 'hwm outdated --fix' to update.",-                  issueTopic = "registry",-                  issueSeverity = SeverityWarning-                }-            )

@@ -1,66 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoImplicitPrelude #-}--module HWM.CLI.Command.Publish (publish) where--import Control.Monad.Error.Class (MonadError (..))-import qualified Data.Text as T-import HWM.Core.Common (Name)-import HWM.Core.Formatting-  ( Color (..),-    Format (..),-    chalk,-    genMaxLen,-    padDots,-    statusIcon,-  )-import HWM.Core.Pkg (Pkg (..))-import HWM.Core.Result (Issue, Severity (..), maxSeverity)-import HWM.Domain.ConfigT (ConfigT, askVersion, askWorkspaceGroups)-import HWM.Domain.Workspace (WorkspaceGroup, canPublish, memberPkgs, pkgGroupName, selectGroup)-import HWM.Integrations.Toolchain.Stack (sdist, upload)-import HWM.Runtime.UI (printSummary, putLine, section, sectionTableM, sectionWorkspace)-import Relude hiding (intercalate)--failIssues :: [Issue] -> ConfigT ()-failIssues [] = pure ()-failIssues issues = do-  printSummary issues-  when (maxSeverity issues == Just SeverityError) $ liftIO exitFailure--collectGroups :: Maybe Name -> [WorkspaceGroup] -> ConfigT [WorkspaceGroup]-collectGroups Nothing ws = pure $ filter canPublish ws-collectGroups (Just target) ws = do-  groups <- traverse (`selectGroup` ws) [target]-  let notPublishable = filter (not . canPublish) groups-  for_ notPublishable $ \g ->-    throwError $ fromString $ toString $ "Target group \"" <> pkgGroupName g <> "\" cannot be published. Check workspace group configuration."-  pure groups--publish :: Maybe Name -> ConfigT ()-publish target = do-  ws <- askWorkspaceGroups-  groups <- collectGroups target ws-  version <- askVersion-  when (null groups) $ throwError "No publishable groups found. Check workspace group configuration."--  sectionTableM-    0-    "publish"-    [ ("version", pure $ chalk Magenta (format version)),-      ("target", pure $ chalk Cyan (format (T.intercalate ", " (map pkgGroupName groups)))),-      ("registry", pure "hackage")-    ]--  issues <- traverse memberPkgs groups >>= traverse sdist . concat-  failIssues (concat issues)--  sectionWorkspace $ for_ groups $ \g ->-    section (chalk Bold (pkgGroupName g)) $ do-      pkgs <- memberPkgs g-      for_ pkgs $ \pkg -> do-        (status, publishIssues) <- upload pkg-        putLine $ "└── " <> padDots (genMaxLen (map pkgMemberId pkgs)) (pkgMemberId pkg) <> statusIcon status-        failIssues publishIssues

@@ -0,0 +1,39 @@+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Registry+  ( RegistryCommand (..),+    runRegistry,+  )+where++import HWM.CLI.Command.Registry.Add (RegistryAddOptions, runRegistryAdd)+import HWM.CLI.Command.Registry.Audit (RegistryAuditOptions, runRegistryAudit)+import HWM.CLI.Command.Registry.Ls (RegistryLsOptions, runRegistryLs)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import Options.Applicative (command, info, progDesc, subparser)+import Relude++-- | Subcommands for `hwm registry`+data RegistryCommand+  = RegistryAdd RegistryAddOptions+  | RegistryAudit RegistryAuditOptions+  | RegistryLs RegistryLsOptions+  deriving (Show)++runRegistry :: RegistryCommand -> ConfigT ()+runRegistry registryCommand =+  case registryCommand of+    RegistryAdd opts -> runRegistryAdd opts+    RegistryAudit opts -> runRegistryAudit opts+    RegistryLs opts -> runRegistryLs opts++instance ParseCLI RegistryCommand where+  parseCLI =+    subparser+      ( mconcat+          [ command "add" (info (RegistryAdd <$> parseCLI) (progDesc "Add a dependency to the registry.")),+            command "audit" (info (RegistryAudit <$> parseCLI) (progDesc "Audit and optionally fix the registry.")),+            command "ls" (info (RegistryLs <$> parseCLI) (progDesc "List registry entries."))+          ]+      )

@@ -0,0 +1,60 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++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.Parsing (ParseCLI (..), parse, parseOptions)+import HWM.Core.Pkg (PkgName (..))+import HWM.Domain.Bounds (deriveBounds)+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, Env (config), updateConfig)+import HWM.Domain.Dependencies (Dependency (Dependency), lookupBounds, singleDeps)+import HWM.Domain.Environments (getTestedRange)+import HWM.Domain.Workspace (forWorkspaceTuple, resolveWorkspaces)+import HWM.Integrations.Toolchain.Package+import HWM.Runtime.UI (putLine, section, sectionConfig, sectionTableM)+import Options.Applicative (argument, help, long, metavar, short, str)+import Relude++data RegistryAddOptions = RegistryAddOptions {opsPkgName :: PkgName, opsWorkspace :: [Text]} deriving (Show)++instance ParseCLI RegistryAddOptions where+  parseCLI =+    RegistryAddOptions+      <$> argument (str >>= parse) (metavar "PACKAGE" <> help "Package name to add")+      <*> parseOptions (long "workspace" <> short 'w' <> metavar "WORKSPACE" <> help "Target workspace ID")++runRegistryAdd :: RegistryAddOptions -> ConfigT ()+runRegistryAdd RegistryAddOptions {opsPkgName, opsWorkspace} = do+  workspaces <- resolveWorkspaces opsWorkspace+  sectionTableM+    0+    "add dependency"+    [ ("package", pure $ chalk Magenta (format opsPkgName)),+      ("target", pure $ chalk Cyan (if null opsWorkspace then "none (registry only)" else T.intercalate ", " opsWorkspace))+    ]+  registered <- asks (lookupBounds opsPkgName . cfgRegistry . config)+  case registered of+    Nothing -> do+      range <- getTestedRange+      section "discovery" $ do+        putLine $ padDots 16 "registry" <> "missing (initiating lookup)"++      bounds <- deriveBounds opsPkgName range+      let dependency = Dependency opsPkgName bounds++      ((\cf -> pure cf {cfgRegistry = cfgRegistry cf <> singleDeps dependency}) `updateConfig`) $ do+        sectionConfig 0 [("hwm.yaml", pure $ chalk Green "✓")]+        addDepToPackage workspaces dependency+    Just bounds -> do+      section "discovery" $ do+        putLine $ padDots 16 "registry" <> format bounds <> " (already registered)"+      addDepToPackage workspaces (Dependency opsPkgName bounds)+  where+    addDepToPackage ws dependency =+      unless (null ws)+        $ forWorkspaceTuple ws+        $ \pkg -> updatePackage (packageModifyDependencies (\deps -> pure (deps <> singleDeps dependency))) pkg

@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Registry.Audit (runRegistryAudit, RegistryAuditOptions (..)) where++import HWM.Core.Formatting (Color (..), chalk)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (..))+import HWM.Domain.Bounds (BoundCompliance (..), auditBounds, auditHasAny, formatAudit, updateDepBounds)+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, config, updateConfig)+import HWM.Domain.Dependencies (mapDeps, mapWithName)+import HWM.Domain.Environments (getTestedRange)+import HWM.Integrations.Toolchain.Package (syncPackages)+import HWM.Runtime.UI (indent, printGenTable, putLine, section, sectionConfig, sectionTableM)+import Options.Applicative+import Relude++data RegistryAuditOptions = RegistryAuditOptions {auditFix :: Bool, auditForce :: Bool} deriving (Show)++instance ParseCLI RegistryAuditOptions where+  parseCLI =+    RegistryAuditOptions+      <$> switch (long "fix" <> help "Automatically fix issues")+      <*> switch (long "force" <> help "Force actions")++runRegistryAudit :: RegistryAuditOptions -> ConfigT ()+runRegistryAudit RegistryAuditOptions {..} = do+  originalRegistry <- asks (cfgRegistry . config)+  range <- getTestedRange+  sectionTableM 16 "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."+    else do+      if auditFix+        then ((\cf -> pure $ cf {cfgRegistry = mapDeps (updateDepBounds auditForce range) originalRegistry}) `updateConfig`) $ do+          sectionConfig 0 [("hwm.yaml", pure $ chalk Green "✓")]+          syncPackages+        else do+          injectIssue+            ( Issue+                { issueDetails = Nothing,+                  issueMessage = "Found " <> show (length dependencyAudits - errorCount) <> " outdated dependencies: Run 'hwm registry audit --fix --force' to update.",+                  issueTopic = "registry",+                  issueSeverity = SeverityWarning+                }+            )+          when (errorCount > 0)+            $ injectIssue+              ( Issue+                  { issueDetails = Nothing,+                    issueMessage = "Found " <> show errorCount <> " outdated dependencies: Run 'hwm registry audit --fix' to update.",+                    issueTopic = "registry",+                    issueSeverity = SeverityError+                  }+              )

@@ -0,0 +1,26 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Registry.Ls (runRegistryLs, RegistryLsOptions (..)) where++import qualified Data.Text as T+import HWM.Core.Formatting (Format (..), formatTable)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, config)+import HWM.Domain.Dependencies (toDependencyList)+import HWM.Runtime.UI (putLine, section)+import Options.Applicative (help, long, metavar, short, strOption)+import Relude++newtype RegistryLsOptions = RegistryLsOptions {regSearch :: Maybe Text} deriving (Show)++instance ParseCLI RegistryLsOptions where+  parseCLI = RegistryLsOptions <$> optional (strOption (long "search" <> short 's' <> metavar "SEARCH" <> help "Filter registry entries"))++runRegistryLs :: RegistryLsOptions -> ConfigT ()+runRegistryLs RegistryLsOptions {regSearch} = do+  deps <- asks (toDependencyList . cfgRegistry . config)+  let filtered = maybe deps (\s -> filter (T.isInfixOf s . format) deps) regSearch+  section "registry" $ forM_ (formatTable (map format filtered)) putLine

@@ -0,0 +1,150 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Redundant $" #-}++module HWM.CLI.Command.Release.Artifacts+  ( ReleaseArchiveOptions (..),+    parseCLI,+    runReleaseArchive,+  )+where++import Control.Monad.Except (MonadError (..))+import qualified Data.Map as Map+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.Parsing (Parse (..), ParseCLI (..), parseLS)+import HWM.Core.Pkg (Pkg (..))+import HWM.Core.Result (fromEither)+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, Env (..), getArchiveConfigs)+import HWM.Domain.Release (ArchiveFormat, ArtifactConfig (..))+import HWM.Domain.Workspace (resolveWorkspaces)+import HWM.Integrations.Toolchain.Stack (stackGenBinary)+import HWM.Runtime.Archive (ArchiveInfo (..), ArchivingPlan (..), createArchive)+import HWM.Runtime.Network (uploadToGitHub)+import HWM.Runtime.UI (indent, mapMTable, putLine, section, sectionTableM)+import Options.Applicative (help, long, metavar, option, showDefault, str, strOption, value)+import Relude+import System.Directory (createDirectoryIfMissing, removePathForcibly)+import System.FilePath (joinPath)++-- | Options for 'hwm release archive'+data ReleaseArchiveOptions = ReleaseArchiveOptions+  { targetName :: Maybe Text,+    ghPublishUrl :: Maybe Text,+    outputDir :: FilePath,+    ovFormat :: Maybe [Text],+    overrides :: ArchiveOverrides+  }+  deriving (Show)++data ArchiveOverrides = ArchiveOverrides+  { ovGhcOptions :: Maybe [Text],+    ovNameTemplate :: Maybe Text+  }+  deriving (Show)++instance ParseCLI ArchiveOverrides where+  parseCLI =+    ArchiveOverrides+      <$> optional (option (parseLS <$> str) (long "ghc-options" <> metavar "GHC_OPTION" <> help "Override GHC options for the release target. Can be specified multiple times."))+      <*> optional (strOption (long "name-template" <> metavar "NAME_TEMPLATE" <> help "Override the name template for the release target. Use {name} and {version} as placeholders."))++instance ParseCLI ReleaseArchiveOptions where+  parseCLI =+    ReleaseArchiveOptions+      <$> optional (strOption (long "target" <> metavar "TARGET" <> help "Name of the release target to build. If not specified, all targets will be built."))+      <*> optional (strOption (long "gh-upload" <> metavar "UPLOAD_URL" <> help "URL to upload the release artifact. If not specified, the artifact will not be uploaded."))+      <*> strOption+        ( long "output-dir"+            <> metavar "OUTPUT_DIR"+            <> help "Directory to output the release artifacts."+            <> value ".hwm/dist"+            <> showDefault+        )+      <*> optional (option (parseLS <$> str) (long "format" <> metavar "FORMAT" <> help "Override the archive format for the release target. Supported: zip, tar.gz."))+      <*> parseCLI++genBindaryDir :: (MonadIO m, ToString a) => a -> m FilePath+genBindaryDir name = do+  let path = joinPath [".hwm/release/binaries", toString name]+  prepeareDir path+  pure path++ghcOptions :: [Text] -> [Text]+ghcOptions [] = []+ghcOptions xs = ["--ghc-options=" <> T.unwords xs]++prepeareDir :: (MonadIO m) => FilePath -> m ()+prepeareDir dir = liftIO $ do+  removePathForcibly dir+  createDirectoryIfMissing True dir++applyOverrieds :: Maybe [ArchiveFormat] -> ArchiveOverrides -> ArtifactConfig -> ArtifactConfig+applyOverrieds formats ArchiveOverrides {..} cfg =+  cfg+    { arcFormats = fromMaybe (arcFormats cfg) formats,+      arcGhcOptions = fromMaybe (arcGhcOptions cfg) ovGhcOptions,+      arcNameTemplate = fromMaybe (arcNameTemplate cfg) ovNameTemplate+    }++parseFormats :: [Text] -> ConfigT [ArchiveFormat]+parseFormats = fromEither "can't parse archive format" . traverse parse++withOverrides :: ReleaseArchiveOptions -> Map Name ArtifactConfig -> ConfigT [(Name, ArtifactConfig)]+withOverrides ReleaseArchiveOptions {..} cfgs = do+  parsedFormats <- traverse parseFormats ovFormat+  case targetName of+    Just target -> case Map.lookup target cfgs of+      Just cfg -> pure [(target, applyOverrieds parsedFormats overrides cfg)]+      Nothing -> throwError $ fromString $ "Target \"" <> toString target <> "\" not found in configuration."+    Nothing -> pure $ map (second (applyOverrieds parsedFormats overrides)) (Map.toList cfgs)++runReleaseArchive :: ReleaseArchiveOptions -> ConfigT ()+runReleaseArchive ops@ReleaseArchiveOptions {..} = do+  prepeareDir outputDir+  version <- asks (cfgVersion . config)+  cfgs <- getArchiveConfigs >>= withOverrides ops++  sectionTableM 0 "artifacts"+    $ [ ("mode", pure $ if isNothing ghPublishUrl then "local" else "publish to GitHub"),+        ("output directory", pure $ T.pack outputDir),+        ("targets", pure $ formatList "," (map fst cfgs))+      ]++  plans <- mapMTable "build" $ map (\x -> (fst x, buildPkg x)) cfgs++  section "archive" $ pure ()+  artifacts <- for plans $ \(name, plan) -> do+    archives <- createArchive version plan+    indent 1+      $ section name+      $ for_ archives+      $ \ArchiveInfo {..} -> do+        putLine $ subPathSign <> format archivePath+        putLine $ subPathSign <> format sha256Path+    pure (name, archives)++  for_ ghPublishUrl $ \uploadUrl -> section "publish (github)"+    $ for_ artifacts+    $ \(name, archives) -> section name+      $ for_ archives+      $ \ArchiveInfo {..} -> do+        uploadToGitHub uploadUrl archivePath+        putLine "gh published"+        uploadToGitHub uploadUrl sha256Path+        putLine "checksum published"+  where+    buildPkg (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+      stackGenBinary pkgName binaryDir (ghcOptions arcGhcOptions)+      pure $ (statusIcon Checked, ArchivingPlan {nameTemplate = arcNameTemplate, outDir = outputDir, sourceDir = binaryDir, name = executableName, archiveFormats = arcFormats})

@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Release.Publish+  ( PublishOptions (..),+    runPublish,+  )+where++import Control.Monad.Error.Class (MonadError (..))+import qualified Data.Map as Map+import HWM.Core.Common (Name)+import HWM.Core.Formatting+  ( Color (..),+    Format (..),+    chalk,+    genMaxLen,+    padDots,+    statusIcon,+  )+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Core.Pkg (Pkg (..), pkgId)+import HWM.Core.Result (Issue, Severity (..), maxSeverity)+import HWM.Domain.Config (Config (cfgRelease))+import HWM.Domain.ConfigT (ConfigT, Env (..), askVersion)+import HWM.Domain.Dependencies (sortByDependencyHierarchy)+import HWM.Domain.Release (Release (..))+import HWM.Domain.Workspace (WsPkgs, allPackages, resolveWsPkgs)+import HWM.Integrations.Toolchain.Package (deriveRegistry)+import HWM.Integrations.Toolchain.Stack (sdist, upload)+import HWM.Runtime.UI (printSummary, putLine, section, sectionTableM)+import Options.Applicative (argument, help, metavar, str)+import Relude hiding (intercalate)++failIssues :: [Issue] -> ConfigT ()+failIssues [] = pure ()+failIssues issues = do+  printSummary issues+  when (maxSeverity issues == Just SeverityError) $ liftIO exitFailure++newtype PublishOptions = PublishOptions+  { publishGroup :: Maybe Name+  }+  deriving (Show)++instance ParseCLI PublishOptions where+  parseCLI =+    PublishOptions+      <$> optional (argument str (metavar "GROUP" <> help "Name of the workspace group to publish (default: all)"))++arrangePackageRelease :: [Pkg] -> ConfigT [Pkg]+arrangePackageRelease pkgs = do+  (_, graph) <- allPackages >>= deriveRegistry+  sortByDependencyHierarchy graph pkgs++collectGroups :: Maybe Name -> ConfigT WsPkgs+collectGroups Nothing = do+  pbMap <- fromMaybe mempty . (>>= rlsPublish) <$> asks (cfgRelease . config)+  concat <$> traverse resolveWsPkgs (Map.elems pbMap)+collectGroups (Just name) = do+  pbMap <- fromMaybe mempty . (>>= rlsPublish) <$> asks (cfgRelease . config)+  case Map.lookup name pbMap of+    Just pbList -> resolveWsPkgs pbList+    Nothing -> throwError $ fromString $ toString $ "No publish configuration found for group \"" <> name <> "\". Check release configuration."++runPublish :: PublishOptions -> ConfigT ()+runPublish PublishOptions {..} = do+  wgs <- collectGroups publishGroup+  version <- askVersion+  when (null wgs) $ throwError "No publishable groups found. Check workspace group configuration."+  sectionTableM+    0+    "publish"+    [ ("version", pure $ chalk Magenta (format version)),+      ("target", pure $ chalk Cyan (fromMaybe "all" publishGroup)),+      ("registry", pure "hackage")+    ]++  pkgs <- arrangePackageRelease (concatMap snd wgs)+  let size = genMaxLen (map pkgId pkgs)+  section "publishing plan (topological sort)" $ do+    for_ (zip pkgs [1 ..] :: [(Pkg, Int)]) $ \(pkg, idx) -> do+      putLine $ "└── " <> padDots size (pkgId pkg) <> show idx++  issues <- traverse sdist (concatMap snd wgs)+  failIssues (concat issues)++  section "publishing" $ do+    for_ pkgs $ \pkg -> do+      (status, publishIssues) <- upload pkg+      putLine $ "└── " <> padDots size (pkgId pkg) <> statusIcon status+      failIssues publishIssues

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Release.Root+  ( ReleaseCommand (..),+    runRelease,+  )+where++import HWM.CLI.Command.Release.Artifacts (ReleaseArchiveOptions, runReleaseArchive)+import HWM.CLI.Command.Release.Publish (PublishOptions, runPublish)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import Options.Applicative (command, hsubparser, info, progDesc)+import Relude++-- | Top-level parser for 'release' command+data ReleaseCommand+  = ReleaseArchive ReleaseArchiveOptions+  | Publish PublishOptions+  deriving (Show)++instance ParseCLI ReleaseCommand where+  parseCLI =+    hsubparser+      ( command "artifacts" (info (ReleaseArchive <$> parseCLI) (progDesc "Build, archive, hash, and export a package release"))+          <> command "publish" (info (Publish <$> parseCLI) (progDesc "Publish a package release to Hackage"))+      )++runRelease :: ReleaseCommand -> ConfigT ()+runRelease (ReleaseArchive opts) = runReleaseArchive opts+runRelease (Publish opts) = runPublish opts

@@ -5,7 +5,7 @@  module HWM.CLI.Command.Run   ( runScript,-    ScriptOptions (..),+    ScriptOptions,   ) where @@ -13,45 +13,58 @@ import Control.Monad.Error.Class (MonadError (..)) import Data.List (intersect) import qualified Data.Map as M-import qualified Data.Set as S 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.ConfigT (ConfigT, askWorkspaceGroups, config)-import HWM.Domain.Matrix (BuildEnvironment (..), getBuildEnvironment, getBuildEnvroments)-import HWM.Domain.Workspace (resolveTargets)+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.Cache (prepareDir) import HWM.Runtime.Logging (logError, logRoot) import HWM.Runtime.Process (inheritRun, silentRun) import HWM.Runtime.UI (putLine, runSpinner, sectionEnvironments, sectionWorkspace, statusIndicator)+import Options.Applicative+  ( argument,+    help,+    long,+    metavar,+    short,+    str,+  ) import Relude  data ScriptOptions = ScriptOptions-  { scriptName :: Name,-    scriptTargets :: [Name],+  { scriptTargets :: [Name],     scriptEnvs :: [Name],     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"] = getBuildEnvroments+getEnvs ["all"] = getBuildEnvironments getEnvs names = for names (getBuildEnvironment . Just) -runScript :: ScriptOptions -> ConfigT ()-runScript ScriptOptions {..} = do+runScript :: Name -> ScriptOptions -> ConfigT ()+runScript scriptName ScriptOptions {..} = do   prepareDir logRoot   cfg <- asks config-  case M.lookup scriptName (scripts cfg) of+  case M.lookup scriptName (cfgScripts cfg) of     Just script -> do       envs <- getEnvs scriptEnvs-      ws <- askWorkspaceGroups-      targets <- fmap (S.toList . S.fromList) (resolveTargets ws scriptTargets)+      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)@@ -63,7 +76,7 @@           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 (for_ (map buildName envs) (run . Just))+            sectionEnvironments Nothing (for_ (map buildName envs) (run . Just))         else run Nothing     Nothing -> throwError $ fromString $ toString $ "Script not found: " <> scriptName @@ -91,7 +104,7 @@     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 $ putLine $ format benv+      sectionEnvironments Nothing $ putLine $ format benv       putLine ""       putLine ("❯ " <> cmd)       inheritRun yamlPath cmd

@@ -3,36 +3,24 @@  module HWM.CLI.Command.Status (showStatus) where -import HWM.Core.Formatting (Color (..), Format (..), chalk, genMaxLen, monadStatus, padDots, statusIcon, subPathSign)-import HWM.Core.Pkg (Pkg (..))-import qualified HWM.Domain.Config as C+import HWM.Core.Formatting (Color (..), Format (..), chalk)+import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, config)-import HWM.Domain.Matrix (getBuildEnvironment, getBuildEnvroments, printEnvironments)-import HWM.Domain.Workspace (memberPkgs, pkgGroupName)+import HWM.Domain.Environments (printEnvironments)+import HWM.Domain.Workspace (forWorkspace) import HWM.Integrations.Toolchain.Package (validatePackage)-import HWM.Runtime.UI (putLine, sectionTableM, sectionWorkspace)+import HWM.Runtime.UI (sectionTableM) import Relude  -- | Main status command - displays project info and package statuses showStatus :: ConfigT () showStatus = do   cfg <- asks config-  active <- getBuildEnvironment Nothing-  environments <- getBuildEnvroments   sectionTableM     0     "project"-    [ ("name", pure $ chalk Magenta (C.name cfg)),-      ("version", pure $ chalk Green (format $ C.version cfg))+    [ ("name", pure $ chalk Magenta (cfgName cfg)),+      ("version", pure $ chalk Green (format $ cfgVersion cfg))     ]-  printEnvironments active environments-  sectionWorkspace-    $ for_ (C.workspace cfg)-    $ \g -> do-      putLine ""-      putLine $ "• " <> chalk Bold (pkgGroupName g)-      pkgs <- memberPkgs g-      let maxLen = genMaxLen (map pkgMemberId pkgs)-      for_ pkgs $ \pkg -> do-        status <- monadStatus (validatePackage pkg)-        putLine $ subPathSign <> padDots maxLen (pkgMemberId pkg) <> statusIcon status+  printEnvironments Nothing+  forWorkspace validatePackage

@@ -6,7 +6,7 @@ import HWM.Core.Common (Name) import HWM.Core.Formatting (Color (..), Format (..), chalk) import HWM.Domain.ConfigT (ConfigT)-import HWM.Domain.Matrix (BuildEnvironment (..), getBuildEnvironment)+import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment) import HWM.Integrations.Toolchain.Hie (syncHie) import HWM.Integrations.Toolchain.Package (syncPackages) import HWM.Integrations.Toolchain.Stack (syncStackYaml)

@@ -4,38 +4,64 @@  module HWM.CLI.Command.Version   ( runVersion,+    VersionOptions,   ) where  import HWM.Core.Formatting (Color (..), Format (..), chalk)-import HWM.Core.Version (Bump, nextVersion)-import HWM.Domain.Bounds (versionBounds)+import HWM.Core.Parsing (Parse (..), ParseCLI (parseCLI))+import HWM.Core.Result (Issue (..), MonadIssue (injectIssue), Severity (..))+import HWM.Core.Version (VersionChange (..), nextVersion) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, config, updateConfig) import HWM.Integrations.Toolchain.Package (syncPackages) import HWM.Runtime.UI (putLine, sectionConfig, sectionTableM)+import Options.Applicative (argument, help, metavar)+import Options.Applicative.Builder (str) import Relude  size :: Int size = 16 -bumpVersion :: Bump -> Config -> ConfigT Config-bumpVersion bump Config {..} = do-  let version' = nextVersion bump version+newtype VersionOptions = VersionOptions {bump :: Maybe VersionChange} deriving (Show)++instance ParseCLI VersionOptions where+  parseCLI = VersionOptions <$> optional (argument (str >>= parse) (metavar "BUMP" <> help "Bump the version. Can be one of: major, minor, patch, or a specific version like 1.2.3"))++bumpVersion :: VersionChange -> Config -> ConfigT Config+bumpVersion (BumpVersion bump) Config {..} = do+  let version' = nextVersion bump cfgVersion   sectionTableM     size     ("bump version (" <> format bump <> ")")-    [ ("from", pure $ format version),+    [ ("from", pure $ format cfgVersion),       ("to", pure $ chalk Cyan (format version'))     ]+  pure Config {cfgVersion = version', cfgBounds = Nothing, ..}+bumpVersion (FixedVersion version') Config {..} = do+  sectionTableM+    size+    "set version"+    [ ("from", pure $ format cfgVersion),+      ("to", pure $ chalk Cyan (format version') <> if version' == cfgVersion then " (no change)" else "")+    ] -  let bounds' = versionBounds version'-  pure Config {version = version', bounds = bounds', ..}+  when (version' < cfgVersion)+    $ injectIssue+      ( Issue+          { issueTopic = "version",+            issueSeverity = SeverityWarning,+            issueMessage = "The specified version is lower than the current version. This may cause issues with package managers and should be done with caution.",+            issueDetails = Nothing+          }+      ) -runVersion :: Maybe Bump -> ConfigT ()-runVersion (Just bump) = (bumpVersion bump `updateConfig`) $ do+  pure Config {cfgVersion = version', ..}++runVersion :: VersionOptions -> ConfigT ()+runVersion (VersionOptions (Just bump)) = (bumpVersion bump `updateConfig`) $ do   sectionConfig size [("hwm.yaml", pure $ chalk Green "✓")]   syncPackages-runVersion Nothing = do-  putLine . format . version =<< asks config+runVersion (VersionOptions Nothing) = do+  putLine . format . cfgVersion =<< asks config   exitSuccess

@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Workspace+  ( WorkspaceCommand (..),+    runWorkspace,+  )+where++import HWM.CLI.Command.Workspace.Add (WorkspaceAddOptions, runWorkspaceAdd)+import HWM.CLI.Command.Workspace.Ls (WorkspaceLsOptions, runWorkspaceLs)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import Options.Applicative (command, info, progDesc, subparser)+import Relude++-- | Subcommands for `hwm workspace`+data WorkspaceCommand+  = WorkspaceAdd WorkspaceAddOptions+  | WorkspaceLs WorkspaceLsOptions+  deriving (Show)++runWorkspace :: WorkspaceCommand -> ConfigT ()+runWorkspace cmd = case cmd of+  WorkspaceAdd opts -> runWorkspaceAdd opts+  WorkspaceLs opts -> runWorkspaceLs opts++instance ParseCLI WorkspaceCommand where+  parseCLI =+    subparser+      ( mconcat+          [ command "add" (info (WorkspaceAdd <$> parseCLI) (progDesc "Add a new workspace.")),+            command "ls" (info (WorkspaceLs <$> parseCLI) (progDesc "List all workspaces."))+          ]+      )

@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Workspace.Add (WorkspaceAddOptions, runWorkspaceAdd) where++import Control.Monad.Error.Class (MonadError (throwError))+import qualified Data.Map as Map+import HWM.Core.Formatting (Color (..), Status (Checked), chalk, displayStatus, padDots, subPathSign)+import HWM.Core.Parsing (ParseCLI (..))+import HWM.Core.Pkg (PkgName (..), mkPkgDirPath, resolvePrefix)+import HWM.Core.Result (Issue (..), MonadIssue (injectIssue), Severity (SeverityError, SeverityWarning))+import HWM.Domain.Config (Config (..))+import HWM.Domain.ConfigT (ConfigT, Env (config), updateConfig)+import HWM.Domain.Workspace (WorkGroup (..), WorkspaceRef (..), addWorkgroupMember, parseWorkspaceRef)+import HWM.Integrations.Scaffold (scaffoldPackage)+import HWM.Integrations.Toolchain.Hie (syncHie)+import HWM.Integrations.Toolchain.Stack (syncStackYaml)+import HWM.Runtime.UI (putLine, sectionConfig, sectionWorkspace)+import Options.Applicative (help, long, metavar, strArgument, strOption)+import Relude++data WorkspaceAddOptions = WorkspaceAddOptions+  { opsWorkspaceId :: WorkspaceRef,+    opsWorkspaceDir :: Maybe FilePath,+    opsPrefix :: Maybe Text+  }+  deriving (Show)++instance ParseCLI WorkspaceAddOptions where+  parseCLI =+    (WorkspaceAddOptions . parseWorkspaceRef <$> strArgument (metavar "NAME" <> help "Name of the workspace to add"))+      <*> optional (strOption (long "dir" <> help "Directory for the workspace (defaults to group name)"))+      <*> optional (strOption (long "prefix" <> help "Prefix to add to all member package names"))++runWorkspaceAdd :: WorkspaceAddOptions -> ConfigT ()+runWorkspaceAdd (WorkspaceAddOptions {opsWorkspaceId = WorkspaceRef groupId Nothing, ..}) = do+  wss <- asks (cfgWorkspace . config)+  if Map.member groupId wss+    then+      throwError+        Issue+          { issueTopic = groupId,+            issueMessage = "A workspace group \"" <> groupId <> "\" already exists.",+            issueSeverity = SeverityError,+            issueDetails = Nothing+          }+    else do+      let ws = Map.insert groupId (WorkGroup opsWorkspaceDir [] opsPrefix) wss+      updateConfig (\cfg -> pure $ cfg {cfgWorkspace = ws}) $ sectionWorkspace $ do+        putLine ""+        putLine $ "• " <> chalk Bold groupId <> " " <> displayStatus [("added", Checked)]+runWorkspaceAdd (WorkspaceAddOptions {opsWorkspaceId = WorkspaceRef groupId (Just memberId), ..}) = do+  when (isJust opsPrefix) $ injectIssue (noEffect "prefix")+  when (isJust opsWorkspaceDir) $ injectIssue (noEffect "dir")+  (ws, w) <- addWorkgroupMember groupId memberId+  scaffoldPackage (mkPkgDirPath (dir w) (prefix w) memberId) (PkgName $ resolvePrefix (prefix w) memberId)+  updateConfig (\cfg -> pure $ cfg {cfgWorkspace = ws})+    $ sectionWorkspace+    $ do+      putLine ""+      putLine $ "• " <> chalk Bold groupId+      putLine $ subPathSign <> padDots 16 memberId <> displayStatus [("added", Checked)]+      sectionConfig+        0+        [ ("stack.yaml", syncStackYaml $> chalk Green "✓"),+          ("hie.yaml", syncHie $> chalk Green "✓")+        ]+  pure ()+  where+    noEffect label =+      Issue+        { issueTopic = memberId,+          issueMessage = "option \"--" <> label <> "\" is only relevant when adding a workspace group. They have no effect when adding a member package.",+          issueSeverity = SeverityWarning,+          issueDetails = Nothing+        }

@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.CLI.Command.Workspace.Ls (WorkspaceLsOptions, runWorkspaceLs) where++import HWM.Core.Parsing (ParseCLI (..))+import HWM.Domain.ConfigT (ConfigT)+import HWM.Domain.Workspace (forWorkspace)+import HWM.Integrations.Toolchain.Package (validatePackage)+import Relude++data WorkspaceLsOptions = WorkspaceLsOptions+  deriving (Show)++instance ParseCLI WorkspaceLsOptions where+  parseCLI = pure WorkspaceLsOptions++runWorkspaceLs :: WorkspaceLsOptions -> ConfigT ()+runWorkspaceLs _ = forWorkspace validatePackage

@@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Eta reduce" #-}+ module HWM.Core.Formatting   ( Color (..),     chalk,@@ -26,6 +29,7 @@     formatTable,     formatList,     monadStatus,+    formatTemplate,   ) where @@ -101,6 +105,13 @@   let status = deriveStatus (map snd ls)    in if isOk status then statusIcon status else formatStatus ls +formatTemplate :: [(Text, Text)] -> Text -> Text+formatTemplate vars template =+  foldl' applyVar template vars+  where+    applyVar current (key, val) =+      T.replace ("{{" <> key <> "}}") val current+ padDots :: Int -> Text -> Text padDots width s = s <> " " <> chalk Dim (T.replicate (max 0 (width - T.length s)) ".") <> " " @@ -205,7 +216,7 @@             else fromMaybe name (T.stripPrefix "-" name)  indentBlockNum :: Int -> Text -> Text-indentBlockNum i = indentBlock (T.replicate i " ")+indentBlockNum i = indentBlock (T.replicate (i * 2) " ")  indentBlock :: Text -> Text -> Text indentBlock prefix text

@@ -13,6 +13,11 @@     genUrl,     Parse (..),     parseOptions,+    parsePkgString,+    ParseCLI (..),+    flag,+    ignoreSpaces,+    parseLS,   ) where @@ -29,6 +34,8 @@     uncons,   ) import qualified Data.Text as T+import Options.Applicative (Mod, Parser, help, long, short, strOption, switch)+import Options.Applicative.Builder (OptionFields) import Relude hiding   ( break,     drop,@@ -42,9 +49,15 @@  type SourceText = Text -parseOptions :: [Text] -> [Text]-parseOptions raw = raw >>= (map T.strip . T.splitOn ",")+flag :: Char -> String -> String -> Parser Bool+flag s l h = switch (long l <> short s <> help h) +parseOptions :: Mod OptionFields Text -> Parser [Text]+parseOptions x = fmap (>>= parseLS) (many (strOption x))++parseLS :: Text -> [Text]+parseLS = map T.strip . T.splitOn ","+ parseField :: SourceText -> (SourceText, SourceText) parseField = second (strip . drop 1) . breakAt (== ':') @@ -82,6 +95,17 @@ class Parse a where   parse :: (MonadFail m) => Text -> m a +class ParseCLI a where+  parseCLI :: Parser a+ instance Parse Int where   parse t =     maybe (fail $ "Could not parse Int: '" <> toString t <> "'!") pure (readMaybe $ toString t)++parsePkgString :: Text -> (Text, Text)+parsePkgString input =+  let base = T.takeWhile (/= '@') input+      (namePart, versionPart) = T.breakOnEnd "-" base+   in if T.null versionPart || T.null namePart+        then (base, "")+        else (T.dropEnd 1 namePart, versionPart)

@@ -10,13 +10,15 @@  module HWM.Core.Pkg   ( Pkg (..),-    PkgName,+    PkgName (..),     makePkg,     pkgFile,     pkgYamlPath,     pkgId,     scanPkgs,     cabalFilePath,+    mkPkgDirPath,+    resolvePrefix,   ) where @@ -84,9 +86,12 @@       pkgDirPath = dir     } +mkPkgDirPath :: Maybe String -> Maybe Text -> Text -> FilePath+mkPkgDirPath root prefix memberName = resolvePath root (resolvePrefix prefix memberName)+ makePkg :: (MonadIO m, MonadError Issue m) => Text -> Maybe FilePath -> Maybe Name -> Name -> m Pkg makePkg groupName root prefix memberName = do-  let pkgDirPath = resolvePath root (resolvePrefix prefix memberName)+  let pkgDirPath = mkPkgDirPath root prefix memberName   json <- getPkgInfo pkgDirPath   pure $ toPkg json groupName memberName pkgDirPath 

@@ -13,6 +13,7 @@     nextVersion,     dropPatch,     parseGHCVersion,+    VersionChange (..),   ) where @@ -64,9 +65,10 @@   format = formatList "." . toSeries  instance Parse Version where-  parse s = either (fail . toString . (prefix <>)) pure (sepBy "." s >>= fromSeries)+  parse s = either tofail pure (sepBy "." vNumbers >>= fromSeries)     where-      prefix = "invalid version(" <> s <> ")" <> ": "+      vNumbers = fromMaybe s (T.stripPrefix "v" s)+      tofail x = fail $ toString ("invalid version(" <> s <> ")" <> ": " <> x)  fromSeries :: (MonadFail m) => [Int] -> m Version fromSeries [] = fail "version should have at least one number!"@@ -136,3 +138,13 @@  parseGHCVersion :: (MonadFail m) => Text -> m Version parseGHCVersion text = parse (fromMaybe text (T.stripPrefix "ghc-" text))++data VersionChange = FixedVersion Version | BumpVersion Bump deriving (Show)++isBump :: Text -> Bool+isBump = (`elem` ["major", "minor", "patch"])++instance Parse VersionChange where+  parse x+    | isBump x = BumpVersion <$> parse x+    | otherwise = FixedVersion <$> parse x

@@ -8,34 +8,39 @@ {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Domain.Bounds-  ( Bounds,+  ( Bounds (..),     BoundsByName,     versionBounds,     updateDepBounds,-    getBound,     Bound (..),     Restriction (..),-    printUpperBound,     hasBounds,-    boundsScore,     boundsBetter,+    auditBounds,+    BoundAudit (..),+    BoundCompliance (..),+    BoundsAudit (..),+    formatAudit,+    auditHasAny,+    TestedRange (..),+    deriveBounds,   ) where -import Control.Monad.Except (MonadError)+import Control.Monad.Except import Data.Aeson   ( FromJSON (..),     ToJSON (..),     Value (..),   )-import Data.List (maximum, minimum)-import HWM.Core.Formatting (Format (..), formatList)+import HWM.Core.Formatting (Color (..), Format (..), chalk, formatList, padDots) import HWM.Core.Has (Has) import HWM.Core.Parsing (Parse (..), fromToString, removeHead, sepBy, unconsM) import HWM.Core.Pkg (PkgName) import HWM.Core.Result (Issue) import HWM.Core.Version (Bump (..), Version, dropPatch, nextVersion)-import HWM.Runtime.Cache (Cache, getVersions)+import HWM.Runtime.Cache (Cache, Snapshot, getVersion, getVersions)+import HWM.Runtime.UI import Relude  data Restriction = Min | Max deriving (Show, Eq, Ord)@@ -62,7 +67,7 @@ instance Format Bound where   format Bound {..} = unwords $ (toText restriction <> eq) : [toText version]     where-      eq = if orEquals then "=" else ""+      eq = if orEquals then "=" else " "  instance Ord Bound where   compare a b =@@ -78,17 +83,24 @@     version <- parse value     pure Bound {..} -newtype Bounds = Bounds [Bound]+data Bounds = Bounds+  { lowerBound :: Maybe Bound,+    upperBound :: Maybe Bound+  }   deriving (Generic, Show, Eq)  type BoundsByName = '[]  instance Parse Bounds where-  parse "" = pure $ Bounds []-  parse str = Bounds <$> sepBy "&&" str+  parse "" = pure $ Bounds Nothing Nothing+  parse str = do+    bounds <- sepBy "&&" str+    let lower = find (\Bound {..} -> restriction == Min) bounds+    let upper = find (\Bound {..} -> restriction == Max) bounds+    pure $ Bounds lower upper  instance Format Bounds where-  format (Bounds xs) = formatList " && " $ sort xs+  format (Bounds lower upper) = formatList " && " $ sort $ catMaybes [lower, upper]  instance ToString Bounds where   toString = toString . format@@ -103,46 +115,114 @@ versionBounds :: Version -> Bounds versionBounds version =   Bounds-    [ Bound Min True (dropPatch version),-      Bound Max False (nextVersion Minor version)-    ]--getBound :: Restriction -> Bounds -> [Bound]-getBound v (Bounds xs) = maybeToList $ find (\Bound {..} -> restriction == v) xs--printUpperBound :: Bounds -> Text-printUpperBound bounds = case getBound Max bounds of-  [Bound {version}] -> format version-  _ -> ""+    { lowerBound = Just $ Bound Min True (dropPatch version),+      upperBound = Just $ Bound Max False (nextVersion Minor version)+    }  hasBounds :: Bounds -> Bool-hasBounds b =-  let lower = getBound Min b-      upper = getBound Max b-   in not (null lower && null upper)+hasBounds Bounds {..} = isJust lowerBound || isJust upperBound  boundsScore :: Bounds -> Int-boundsScore b = length (getBound Min b) + length (getBound Max b)+boundsScore Bounds {..} = length (maybeToList lowerBound) + length (maybeToList upperBound)  boundsBetter :: Bounds -> Bounds -> Bool boundsBetter a b = boundsScore a > boundsScore b -getLatest :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Cache) => PkgName -> m Bound-getLatest = fmap (Bound Max True . head) . getVersions+auditBound :: Maybe Bound -> Maybe Version -> (Version -> Version -> Bool) -> BoundAudit+auditBound registryBound matrixVersion isConflict+  | null registryBound = BoundAudit {auditStatus = Missing, ..}+  | match isConflict registryBound matrixVersion = BoundAudit {auditStatus = Conflict, ..}+  | match (flip isConflict) registryBound matrixVersion = BoundAudit {auditStatus = Unverified, ..}+  | otherwise = BoundAudit {auditStatus = Valid, ..}+  where+    match :: (Version -> Version -> Bool) -> Maybe Bound -> Maybe Version -> Bool+    match f (Just Bound {version}) (Just target) = f version target+    match _ _ _ = False -updateDepBounds :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Cache) => PkgName -> Bounds -> m Bounds-updateDepBounds name bounds = do-  latest <- getLatest name-  let upper = getBound Max bounds-  let newVersion = maximum (latest : upper)-  _min <- initiateMin name bounds-  pure (Bounds (_min <> [newVersion]))+updateBound :: Bool -> Restriction -> BoundCompliance -> Maybe Bound -> Maybe Version -> Maybe Bound+updateBound forceOverride res compliance registryBound matrixVersion+  | compliance == Conflict = preferMatrix+  | forceOverride && compliance == Unverified = preferMatrix+  | otherwise = registryBound <|> matrixBound+  where+    preferMatrix = matrixBound <|> registryBound+    matrixBound = Bound res True <$> matrixVersion -initiateMin :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Cache) => PkgName -> Bounds -> m [Bound]-initiateMin name bounds = do-  let mi = getBound Min bounds-  if null mi-    then do-      ls <- fmap (Bound Min True) <$> getVersions name-      pure [minimum ls]-    else pure mi+auditBounds :: TestedRange -> PkgName -> Bounds -> BoundsAudit+auditBounds TestedRange {..} name Bounds {..} =+  BoundsAudit+    { auditPkgName = name,+      auditMinBound = auditBound lowerBound (getVersion name legacy) (>),+      auditMaxBound = auditBound upperBound (getVersion name nightly) (<)+    }++updateDepBounds :: Bool -> TestedRange -> PkgName -> Bounds -> Bounds+updateDepBounds forceOverride TestedRange {..} name Bounds {..} =+  Bounds+    { lowerBound = updateBound forceOverride Min (auditStatus $ auditMinBound audit) lowerBound (getVersion name legacy),+      upperBound = updateBound forceOverride Max (auditStatus $ auditMaxBound audit) upperBound (getVersion name nightly)+    }+  where+    audit = auditBounds TestedRange {..} name Bounds {..}++auditHasAny :: (BoundCompliance -> Bool) -> BoundsAudit -> Bool+auditHasAny f BoundsAudit {..} = any (f . auditStatus) [auditMinBound, auditMaxBound]++data BoundCompliance+  = Conflict+  | Unverified+  | Missing+  | Valid+  deriving (Show, Eq)++data BoundAudit = BoundAudit+  { registryBound :: Maybe Bound,+    matrixVersion :: Maybe Version,+    auditStatus :: BoundCompliance+  }+  deriving (Show, Eq)++formatStatus :: BoundCompliance -> Text+formatStatus Conflict = chalk Red "-> "+formatStatus Unverified = chalk Yellow "-> "+formatStatus Missing = chalk Cyan " ! "+formatStatus Valid = chalk Green " ✓ "++formatBoundAudit :: BoundAudit -> [Text]+formatBoundAudit (BoundAudit Nothing Nothing s) = ["", formatStatus s]+formatBoundAudit (BoundAudit Nothing (Just x) s) = [chalk Dim (format x), formatStatus s]+formatBoundAudit (BoundAudit (Just x) Nothing s) = [chalk Dim (format x), formatStatus s]+formatBoundAudit (BoundAudit (Just reg) (Just mat) s) = [chalk Dim (format reg), formatStatus s <> "  " <> format mat]++data BoundsAudit = BoundsAudit+  { auditPkgName :: PkgName,+    auditMinBound :: BoundAudit,+    auditMaxBound :: BoundAudit+  }++formatAudit :: BoundsAudit -> [Text]+formatAudit a = [format $ auditPkgName a] <> formatBoundAudit (auditMinBound a) <> [chalk Dim "  &&  "] <> formatBoundAudit (auditMaxBound a)++data TestedRange = TestedRange+  { legacy :: Snapshot,+    nightly :: Snapshot+  }++deriveBounds :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Cache, MonadUI m) => PkgName -> TestedRange -> m Bounds+deriveBounds name TestedRange {..} = do+  let lower = getVersion name legacy+  let upper = getVersion name nightly++  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)"++  pure+    Bounds+      { lowerBound = Bound Min True <$> lower,+        upperBound = Just (Bound Max True newUpper)+      }

@@ -23,22 +23,24 @@ import HWM.Core.Pkg import HWM.Core.Result (Issue) import HWM.Core.Version (Version)-import HWM.Domain.Bounds (Bounds)+import HWM.Domain.Bounds (Bounds, versionBounds) import HWM.Domain.Dependencies (Dependencies, getBounds)-import HWM.Domain.Matrix (Matrix (..))-import HWM.Domain.Workspace (PkgRegistry, WorkspaceGroup)+import HWM.Domain.Environments (Environments (..))+import HWM.Domain.Release (Release)+import HWM.Domain.Workspace (PkgRegistry, Workspace) import HWM.Runtime.Cache (Cache)-import HWM.Runtime.Files (aesonYAMLOptions)+import HWM.Runtime.Files (aesonYAMLOptionsAdvanced) import Relude  data Config = Config-  { name :: Name,-    version :: Version,-    bounds :: Bounds,-    workspace :: [WorkspaceGroup],-    matrix :: Matrix,-    registry :: Dependencies,-    scripts :: Map Name Text+  { cfgName :: Name,+    cfgVersion :: Version,+    cfgBounds :: Maybe Bounds,+    cfgWorkspace :: Workspace,+    cfgEnvironments :: Environments,+    cfgRegistry :: Dependencies,+    cfgScripts :: Map Name Text,+    cfgRelease :: Maybe Release   }   deriving     ( Generic,@@ -47,26 +49,29 @@  getRule :: (MonadError Issue m) => PkgName -> PkgRegistry -> Config -> m Bounds getRule depName ps Config {..}-  | Map.member depName ps = pure bounds-  | otherwise = getBounds depName registry+  | Map.member depName ps = pure (fromMaybe (versionBounds cfgVersion) cfgBounds)+  | otherwise = getBounds depName cfgRegistry +prefix :: String+prefix = "cfg"+ instance FromJSON Config where-  parseJSON = genericParseJSON aesonYAMLOptions+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced prefix)  instance ToJSON Config where-  toJSON = genericToJSON aesonYAMLOptions+  toJSON = genericToJSON (aesonYAMLOptionsAdvanced prefix)  instance   ( MonadError Issue m,     MonadReader env m,     Has env Cache,-    Has env [WorkspaceGroup],-    Has env Matrix,+    Has env Workspace,+    Has env Environments,     MonadIO m   ) =>   Check m Config   where-  check Config {..} = check matrix+  check Config {..} = check cfgEnvironments  defaultScripts :: Map Name Text defaultScripts =

@@ -2,16 +2,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Use lambda-case" #-}- module HWM.Domain.ConfigT   ( ConfigT (..),     runConfigT,@@ -21,11 +19,10 @@     unpackConfigT,     askCache,     askMatrix,-    askPackages,-    askWorkspaceGroups,     askVersion,     saveConfig,     resolveResultUI,+    getArchiveConfigs,   ) where @@ -34,16 +31,16 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.Text as T import qualified Data.Text.Encoding as T-import HWM.Core.Common (Check (..))+import HWM.Core.Common (Check (..), Name) import HWM.Core.Formatting (Format (..)) import HWM.Core.Has (Has (..)) import HWM.Core.Options (Options (..))-import HWM.Core.Pkg (Pkg) import HWM.Core.Result (Issue (..), MonadIssue (..), Result (..), ResultT, runResultT) import HWM.Core.Version (Version, askVersion) import HWM.Domain.Config (Config (..))-import HWM.Domain.Matrix (Matrix (..))-import HWM.Domain.Workspace (PkgRegistry, WorkspaceGroup, memberPkgs, pkgRegistry)+import HWM.Domain.Environments (Environments (..))+import HWM.Domain.Release (ArtifactConfig, Release (..))+import HWM.Domain.Workspace (PkgRegistry, Workspace, pkgRegistry) import HWM.Runtime.Cache (Cache, VersionMap, loadCache, saveCache) import HWM.Runtime.Files (addHash, readYaml, rewrite_) import HWM.Runtime.UI (MonadUI (..), UIT, printSummary, runUI)@@ -79,14 +76,14 @@ instance Has (Env m) Config where   obtain = config -instance Has (Env m) [WorkspaceGroup] where-  obtain Env {config} = workspace config+instance Has (Env m) Workspace where+  obtain Env {config} = cfgWorkspace config -instance Has (Env m) Matrix where-  obtain Env {config} = matrix config+instance Has (Env m) Environments where+  obtain Env {config} = cfgEnvironments config  instance Has (Env m) Version where-  obtain Env {config} = version config+  obtain Env {config} = cfgVersion config  instance Has (Env m) PkgRegistry where   obtain = pkgs@@ -118,7 +115,7 @@  computeHash :: Config -> Text computeHash cfg =-  let hashInput = T.encodeUtf8 (T.pack (show (environments $ matrix cfg)))+  let hashInput = T.encodeUtf8 (T.pack (show (envTargets $ cfgEnvironments cfg)))       hashBytes = SHA256.hash hashInput    in T.decodeUtf8 (Base16.encode hashBytes) @@ -148,9 +145,9 @@ runConfigT :: ConfigT () -> Options -> IO () runConfigT m opts@Options {..} = do   config <- resolveResultTSilent (readYaml hwm)-  cache <- loadCache (defaultEnvironment (matrix config))+  cache <- loadCache (envDefault (cfgEnvironments config))   changed <- hasHashChanged config <$> getFileHash hwm-  pkgs <- resolveResultTSilent (pkgRegistry (workspace config))+  pkgs <- resolveResultTSilent (pkgRegistry (cfgWorkspace config))   let env = Env {options = opts, config, cache, pkgs}       resultT = unpackConfigT (if changed then checkConfig >> m else m) env   resolveResultT resultT cache@@ -158,14 +155,13 @@ resolveResultT :: ResultT (UIT IO) a -> Cache -> IO () resolveResultT resT cache =   runUI-    ( runResultT resT >>= \r ->-        case r of-          Success {..} -> do-            liftIO $ saveCache cache-            printSummary issues-          Failure {..} -> do-            printSummary (toList failure)-            exitFailure+    ( runResultT resT >>= \case+        Success {..} -> do+          liftIO $ saveCache cache+          printSummary issues+        Failure {..} -> do+          printSummary (toList failure)+          exitFailure     )  resolveResultTSilent :: ResultT IO a -> IO a@@ -188,13 +184,10 @@ askCache :: ConfigT Cache askCache = asks cache -askWorkspaceGroups :: ConfigT [WorkspaceGroup]-askWorkspaceGroups = asks (workspace . config)--askMatrix :: ConfigT Matrix-askMatrix = asks (matrix . config)+askMatrix :: ConfigT Environments+askMatrix = asks (cfgEnvironments . config) -askPackages :: ConfigT [Pkg]-askPackages = do-  groups <- askWorkspaceGroups-  concat <$> traverse memberPkgs groups+getArchiveConfigs :: ConfigT (Map Name ArtifactConfig)+getArchiveConfigs = do+  release <- asks (cfgRelease . config)+  pure $ fromMaybe mempty (release >>= rlsArtifacts)

@@ -7,7 +7,7 @@   ( Dependencies,     Dependency (..),     getBounds,-    traverseDeps,+    mapDeps,     toDependencyList,     fromDependencyList,     mergeDependencies,@@ -15,6 +15,9 @@     externalRegistry,     DependencyGraph (..),     sortByDependencyHierarchy,+    mapWithName,+    singleDeps,+    lookupBounds,   ) where @@ -60,11 +63,23 @@ newtype Dependencies = Dependencies {unpackDeps :: Map PkgName Bounds}   deriving (Show) +instance Semigroup Dependencies where+  (Dependencies a) <> (Dependencies b) = Dependencies (a <> b)++lookupBounds :: PkgName -> Dependencies -> Maybe Bounds+lookupBounds name (Dependencies m) = Map.lookup name m+ getBounds :: (MonadError Issue m) => PkgName -> Dependencies -> m Bounds getBounds name = select "Package " name . unpackDeps -traverseDeps :: (Applicative f) => (PkgName -> Bounds -> f Bounds) -> Dependencies -> f Dependencies-traverseDeps f (Dependencies xs) = Dependencies <$> Map.traverseWithKey f xs+mapDeps :: (PkgName -> Bounds -> Bounds) -> Dependencies -> Dependencies+mapDeps f (Dependencies xs) = Dependencies $ Map.mapWithKey f xs++mapWithName :: (PkgName -> Bounds -> b) -> Dependencies -> [b]+mapWithName f (Dependencies xs) = Map.elems $ Map.mapWithKey f xs++singleDeps :: Dependency -> Dependencies+singleDeps (Dependency name bounds) = Dependencies (Map.singleton name bounds)  initDependencies :: [Dependency] -> Dependencies initDependencies = Dependencies . Map.fromList . map toDuple

@@ -0,0 +1,265 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Domain.Environments+  ( EnviromentTarget (..),+    Environments (..),+    BuildEnvironment (..),+    getBuildEnvironments,+    getBuildEnvironment,+    hkgRefs,+    printEnvironments,+    getTestedRange,+    removeEnvironmentByName,+    newEnv,+    existsEnviroment,+  )+where++import Control.Monad.Except (MonadError (..))+import Data.Aeson+  ( FromJSON (..),+    ToJSON (toJSON),+    genericParseJSON,+    genericToJSON,+  )+import Data.Foldable (Foldable (..))+import Data.List ((\\))+import qualified Data.Map as M+import qualified Data.Map as Map+import Data.Traversable (for)+import HWM.Core.Common+  ( Check (..),+    Name,+  )+import HWM.Core.Formatting (Color (..), Format (..), availableOptions, chalk)+import HWM.Core.Has (Has, HasAll, askEnv)+import HWM.Core.Pkg (Pkg (..), PkgName, pkgId)+import HWM.Core.Result (Issue)+import HWM.Core.Version (Version)+import HWM.Domain.Bounds (TestedRange (..))+import HWM.Domain.Workspace (Workspace, allPackages)+import HWM.Runtime.Cache (Cache, Registry (currentEnv), VersionMap, getLatestNightlySnapshot, getRegistry, getSnapshot, getVersions)+import HWM.Runtime.Files (aesonYAMLOptions, aesonYAMLOptionsAdvanced)+import HWM.Runtime.UI (MonadUI, forTable, sectionEnvironments)+import Relude++type Extras = VersionMap++data Environments = Environments+  { envDefault :: Name,+    envTargets :: Map Name EnviromentTarget+  }+  deriving+    ( Generic,+      Show+    )++newEnv :: Version -> Name -> EnviromentTarget+newEnv ghc resolver =+  EnviromentTarget+    { ghc = ghc,+      resolver = resolver,+      extraDeps = Nothing,+      exclude = Nothing,+      allowNewer = Nothing+    }++prefix :: String+prefix = "env"++instance FromJSON Environments where+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced prefix)++instance ToJSON Environments where+  toJSON = genericToJSON (aesonYAMLOptionsAdvanced prefix)++instance+  ( MonadError Issue m,+    MonadReader env m,+    Has env Environments,+    Has env Workspace,+    Has env Cache,+    MonadIO m+  ) =>+  Check m Environments+  where+  check Environments {..} = traverse_ check envTargets++data EnviromentTarget = EnviromentTarget+  { ghc :: Version,+    resolver :: Name,+    extraDeps :: Maybe Extras,+    exclude :: Maybe [Text],+    allowNewer :: Maybe Bool+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )++instance FromJSON EnviromentTarget where+  parseJSON = genericParseJSON aesonYAMLOptions++instance ToJSON EnviromentTarget where+  toJSON = genericToJSON aesonYAMLOptions++instance+  ( MonadError Issue m,+    MonadReader env m,+    Has env Workspace,+    Has env Cache,+    MonadIO m+  ) =>+  Check m EnviromentTarget+  where+  check EnviromentTarget {..} =+    sequence_+      [ traverse_ check (maybe [] hkgRefs extraDeps),+        checkPkgNames exclude+      ]++checkPkgNames ::+  ( MonadError Issue m,+    MonadReader env m,+    Has env Workspace,+    MonadIO m+  ) =>+  Maybe [Text] ->+  m ()+checkPkgNames ls = do+  known <- map pkgId <$> allPackages+  let unknown = fromMaybe [] ls \\ known+  unless (null unknown) (throwError $ fromString ("unknown packages: " <> show unknown))++data BuildEnvironment = BuildEnvironment+  { buildEnv :: EnviromentTarget,+    buildPkgs :: [Pkg],+    buildName :: Name,+    buildExtraDeps :: Maybe Extras,+    buildResolver :: Name+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )++instance Format BuildEnvironment where+  format BuildEnvironment {..} = buildName <> " (" <> format (ghc buildEnv) <> ")"++getBuildEnvironments ::+  ( MonadReader env m,+    Has env Environments,+    Has env Workspace,+    MonadIO m,+    MonadError Issue m+  ) =>+  m [BuildEnvironment]+getBuildEnvironments = do+  envs <- envTargets <$> askEnv+  for (Map.toList envs) $ \(name, env) -> do+    pkgs <- allPackages+    pure+      BuildEnvironment+        { buildEnv = env,+          buildPkgs = excludePkgs env pkgs,+          buildName = name,+          buildExtraDeps = extraDeps env,+          buildResolver = resolver env+        }+  where+    excludePkgs build = filter (\p -> pkgId p `notElem` fromMaybe [] (exclude build))++getBuildEnvironment ::+  ( MonadReader env m,+    Has env Environments,+    Has env Workspace,+    Has env Cache,+    MonadIO m,+    MonadError Issue m+  ) =>+  Maybe Name ->+  m BuildEnvironment+getBuildEnvironment inputName = do+  envs <- getBuildEnvironments+  defaultname <- envDefault <$> askEnv+  case inputName of+    Just name -> matchEnv envs name (select envs name)+    Nothing -> do+      cachedName <- currentEnv <$> getRegistry+      matchEnv envs defaultname (select envs cachedName <|> select envs defaultname)+  where+    select envs name = find ((name ==) . buildName) envs+    matchEnv envs name = maybe (throwError $ fromString $ toString ("No matching Environment for input '" <> name <> "'! " <> availableOptions (map buildName envs))) pure++data HkgRef = HkgRef+  { pkgName :: PkgName,+    pkgVersion :: Version+  }+  deriving (Eq, Ord)++instance+  ( MonadError Issue m,+    MonadReader env m,+    HasAll env [Workspace, Cache],+    MonadIO m+  ) =>+  Check m HkgRef+  where+  check HkgRef {..} = getVersions pkgName >>= checkElem (pkgVersion ==) . toList+    where+      checkElem f xs =+        if isJust (find f xs)+          then pure ()+          else+            throwError+              $ fromString+              $ toString+                ("No matching version for '" <> format pkgVersion <> "'! " <> availableOptions xs)++hkgRefs :: VersionMap -> [HkgRef]+hkgRefs = map (uncurry HkgRef) . M.toList++instance Format HkgRef where+  format HkgRef {..} = format pkgName <> "-" <> format pkgVersion++existsEnviroment :: (MonadReader env m, Has env Environments) => Name -> m Bool+existsEnviroment n = do+  envs <- envTargets <$> 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+  environments <- getBuildEnvironments+  sectionEnvironments (Just $ format def) $ forTable 0 environments $ \env ->+    ( format env,+      if env == active+        then chalk Cyan (buildResolver env <> " (active)")+        else chalk Gray (buildResolver env)+    )++getTestedRange :: (Monad m, MonadReader env m, Has env Workspace, Has env Environments, MonadIO m, MonadError Issue m) => m TestedRange+getTestedRange = do+  env <- getBuildEnvironments+  legacy <- getSnapshot (minimum $ map buildResolver env)+  nightly <- getLatestNightlySnapshot+  pure TestedRange {legacy = legacy, nightly = nightly}++-- | Remove an environment from the matrix by name+removeEnvironmentByName :: Name -> Environments -> Environments+removeEnvironmentByName envName matrix =+  matrix {envTargets = Map.delete envName (envTargets matrix)}

@@ -1,236 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE NoImplicitPrelude #-}--module HWM.Domain.Matrix-  ( BuildEnv (..),-    Matrix (..),-    BuildEnvironment (..),-    getBuildEnvroments,-    getBuildEnvironment,-    hkgRefs,-    printEnvironments,-  )-where--import Control.Monad.Except (MonadError (..))-import Data.Aeson-  ( FromJSON (..),-    ToJSON (toJSON),-    genericParseJSON,-    genericToJSON,-  )-import Data.List ((\\))-import qualified Data.Map as M-import Data.Traversable (for)-import HWM.Core.Common-  ( Check (..),-    Name,-  )-import HWM.Core.Formatting (Color (..), Format (..), availableOptions, chalk)-import HWM.Core.Has (Has, HasAll, askEnv)-import HWM.Core.Pkg (Pkg (..), PkgName, pkgId)-import HWM.Core.Result (Issue)-import HWM.Core.Version (Version)-import HWM.Domain.Workspace (WorkspaceGroup, memberPkgs)-import HWM.Runtime.Cache (Cache, Registry (currentEnv), VersionMap, getRegistry, getVersions)-import HWM.Runtime.Files (aesonYAMLOptions)-import HWM.Runtime.UI (MonadUI, forTable, sectionEnvironments)-import Relude--type Extras = VersionMap--data Matrix = Matrix-  { defaultEnvironment :: Name,-    environments :: [BuildEnv]-  }-  deriving-    ( Generic,-      Show-    )--instance FromJSON Matrix where-  parseJSON = genericParseJSON aesonYAMLOptions--instance ToJSON Matrix where-  toJSON = genericToJSON aesonYAMLOptions--instance-  ( MonadError Issue m,-    MonadReader env m,-    Has env Matrix,-    Has env [WorkspaceGroup],-    Has env Cache,-    MonadIO m-  ) =>-  Check m Matrix-  where-  check Matrix {..} = traverse_ check environments--data BuildEnv = BuildEnv-  { name :: Name,-    ghc :: Version,-    resolver :: Name,-    extraDeps :: Maybe Extras,-    exclude :: Maybe [Text],-    allowNewer :: Maybe Bool-  }-  deriving-    ( Generic,-      Show,-      Ord,-      Eq-    )--instance FromJSON BuildEnv where-  parseJSON = genericParseJSON aesonYAMLOptions--instance ToJSON BuildEnv where-  toJSON = genericToJSON aesonYAMLOptions--instance-  ( MonadError Issue m,-    MonadReader env m,-    Has env [WorkspaceGroup],-    Has env Cache,-    MonadIO m-  ) =>-  Check m BuildEnv-  where-  check BuildEnv {..} =-    sequence_-      [ traverse_ check (maybe [] hkgRefs extraDeps),-        checkPkgNames exclude-      ]--checkPkgNames ::-  ( MonadError Issue m,-    MonadReader env m,-    Has env [WorkspaceGroup],-    MonadIO m-  ) =>-  Maybe [Text] ->-  m ()-checkPkgNames ls = do-  known <- map pkgId <$> askAllPackages-  let unknown = fromMaybe [] ls \\ known-  unless (null unknown) (throwError $ fromString ("unknown packages: " <> show unknown))--data BuildEnvironment = BuildEnvironment-  { buildEnv :: BuildEnv,-    buildPkgs :: [Pkg],-    buildName :: Name,-    buildExtraDeps :: Maybe Extras,-    buildResolver :: Name-  }-  deriving-    ( Generic,-      Show,-      Ord,-      Eq-    )--instance Format BuildEnvironment where-  format BuildEnvironment {..} = buildName <> " (" <> format (ghc buildEnv) <> ")"--getBuildEnvroments ::-  ( MonadReader env m,-    Has env Matrix,-    Has env [WorkspaceGroup],-    MonadIO m,-    MonadError Issue m-  ) =>-  m [BuildEnvironment]-getBuildEnvroments = do-  envs <- environments <$> askEnv-  for envs $ \env -> do-    pkgs <- askAllPackages-    pure-      BuildEnvironment-        { buildEnv = env,-          buildPkgs = excludePkgs env pkgs,-          buildName = name env,-          buildExtraDeps = extraDeps env,-          buildResolver = resolver env-        }-  where-    excludePkgs build = filter (\p -> pkgId p `notElem` fromMaybe [] (exclude build))--getBuildEnvironment ::-  ( MonadReader env m,-    Has env Matrix,-    Has env [WorkspaceGroup],-    Has env Cache,-    MonadIO m,-    MonadError Issue m-  ) =>-  Maybe Name ->-  m BuildEnvironment-getBuildEnvironment targetNameInput = do-  targetName <- maybe (currentEnv <$> getRegistry) pure targetNameInput-  envs <- getBuildEnvroments-  maybe-    (throwError $ fromString $ toString ("No matching Environment for input '" <> targetName <> "'! " <> availableOptions (map buildName envs)))-    pure-    $ find ((targetName ==) . buildName) envs--data HkgRef = HkgRef-  { pkgName :: PkgName,-    pkgVersion :: Version-  }-  deriving (Eq, Ord)--instance-  ( MonadError Issue m,-    MonadReader env m,-    HasAll env [[WorkspaceGroup], Cache],-    MonadIO m-  ) =>-  Check m HkgRef-  where-  check HkgRef {..} = getVersions pkgName >>= checkElem (pkgVersion ==) . toList-    where-      checkElem f xs =-        if isJust (find f xs)-          then pure ()-          else-            throwError-              $ fromString-              $ toString-                ("No matching version for '" <> format pkgVersion <> "'! " <> availableOptions xs)--hkgRefs :: VersionMap -> [HkgRef]-hkgRefs = map (uncurry HkgRef) . M.toList--instance Format HkgRef where-  format HkgRef {..} = format pkgName <> "-" <> format pkgVersion--askGroups :: (MonadReader env m, Has env [WorkspaceGroup]) => m [WorkspaceGroup]-askGroups = askEnv--askAllPackages ::-  ( MonadReader env m,-    Has env [WorkspaceGroup],-    MonadIO m,-    MonadError Issue m-  ) =>-  m [Pkg]-askAllPackages = do-  groups <- askGroups-  concat <$> traverse memberPkgs groups--printEnvironments :: (MonadUI m) => BuildEnvironment -> [BuildEnvironment] -> m ()-printEnvironments active environments =-  sectionEnvironments $ forTable 0 environments $ \env ->-    ( format env,-      if env == active-        then chalk Cyan (buildResolver env <> " (active)")-        else chalk Gray (buildResolver env)-    )

@@ -0,0 +1,113 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Domain.Release+  ( Release (..),+    ArtifactConfig (..),+    ArchiveFormat (..),+    formatArchiveTemplate,+  )+where++import Data.Aeson+  ( FromJSON (..),+    ToJSON (toJSON),+    genericParseJSON,+    genericToJSON,+  )+import Data.Yaml (Value (..))+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Format (..), formatTemplate)+import HWM.Core.Parsing (Parse (..))+import HWM.Core.Version (Version)+import HWM.Domain.Workspace (WorkspaceRef)+import HWM.Runtime.Files (aesonYAMLOptionsAdvanced)+import HWM.Runtime.Platform (Platform (..))+import Relude++type Publishables = Map Name [WorkspaceRef]++data Release = Release+  { rlsArtifacts :: Maybe (Map Name ArtifactConfig),+    rlsPublish :: Maybe Publishables+  }+  deriving+    ( Generic,+      Show+    )++prefix :: String+prefix = "rls"++instance FromJSON Release where+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced prefix)++instance ToJSON Release where+  toJSON = genericToJSON (aesonYAMLOptionsAdvanced prefix)++data ArtifactConfig = ArtifactConfig+  { arcSource :: Text,+    arcFormats :: [ArchiveFormat],+    arcGhcOptions :: [Text],+    arcNameTemplate :: Text+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )++data ArchiveFormat = Zip | TarGz+  deriving (Generic, Show, Ord, Eq)++instance FromJSON ArchiveFormat where+  parseJSON = parseJSON >=> parse++instance Parse ArchiveFormat where+  parse "zip" = pure Zip+  parse "tar.gz" = pure TarGz+  parse s = fail $ "Invalid archive format: " <> toString s <> ". Supported: zip, tar.gz."++instance ToJSON ArchiveFormat where+  toJSON Zip = String "zip"+  toJSON TarGz = String "tar.gz"++defaultFormat :: Text+defaultFormat = "{{binary}}-v{{version}}-{{os}}-{{arch}}"++formatArchiveTemplate :: Name -> Version -> Platform -> Text -> Text+formatArchiveTemplate name version platform =+  formatTemplate+    [ ("binary", name),+      ("version", format version),+      ("os", format $ os platform),+      ("arch", format $ arch platform)+    ]++defaultArchiveConfig :: Text -> ArtifactConfig+defaultArchiveConfig src =+  ArtifactConfig+    { arcSource = src,+      arcFormats = [TarGz, Zip],+      arcGhcOptions =+        [ "-O2", -- High-level optimization+          "-split-sections", -- Enables dead-code elimination at the function level+          "-optl-s", -- Tells the linker to strip symbols+          "-threaded" -- Essential for modern CLI concurrency+        ],+      arcNameTemplate = defaultFormat+    }++isDefaultArchiveConfig :: ArtifactConfig -> Bool+isDefaultArchiveConfig arc = arc == defaultArchiveConfig (arcSource arc)++instance FromJSON ArtifactConfig where+  parseJSON (String x) = pure $ defaultArchiveConfig x+  parseJSON v = genericParseJSON (aesonYAMLOptionsAdvanced prefix) v++instance ToJSON ArtifactConfig where+  toJSON v+    | isDefaultArchiveConfig v = String (arcSource v)+    | otherwise = genericToJSON (aesonYAMLOptionsAdvanced prefix) v

@@ -8,15 +8,21 @@ {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Domain.Workspace-  ( WorkspaceGroup (..),-    pkgGroupName,+  ( Workspace,+    WorkGroup (..),     pkgRegistry,     PkgRegistry,-    memberPkgs,-    resolveTargets,-    selectGroup,-    canPublish,-    buildWorkspaceGroups,+    WorkspaceRef (..),+    buildWorkspace,+    resolveWorkspaces,+    forWorkspace,+    forWorkspaceTuple,+    parseWorkspaceRef,+    forWorkspaceCore,+    addWorkgroupMember,+    allPackages,+    resolveWsPkgs,+    WsPkgs,   ) where @@ -26,27 +32,49 @@     Options (..),     ToJSON (toJSON),     genericToJSON,+    withText,   ) import Data.Aeson.Types   ( defaultOptions,   ) import Data.List (groupBy) import qualified Data.Map as Map+import qualified Data.Set as S import qualified Data.Text as T import HWM.Core.Common (Name)-import HWM.Core.Formatting (availableOptions, commonPrefix, slugify)+import HWM.Core.Formatting (Color (..), availableOptions, chalk, commonPrefix, genMaxLen, monadStatus, padDots, slugify, statusIcon, subPathSign)+import HWM.Core.Has (Has (..), askEnv) import HWM.Core.Pkg (Pkg (..), PkgName, makePkg) import HWM.Core.Result import HWM.Domain.Dependencies (DependencyGraph, sortByDependencyHierarchy) import HWM.Runtime.Files (cleanRelativePath)+import HWM.Runtime.UI (MonadUI, putLine, sectionWorkspace) import Relude -data WorkspaceGroup = WorkspaceGroup-  { name :: Name,-    dir :: Maybe FilePath,+type Workspace = Map Name WorkGroup++data WorkspaceRef = WorkspaceRef+  { wsRefGroupId :: Name,+    wsRefMemberId :: Maybe Name+  }+  deriving (Show, Eq, Generic)++instance FromJSON WorkspaceRef where+  parseJSON = withText "WorkspaceRef" $ pure . parseWorkspaceRef++instance ToJSON WorkspaceRef where+  toJSON (WorkspaceRef g Nothing) = toJSON g+  toJSON (WorkspaceRef g (Just m)) = toJSON $ g <> "/" <> m++parseWorkspaceRef :: Text -> WorkspaceRef+parseWorkspaceRef input = case T.breakOn "/" input of+  (pkg, "") -> WorkspaceRef pkg Nothing -- No slash found+  (grp, rest) -> WorkspaceRef grp (Just (T.drop 1 rest)) -- Drop the "/"++data WorkGroup = WorkGroup+  { dir :: Maybe FilePath,     members :: [Name],-    prefix :: Maybe Text,-    publish :: Maybe Bool+    prefix :: Maybe Text   }   deriving     ( Generic,@@ -54,41 +82,61 @@       Show     ) -instance ToJSON WorkspaceGroup where+instance ToJSON WorkGroup where   toJSON = genericToJSON defaultOptions {omitNothingFields = True} -memberPkgs :: (MonadIO m, MonadError Issue m) => WorkspaceGroup -> m [Pkg]-memberPkgs WorkspaceGroup {..} = traverse (makePkg name dir prefix) members+memberPkgs :: (MonadIO m, MonadError Issue m) => (Name, WorkGroup) -> m [Pkg]+memberPkgs (name, WorkGroup {..}) = traverse (makePkg name dir prefix) members -pkgGroupName :: WorkspaceGroup -> Name-pkgGroupName WorkspaceGroup {..} = name+getMembers :: (MonadIO m, MonadError Issue m) => Workspace -> m [Pkg]+getMembers ws = do+  let groups = Map.toList ws+  pkgs <- traverse memberPkgs groups+  pure $ concat pkgs -type PkgRegistry = Map PkgName WorkspaceGroup+allPackages ::+  ( MonadReader env m,+    Has env Workspace,+    MonadIO m,+    MonadError Issue m+  ) =>+  m [Pkg]+allPackages = askEnv >>= getMembers -resolveGroup :: (MonadIO m, MonadError Issue m) => WorkspaceGroup -> m PkgRegistry-resolveGroup g = Map.fromList . map ((,g) . pkgName) <$> memberPkgs g+type PkgRegistry = Map PkgName WorkGroup -pkgRegistry :: (MonadIO m, MonadError Issue m) => [WorkspaceGroup] -> m PkgRegistry-pkgRegistry = fmap Map.unions . traverse resolveGroup+type WsPkgs = [(Name, [Pkg])] -parseTarget :: Text -> (Text, Maybe Text)-parseTarget input = case T.breakOn "/" input of-  (pkg, "") -> (pkg, Nothing) -- No slash found-  (grp, rest) -> (grp, Just (T.drop 1 rest)) -- Drop the "/"+resolveGroup :: (MonadIO m, MonadError Issue m) => (Name, WorkGroup) -> m PkgRegistry+resolveGroup g = Map.fromList . map ((,snd g) . pkgName) <$> memberPkgs g -resolveTargets :: (MonadIO m, MonadError Issue m) => [WorkspaceGroup] -> [Name] -> m [Pkg]-resolveTargets ws names = concat <$> traverse (resolveTarget ws) names+pkgRegistry :: (MonadIO m, MonadError Issue m) => Workspace -> m PkgRegistry+pkgRegistry = fmap Map.unions . traverse resolveGroup . Map.toList -resolveTarget :: (MonadIO m, MonadError Issue m) => [WorkspaceGroup] -> Text -> m [Pkg]-resolveTarget ws target = do-  let (g, n) = parseTarget target-  members <- selectGroup g ws >>= memberPkgs-  resolveT members n+askWorkspace :: (MonadReader env m, Has env Workspace) => m Workspace+askWorkspace = asks obtain -selectGroup :: (MonadError Issue m) => Name -> [WorkspaceGroup] -> m WorkspaceGroup-selectGroup name groups =-  maybe (throwError $ fromString $ toString ("Workspace group \"" <> name <> "\" not found! " <> availableOptions (map pkgGroupName groups))) pure (find ((== name) . pkgGroupName) groups)+groupByGroupName :: [Pkg] -> WsPkgs+groupByGroupName pkgs =+  let sorted = sortOn pkgGroup pkgs+      grouped = groupBy (\a b -> pkgGroup a == pkgGroup b) sorted+   in [(maybe "" pkgGroup (viaNonEmpty head g), g) | g <- grouped, not (null g)] +resolveWorkspaces :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Workspace) => [Name] -> m WsPkgs+resolveWorkspaces = resolveWsPkgs . map parseWorkspaceRef++resolveWsPkgs :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Workspace) => [WorkspaceRef] -> m WsPkgs+resolveWsPkgs = fmap (groupByGroupName . (S.toList . S.fromList) . concat) . traverse resolveWsRef++resolveWsRef :: (MonadIO m, MonadError Issue m, MonadReader env m, Has env Workspace) => WorkspaceRef -> m [Pkg]+resolveWsRef wsRef = do+  ws <- askWorkspace+  members <- selectGroup (wsRefGroupId wsRef) ws >>= memberPkgs . (wsRefGroupId wsRef,)+  resolveT members (wsRefMemberId wsRef)++selectGroup :: (MonadError Issue m) => Name -> Workspace -> m WorkGroup+selectGroup name groups = maybe (throwError $ fromString $ toString ("Workspace group \"" <> name <> "\" not found! " <> availableOptions (Map.keys groups))) pure (Map.lookup name groups)+ resolveT :: (MonadError Issue m) => [Pkg] -> Maybe Name -> m [Pkg] resolveT pkgs Nothing = pure pkgs resolveT pkgs (Just target) =@@ -96,11 +144,8 @@     Just p -> pure [p]     Nothing -> throwError $ fromString $ toString $ "Target not found: " <> target -canPublish :: WorkspaceGroup -> Bool-canPublish WorkspaceGroup {publish} = fromMaybe False publish--buildWorkspaceGroups :: (Monad m, MonadError Issue m) => DependencyGraph -> [Pkg] -> m [WorkspaceGroup]-buildWorkspaceGroups graph = fmap concat . traverse groupToWorkspace . groupBy sameGroup . sortOn pkgGroup+buildWorkspace :: (Monad m, MonadError Issue m) => DependencyGraph -> [Pkg] -> m Workspace+buildWorkspace graph = fmap (Map.fromList . concat) . traverse groupToWorkspace . groupBy sameGroup . sortOn pkgGroup   where     sameGroup left right = pkgGroup left == pkgGroup right     groupToWorkspace [] = pure []@@ -108,19 +153,55 @@       sortPkgs <- sortByDependencyHierarchy graph (pkg : pkgs)       let (prefix, members) = commonPrefix (map pkgMemberId sortPkgs)       pure-        [ WorkspaceGroup-            { name = if T.null (pkgGroup pkg) then "libs" else slugify (pkgGroup pkg),-              dir = cleanRelativePath (Just $ toString (pkgGroup pkg)),-              members,-              prefix = prefix,-              publish = derivePublish (pkgGroup pkg : members)-            }+        [ ( if T.null (pkgGroup pkg) then "libs" else slugify (pkgGroup pkg),+            WorkGroup+              { dir = cleanRelativePath (Just $ toString (pkgGroup pkg)),+                members,+                prefix = prefix+              }+          )         ] -derivePublish :: [Name] -> Maybe Bool-derivePublish names-  | any (`elem` nonPublish) loweredNames = Nothing-  | otherwise = Just True-  where-    loweredNames = map T.toLower names-    nonPublish = ["examples", "example", "bench", "benchmarks"]+forWorkspace :: (MonadIO m, MonadUI m, MonadIssue m, MonadError Issue m, MonadReader env m, Has env Workspace) => (Pkg -> m ()) -> m ()+forWorkspace f = forWorkspaceCore $ \pkg -> do+  status <- monadStatus (f pkg)+  pure $ statusIcon status++forWorkspaceCore :: (MonadIO m, MonadUI m, MonadIssue m, MonadError Issue m, MonadReader env m, Has env Workspace) => (Pkg -> m Text) -> m ()+forWorkspaceCore f = do+  gs <- Map.toList <$> askWorkspace+  sectionWorkspace+    $ for_ gs+    $ \(name, wg) -> do+      putLine ""+      putLine $ "• " <> chalk Bold name+      pkgs <- memberPkgs (name, wg)+      let maxLen = genMaxLen (map pkgMemberId pkgs)+      for_ pkgs $ \pkg -> do+        status <- f pkg+        putLine $ subPathSign <> padDots maxLen (pkgMemberId pkg) <> status++forWorkspaceTuple :: (MonadUI m) => [(Text, [Pkg])] -> (Pkg -> m Text) -> m ()+forWorkspaceTuple ws f = sectionWorkspace $ do+  let maxLen = genMaxLen (map pkgMemberId $ concatMap snd ws)+  for_ ws $ \(name, pkgs) -> do+    putLine ""+    putLine $ "• " <> chalk Bold name+    for_ pkgs $ \pkg -> do+      status <- f pkg+      putLine (subPathSign <> padDots 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+  ws <- askWorkspace+  w <- selectGroup name ws+  if memberId `elem` members w+    then+      throwError+        Issue+          { issueTopic = memberId,+            issueMessage = "A member package with name \"" <> memberId <> "\" already exists in workspace group \"" <> name <> "\".",+            issueSeverity = SeverityError,+            issueDetails = Nothing+          }+    else pure (Map.adjust (\g -> g {members = members g <> [memberId]}) name ws, w)

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Integrations.Scaffold (scaffoldPackage) where++import qualified Data.Text as T+import HWM.Core.Pkg (PkgName)+import HWM.Domain.ConfigT (ConfigT)+import HWM.Integrations.Toolchain.Package (newPackage, savePackage)+import Relude+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))++libHsTemplate :: Text+libHsTemplate =+  T.unlines+    [ "module Lib (someFunc) where",+      "",+      "someFunc :: IO ()",+      "someFunc = putStrLn \"Scaffolded by HWM\""+    ]++scaffoldPackage :: FilePath -> PkgName -> ConfigT ()+scaffoldPackage targetDir pkgName = do+  liftIO $ createDirectoryIfMissing True (targetDir </> "src")+  package <- newPackage pkgName+  savePackage (targetDir </> "package.yaml") package+  liftIO $ writeFile (targetDir </> "src/Lib.hs") (T.unpack libHsTemplate)

@@ -19,7 +19,8 @@ import HWM.Core.Formatting (Format (..)) import HWM.Core.Options (Options (..), askOptions) import HWM.Core.Pkg (Pkg (..), PkgName, pkgFile, pkgYamlPath)-import HWM.Domain.ConfigT (ConfigT, askPackages)+import HWM.Domain.ConfigT (ConfigT)+import HWM.Domain.Workspace (allPackages) import HWM.Integrations.Toolchain.Lib (Libraries, Library (..)) import HWM.Integrations.Toolchain.Package (Package (..)) import HWM.Runtime.Files (readYaml, rewrite_)@@ -78,5 +79,6 @@ syncHie :: ConfigT () syncHie = do   Options {..} <- askOptions-  components <- concat <$> (askPackages >>= traverse genComponents)+  pkgs <- allPackages+  components <- concat <$> traverse genComponents pkgs   rewrite_ hie (const $ pure $ packHie Components {stackYaml = stack, components})

@@ -42,7 +42,7 @@ import GHC.Generics (Generic (..)) import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (..))-import HWM.Core.Pkg (PkgName)+import HWM.Core.Pkg (Pkg (pkgMemberId), PkgName, pkgYamlPath) import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (..), Severity (..)) import HWM.Domain.Bounds (Bounds) import HWM.Domain.Config (getRule)@@ -88,22 +88,22 @@   getRule name pkgs cfg  -- | Process dependencies with error handling - shared logic for both check and update-processDependencies :: Text -> Text -> FilePath -> Dependencies -> (Dependency -> Maybe Bounds -> Maybe a) -> ConfigT [a]-processDependencies memberId scope path deps processor = go [] [] (toDependencyList deps)+processDependencies :: Pkg -> Text -> Dependencies -> (Dependency -> Maybe Bounds -> Maybe a) -> ConfigT [a]+processDependencies pkg scope deps processor = go [] [] (toDependencyList deps)   where     go results issues [] = do       -- Inject accumulated dependency issues at the end       unless (null issues)         $ injectIssue           Issue-            { issueTopic = memberId,+            { issueTopic = pkgMemberId pkg,               issueMessage = show (length issues) <> " dependency issue(s) in " <> scope,               issueSeverity = SeverityWarning,               issueDetails =                 Just                   DependencyIssue                     { issueDependencies = issues,-                      issueFile = path+                      issueFile = pkgYamlPath pkg                     }             }       pure (reverse results)@@ -116,18 +116,18 @@         Nothing -> go results newIssues rest         Just item -> go (item : results) newIssues rest -updateDependencies :: Text -> Text -> FilePath -> Dependencies -> ConfigT Dependencies-updateDependencies memberId scope path deps = do-  updated <- processDependencies memberId scope path deps $ \(Dependency depName depBounds) maybeExpected ->+updateDependencies :: Pkg -> Text -> Dependencies -> ConfigT Dependencies+updateDependencies pkg scope deps = do+  updated <- processDependencies pkg scope deps $ \(Dependency depName depBounds) maybeExpected ->     case maybeExpected of       Nothing -> Just (Dependency depName depBounds) -- Preserve original when lookup fails       Just expected -> Just (Dependency depName expected)   -- Return updated dependencies using fromDependencyList   pure $ fromDependencyList updated -checkDependencies :: Text -> Text -> FilePath -> Dependencies -> ConfigT [BoundsDiff]-checkDependencies memberId scope path deps =-  processDependencies memberId scope path deps $ \(Dependency depName depBounds) maybeExpected ->+checkDependencies :: Pkg -> Text -> Dependencies -> ConfigT [BoundsDiff]+checkDependencies pkg scope deps =+  processDependencies pkg scope deps $ \(Dependency depName depBounds) maybeExpected ->     case maybeExpected of       Nothing -> Nothing -- Skip unknown dependencies in diff       Just expected ->@@ -135,23 +135,23 @@           then Nothing           else Just (scope, depName, depBounds, expected) -updateLibrary :: Text -> Text -> FilePath -> Library -> ConfigT Library-updateLibrary memberId scope path Library {..} = do-  newDependencies <- traverse (updateDependencies memberId scope path) dependencies+updateLibrary :: Pkg -> Text -> Library -> ConfigT Library+updateLibrary pkg scope Library {..} = do+  newDependencies <- traverse (updateDependencies pkg scope) dependencies   pure $ Library {dependencies = newDependencies, ..} -checkLibrary :: Text -> Text -> FilePath -> Library -> ConfigT [BoundsDiff]-checkLibrary _ _ _ Library {dependencies = Nothing} = pure []-checkLibrary memberId scope path Library {dependencies = Just deps} =-  checkDependencies memberId scope path deps+checkLibrary :: Pkg -> Text -> Library -> ConfigT [BoundsDiff]+checkLibrary _ _ Library {dependencies = Nothing} = pure []+checkLibrary pkg scope Library {dependencies = Just deps} =+  checkDependencies pkg scope deps -updateLibraries :: Text -> Text -> FilePath -> Maybe Libraries -> ConfigT (Maybe Libraries)-updateLibraries _ _ _ Nothing = pure Nothing-updateLibraries memberId scope path (Just libs) = do-  updated <- traverse (\(name, lib) -> (name,) <$> updateLibrary memberId (scope <> ":" <> name) path lib) (Map.toList libs)+updateLibraries :: Pkg -> Text -> Maybe Libraries -> ConfigT (Maybe Libraries)+updateLibraries _ _ Nothing = pure Nothing+updateLibraries pkg scope (Just libs) = do+  updated <- traverse (\(name, lib) -> (name,) <$> updateLibrary pkg (scope <> ":" <> name) lib) (Map.toList libs)   pure $ Just $ Map.fromList updated -checkLibraries :: Text -> Text -> FilePath -> Libraries -> ConfigT [BoundsDiff]-checkLibraries memberId scope path libs = concat <$> traverse step (Map.toList libs)+checkLibraries :: Pkg -> Text -> Libraries -> ConfigT [BoundsDiff]+checkLibraries pkg scope libs = concat <$> traverse step (Map.toList libs)   where-    step (name, lib) = checkLibrary memberId (scope <> ":" <> name) path lib+    step (name, lib) = checkLibrary pkg (scope <> ":" <> name) lib

@@ -13,6 +13,10 @@     deriveRegistry,     packageDiffs,     validatePackage,+    updatePackage,+    packageModifyDependencies,+    savePackage,+    newPackage,   ) where @@ -20,13 +24,14 @@ import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON) import qualified Data.Map as Map import qualified Data.Set as Set-import HWM.Core.Formatting (Color (..), Format (..), chalk, displayStatus, genMaxLen, padDots, subPathSign)-import HWM.Core.Pkg (Pkg (..), PkgName, pkgMemberId, pkgYamlPath)+import HWM.Core.Formatting (Format (..), displayStatus)+import HWM.Core.Pkg (Pkg (..), PkgName (PkgName), pkgMemberId, pkgYamlPath) import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (..), Severity (..)) import HWM.Core.Version (Version)-import HWM.Domain.ConfigT (ConfigT, askVersion, askWorkspaceGroups)-import HWM.Domain.Dependencies (Dependencies, Dependency (Dependency), DependencyGraph (DependencyGraph), externalRegistry, normalizeDependencies, toDependencyList)-import HWM.Domain.Workspace (memberPkgs, pkgGroupName)+import HWM.Domain.Config (getRule)+import HWM.Domain.ConfigT (ConfigT, Env (config, pkgs), askVersion)+import HWM.Domain.Dependencies (Dependencies, Dependency (Dependency), DependencyGraph (DependencyGraph), externalRegistry, normalizeDependencies, singleDeps, toDependencyList)+import HWM.Domain.Workspace (forWorkspaceCore) import HWM.Integrations.Toolchain.Cabal (syncCabal) import HWM.Integrations.Toolchain.Lib   ( BoundsDiff,@@ -40,7 +45,6 @@     updateLibrary,   ) import HWM.Runtime.Files (aesonYAMLOptions, readYaml, rewrite_, statusM)-import HWM.Runtime.UI (putLine, sectionWorkspace) import Relude  data Package = Package@@ -62,25 +66,35 @@ instance ToJSON Package where   toJSON = genericToJSON aesonYAMLOptions -updatePackage :: Pkg -> Maybe Package -> ConfigT Package-updatePackage pkg Nothing =-  throwError-    $ Issue-      { issueTopic = pkgMemberId pkg,-        issueMessage = "could not find package file",-        issueSeverity = SeverityWarning,-        issueDetails = Just GenericIssue {issueFile = pkgYamlPath pkg}+newPackage :: PkgName -> ConfigT Package+newPackage name = do+  cfg <- asks config+  ps <- asks pkgs+  let basename = PkgName "base"+  version <- askVersion+  base <- getRule basename ps cfg+  pure+    $ Package+      { name = name,+        version = version,+        library = Just Library {sourceDirs = "src", dependencies = Nothing, __unknownFields = Nothing},+        dependencies = singleDeps (Dependency basename base),+        tests = Nothing,+        executables = Nothing,+        benchmarks = Nothing,+        internalLibraries = Nothing,+        foreignLibraries = Nothing       }-updatePackage pkg (Just Package {..}) = do-  let path = pkgYamlPath pkg-      pkgId = pkgMemberId pkg-  newLibrary <- traverse (updateLibrary pkgId "library" path) library-  newTests <- updateLibraries pkgId "tests" path tests-  newExecutables <- updateLibraries pkgId "executables" path executables-  newBenchmarks <- updateLibraries pkgId "benchmarks" path benchmarks-  newInternalLibraries <- updateLibraries pkgId "internal" path internalLibraries-  newForeignLibraries <- updateLibraries pkgId "foreign" path foreignLibraries-  newDependencies <- updateDependencies pkgId "dependencies" path dependencies++mapPackage :: Pkg -> Package -> ConfigT Package+mapPackage pkg Package {..} = do+  newLibrary <- traverse (updateLibrary pkg "library") library+  newTests <- updateLibraries pkg "tests" tests+  newExecutables <- updateLibraries pkg "executables" executables+  newBenchmarks <- updateLibraries pkg "benchmarks" benchmarks+  newInternalLibraries <- updateLibraries pkg "internal" internalLibraries+  newForeignLibraries <- updateLibraries pkg "foreign" foreignLibraries+  newDependencies <- updateDependencies pkg "dependencies" dependencies   newVersion <- askVersion   pure     $ Package@@ -95,16 +109,19 @@         ..       } +withMaybe :: (Applicative m) => (a -> m [b]) -> Maybe a -> m [b]+withMaybe = maybe (pure [])+ -- | Determine whether a package already matches the expected configuration.-packageDiffs :: Text -> FilePath -> Package -> ConfigT [BoundsDiff]-packageDiffs memberId path Package {..} = do-  depsDiffs <- checkDependencies memberId "dependencies" path dependencies-  libraryDiffs <- traverseLibrary "library" library-  testsDiffs <- traverseLibraries "tests" tests-  executablesDiffs <- traverseLibraries "executables" executables-  benchmarksDiffs <- traverseLibraries "benchmarks" benchmarks-  internalDiffs <- traverseLibraries "internal" internalLibraries-  foreignDiffs <- traverseLibraries "foreign" foreignLibraries+packageDiffs :: Pkg -> Package -> ConfigT [BoundsDiff]+packageDiffs pkg Package {..} = do+  depsDiffs <- checkDependencies pkg "dependencies" dependencies+  libraryDiffs <- withMaybe (checkLibrary pkg "library") library+  testsDiffs <- withMaybe (checkLibraries pkg "tests") tests+  executablesDiffs <- withMaybe (checkLibraries pkg "executables") executables+  benchmarksDiffs <- withMaybe (checkLibraries pkg "benchmarks") benchmarks+  internalDiffs <- withMaybe (checkLibraries pkg "internal") internalLibraries+  foreignDiffs <- withMaybe (checkLibraries pkg "foreign") foreignLibraries   pure     ( depsDiffs         <> libraryDiffs@@ -114,33 +131,35 @@         <> internalDiffs         <> foreignDiffs     )-  where-    traverseLibrary :: Text -> Maybe Library -> ConfigT [BoundsDiff]-    traverseLibrary _ Nothing = pure []-    traverseLibrary scope (Just lib) = checkLibrary memberId scope path lib -    traverseLibraries :: Text -> Maybe Libraries -> ConfigT [BoundsDiff]-    traverseLibraries _ Nothing = pure []-    traverseLibraries scope (Just libs) = checkLibraries memberId scope path libs- syncPackages :: ConfigT ()-syncPackages = sectionWorkspace $ do-  groups <- askWorkspaceGroups-  for_ groups $ \g -> do-    putLine ""-    putLine $ "• " <> chalk Bold (pkgGroupName g)-    dirs <- memberPkgs g-    let maxLen = genMaxLen (map pkgMemberId dirs)-    for_ dirs $ \pkg -> do-      let path = pkgYamlPath pkg-      package <- statusM path (rewrite_ path (updatePackage pkg))-      cabal <- syncCabal pkg-      putLine-        ( subPathSign-            <> padDots maxLen (pkgMemberId pkg)-            <> displayStatus [("pkg", package), ("cabal", cabal)]-        )+syncPackages = forWorkspaceCore $ \pkg -> updatePackage (mapPackage pkg) pkg +packageModifyDependencies :: (Dependencies -> ConfigT Dependencies) -> Package -> ConfigT Package+packageModifyDependencies f Package {..} = do+  newDependencies <- f dependencies+  pure Package {dependencies = newDependencies, ..}++updatePackage :: (Package -> ConfigT Package) -> Pkg -> ConfigT Text+updatePackage f pkg = do+  let path = pkgYamlPath pkg+  package <- statusM path (rewrite_ path maybePackage)+  cabal <- syncCabal pkg+  pure $ displayStatus [("pkg", package), ("cabal", cabal)]+  where+    maybePackage Nothing =+      throwError+        $ Issue+          { issueTopic = pkgMemberId pkg,+            issueMessage = "could not find package file",+            issueSeverity = SeverityWarning,+            issueDetails = Just GenericIssue {issueFile = pkgYamlPath pkg}+          }+    maybePackage (Just package) = f package++savePackage :: FilePath -> Package -> ConfigT ()+savePackage pkg package = rewrite_ pkg (const $ pure package)+ collectPackageDependencies :: Package -> [Dependency] collectPackageDependencies Package {..} =   normalizeDependencies@@ -189,28 +208,23 @@ validatePackage :: Pkg -> ConfigT () validatePackage pkg = do   let path = pkgYamlPath pkg-      pkgId = pkgMemberId pkg-   currentPkg <- readYaml path :: ConfigT Package   expectedVersion <- askVersion-   let currentVersion = version currentPkg       versionMatch = currentVersion == expectedVersion-  diffs <- packageDiffs pkgId path currentPkg-+  diffs <- packageDiffs pkg currentPkg   unless versionMatch     $ injectIssue       Issue-        { issueTopic = pkgId,+        { issueTopic = pkgMemberId pkg,           issueMessage = "version mismatch: " <> format currentVersion <> " → " <> format expectedVersion,           issueSeverity = SeverityWarning,           issueDetails = Just GenericIssue {issueFile = path}         }-   unless (null diffs)     $ injectIssue       Issue-        { issueTopic = pkgId,+        { issueTopic = pkgMemberId pkg,           issueMessage =             let baseMsg =                   if versionMatch

@@ -17,6 +17,8 @@     parseExtraDeps,     scanStackFiles,     buildMatrix,+    runStack,+    stackGenBinary,   ) where @@ -38,17 +40,16 @@ import HWM.Core.Result (Issue (..), IssueDetails (..), Severity (..), fromEither) import HWM.Core.Version (Version, parseGHCVersion) import HWM.Domain.ConfigT (ConfigT)-import HWM.Domain.Matrix (BuildEnv (..), BuildEnvironment (..), Matrix (..), getBuildEnvironment, hkgRefs)+import HWM.Domain.Environments (BuildEnvironment (..), EnviromentTarget (..), Environments (..), getBuildEnvironment, hkgRefs) import HWM.Runtime.Cache (getSnapshotGHC) import HWM.Runtime.Files (aesonYAMLOptions, readYaml, rewrite_) import HWM.Runtime.Logging (log)+import HWM.Runtime.Process (exec) import Relude hiding (head, tail) import System.Directory (createDirectoryIfMissing, doesFileExist)-import System.Exit (ExitCode (..)) import System.FilePath (dropExtension, (</>)) import System.FilePath.Glob (compile, globDir1) import System.FilePath.Posix (takeFileName)-import System.Process (readProcessWithExitCode)  data Stack = Stack   { packages :: [FilePath],@@ -91,7 +92,7 @@ syncStackYaml = do   stackYamlPath <- stack <$> askOptions   rewrite_ stackYamlPath $ const $ do-    BuildEnvironment {buildPkgs, buildEnv = BuildEnv {..}} <- getBuildEnvironment Nothing+    BuildEnvironment {buildPkgs, buildEnv = EnviromentTarget {..}} <- getBuildEnvironment Nothing     pure       Stack         { saveHackageCreds = Just False,@@ -110,7 +111,7 @@   path <- stackPath (Just target)   liftIO $ createDirectoryIfMissing True ".hwm/matrix/"   rewrite_ path $ const $ do-    BuildEnvironment {buildEnv = BuildEnv {..}, ..} <- getBuildEnvironment (Just target)+    BuildEnvironment {buildEnv = EnviromentTarget {..}, ..} <- getBuildEnvironment (Just target)     pure       Stack         { saveHackageCreds = Just False,@@ -120,18 +121,19 @@           ..         } -runStack :: [String] -> ConfigT (Bool, String)-runStack args = do-  (code, _, out) <- liftIO (readProcessWithExitCode "stack" args "")-  case code of-    ExitSuccess {} -> pure (True, out)-    ExitFailure {} -> pure (False, out)+stackGenBinary :: PkgName -> FilePath -> [Text] -> ConfigT ()+stackGenBinary pkgName dirPath args = do+  (success, buildOut) <- runStack (["install", format pkgName, "--local-bin-path", format dirPath] <> args)+  unless success $ throwError (fromString $ "Build failed: " <> buildOut) +runStack :: [Text] -> ConfigT (Bool, String)+runStack = exec "stack"+ sdist :: Pkg -> ConfigT [Issue] sdist pkg = do   let issueTopic = pkgMemberId pkg       issueMessage = "stack sdist detected Issues. No packages were published."-  (isSuccess, out) <- runStack ["sdist", toString (pkgName pkg)]+  (isSuccess, out) <- runStack ["sdist", format (pkgName pkg)]   let severity = if isSuccess then findIssue out else Just SeverityError   case severity of     Nothing -> pure []@@ -142,7 +144,7 @@  upload :: Pkg -> ConfigT (Status, [Issue]) upload pkg = do-  (isSuccess, out) <- runStack ["upload", toString (pkgName pkg)]+  (isSuccess, out) <- runStack ["upload", format (pkgName pkg)]   ( if isSuccess       then pure (Checked, [])       else@@ -187,15 +189,15 @@ deriveEnviromentName :: FilePath -> Maybe Text deriveEnviromentName path = slugify <$> T.stripPrefix "stack-" (toText (dropExtension (takeFileName path))) -buildMatrix :: (MonadIO m, MonadError Issue m) => [Pkg] -> NonEmpty (Name, Stack) -> m Matrix+buildMatrix :: (MonadIO m, MonadError Issue m) => [Pkg] -> NonEmpty (Name, Stack) -> m Environments buildMatrix pkgs (defaultEnv :| envs) = do-  environments <- sortOn ghc <$> traverse (inferBuildEnv pkgs) (defaultEnv : envs)-  pure Matrix {defaultEnvironment = fst defaultEnv, environments}+  environments <- sortOn (ghc . snd) <$> traverse (inferBuildEnv pkgs) (defaultEnv : envs)+  pure Environments {envDefault = fst defaultEnv, envTargets = Map.fromList environments} -inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m BuildEnv+inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m (Name, EnviromentTarget) 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 pkgId excludeList)-  pure BuildEnv {..}+  pure (name, EnviromentTarget {..})

@@ -0,0 +1,93 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Runtime.Archive+  ( createArchive,+    ArchivingPlan (..),+    ArchiveInfo (..),+    ArchiveFormat (..),+  )+where++import qualified Codec.Archive.Zip as Zip+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Except (throwError)+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Format (..))+import HWM.Core.Result (Issue (..), MonadIssue (injectIssue), Severity (..))+import HWM.Core.Version (Version)+import HWM.Domain.Release (ArchiveFormat (..), formatArchiveTemplate)+import HWM.Runtime.Platform (detectPlatform, platformFilePath)+import HWM.Runtime.Process (exec)+import Relude+import System.Directory (doesFileExist)+import System.FilePath.Posix (joinPath, normalise, takeDirectory, takeFileName, (</>))++data ArchiveInfo = ArchiveInfo+  { archivePath :: FilePath,+    sha256Path :: FilePath+  }++data ArchivingPlan = ArchivingPlan+  { sourceDir :: FilePath,+    name :: Name,+    outDir :: FilePath,+    nameTemplate :: Text,+    archiveFormats :: [ArchiveFormat]+  }++checkBinFile :: (MonadIO m, MonadError Issue m) => FilePath -> m ()+checkBinFile binPath = do+  binExists <- liftIO $ doesFileExist binPath+  unless binExists $ throwError (fromString $ "Binary not found at expected path: \"" <> binPath <> "\". Ensure the build step succeeded and the binary is located at the correct path.")++createArchive ::+  (MonadIO m, MonadError Issue m, MonadIssue m) =>+  Version ->+  ArchivingPlan ->+  m [ArchiveInfo]+createArchive version ArchivingPlan {..} = do+  platform <- detectPlatform+  let binName = platformFilePath platform name+  let binPath = sourceDir </> binName+  checkBinFile binPath++  fmap catMaybes $ forM archiveFormats $ \target -> do+    let ext = if target == Zip then ".zip" else ".tar.gz"+    let archiveName = formatArchiveTemplate name version platform nameTemplate <> ext+    let archivePath = normalise $ joinPath [outDir, toString archiveName]++    success <- writeArchive target binPath archivePath binName++    if success+      then Just <$> finalizeArchive archivePath+      else pure Nothing++writeArchive :: (MonadIO m, MonadIssue m) => ArchiveFormat -> FilePath -> FilePath -> FilePath -> m Bool+writeArchive Zip binPath outPath binNameWithExt = liftIO $ do+  entry <- Zip.readEntry [] binPath+  let rootEntry = entry {Zip.eRelativePath = binNameWithExt}+  let archive = Zip.addEntryToArchive rootEntry Zip.emptyArchive+  BSL.writeFile outPath (Zip.fromArchive archive)+  pure True+writeArchive TarGz binPath outPath _ = do+  (isOk, _) <- exec "tar" ["-czvf", format outPath, "-C", format (takeDirectory binPath), format (takeFileName binPath)]+  unless isOk $ injectIssue (Issue {issueTopic = "archive", issueMessage = "⚠️  Warning: Failed to create .tar.gz (check if 'tar' is installed)", issueSeverity = SeverityWarning, issueDetails = Nothing})+  pure isOk++finalizeArchive :: (MonadIO m) => FilePath -> m ArchiveInfo+finalizeArchive archPath = do+  hashBS <- liftIO $ BS.readFile archPath+  let sha256 = T.decodeUtf8 (Base16.encode (SHA256.hash hashBS))+  let sha256Path = archPath <> ".sha256"+  liftIO $ T.writeFile sha256Path (format sha256)+  pure ArchiveInfo {archivePath = archPath, sha256Path = sha256Path}

@@ -18,28 +18,33 @@     getVersions,     Versions,     VersionMap,-    clearVersions,     prepareDir,     getSnapshotGHC,     Snapshot (..),+    getSnapshot,+    getVersion,+    getLatestNightlySnapshot,+    http,   ) where  import qualified Control.Concurrent.STM as STM import Control.Monad.Except (MonadError (..))-import Data.Aeson (FromJSON, ToJSON, eitherDecode, (.:))+import Data.Aeson (FromJSON, ToJSON, Value, eitherDecode, (.:)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (withObject) import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Text as T-import Data.Yaml (decodeEither', prettyPrintParseException)+import Data.Time (getCurrentTime, utctDay)+import Data.Time.Format (defaultTimeLocale, formatTime)+import Data.Yaml (Object, Parser, decodeEither', prettyPrintParseException) import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (..)) import HWM.Core.Has (Has, askEnv)-import HWM.Core.Parsing (genUrl)-import HWM.Core.Pkg (PkgName)+import HWM.Core.Parsing (genUrl, parse, parsePkgString)+import HWM.Core.Pkg (PkgName (..)) import HWM.Core.Result (Issue, Result (..), ResultT (..)) import HWM.Core.Version (Version, parseGHCVersion) import HWM.Runtime.Files (select)@@ -107,20 +112,17 @@   c <- askCache   modifyCache c f -clearVersions :: (MonadReader env m, Has env Cache, MonadIO m) => m ()-clearVersions = updateRegistry (\reg -> reg {versions = mempty})- getReq :: (Url s, Option s) -> Req LbsResponse getReq (u, o) = req GET u NoReqBody lbsResponse o -parse :: (MonadError Issue m) => Text -> m (Req LbsResponse)-parse url = do+parseBody :: (MonadError Issue m) => Text -> m (Req LbsResponse)+parseBody url = do   uri <- maybe (throwError $ fromString $ "Invalid Endpoint: " <> toString url <> "!") pure (mkURI url >>= useURI)   pure (either getReq getReq uri)  http :: (MonadError Issue m, MonadIO m) => Text -> [Text] -> m BL.ByteString http dom p = do-  request <- parse (genUrl dom p)+  request <- parseBody (genUrl dom p)   responseBody <$> liftIO (runReq defaultHttpConfig request)  hackage :: (MonadIO m, MonadError Issue m) => Text -> m (Map Name (NonEmpty Version))@@ -140,12 +142,28 @@ prepareDir :: (MonadIO m) => FilePath -> m () prepareDir dir = liftIO $ createDirectoryIfMissing True dir -newtype Snapshot = Snapshot {snapshotCompiler :: Text}+data Snapshot = Snapshot {snapshotCompiler :: Version, snapshotPackages :: Map PkgName Version}   deriving (Show) +parseValue :: Value -> Parser (PkgName, Version)+parseValue = withObject "Package" $ \v -> do+  package <- v .: "hackage"+  let (name, versionStr) = parsePkgString package+  version <- parse versionStr+  pure (PkgName name, version)++parseMap :: [Value] -> Parser (Map PkgName Version)+parseMap pairs = Map.fromList <$> mapM parseValue pairs+ instance FromJSON Snapshot where-  parseJSON = withObject "Snapshot" $ \v -> Snapshot <$> (v .: "resolver" >>= (.: "compiler"))+  parseJSON = withObject "Snapshot" $ \v ->+    Snapshot <$> readCompilerVersion v <*> (v .: "packages" >>= parseMap) +readCompilerVersion :: Object -> Parser Version+readCompilerVersion v = do+  x <- (v .: "resolver" >>= (.: "compiler")) <|> v .: "compiler"+  parseGHCVersion x+ genName :: (MonadError Issue m) => Text -> m [Text] genName resolver   | Just ltsNum <- T.stripPrefix "lts-" resolver = buildSegments "lts" "." ltsNum@@ -160,12 +178,24 @@               lastPart = NE.last parts            in pure (prefix : segments <> [lastPart <> ".yaml"]) -getSnapshotGHC :: (MonadIO m, MonadError Issue m) => Text -> m Version-getSnapshotGHC name = do+getSnapshotGHC :: (MonadIO m, MonadError Issue m) => Name -> m Version+getSnapshotGHC name = snapshotCompiler <$> getSnapshot name++getSnapshot :: (MonadError Issue m, MonadIO m) => Text -> m Snapshot+getSnapshot name = do   pathSegments <- genName name   body <- runResultT (http "https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master" pathSegments)   case body of     Failure {failure} -> throwError $ fromString $ "HTTP Error: " <> show failure     Success {result} -> case decodeEither' (BL.toStrict result) of-      Left err -> throwError $ fromString $ "Snapshot Error: " <> prettyPrintParseException err-      Right snapshot -> either (throwError . fromString) pure (parseGHCVersion (snapshotCompiler snapshot))+      Left err -> throwError $ fromString $ "Snapshot Error: " <> toString (T.intercalate "/" pathSegments) <> " - " <> prettyPrintParseException err+      Right snapshot -> pure snapshot++getVersion :: PkgName -> Snapshot -> Maybe Version+getVersion name snapshot = Map.lookup name (snapshotPackages snapshot)++getLatestNightlySnapshot :: (MonadIO m, MonadError Issue m) => m Snapshot+getLatestNightlySnapshot = do+  today <- liftIO $ utctDay <$> getCurrentTime+  let name = "nightly-" <> T.pack (formatTime defaultTimeLocale "%Y-%-m-%-d" today)+  getSnapshot name

@@ -14,6 +14,7 @@     addHash,     forbidOverride,     cleanRelativePath,+    aesonYAMLOptionsAdvanced,   ) where @@ -163,7 +164,19 @@       | otherwise = [x]  aesonYAMLOptions :: Options-aesonYAMLOptions = defaultOptions {fieldLabelModifier = toKebabCase, omitNothingFields = True}+aesonYAMLOptions = defaultOptions {fieldLabelModifier = toKebabCase . fieldLabelModifier defaultOptions, omitNothingFields = True}++aesonYAMLOptionsAdvanced :: String -> Options+aesonYAMLOptionsAdvanced prefix = defaultOptions {fieldLabelModifier = toKebabCase . stripFieldNamespace prefix . fieldLabelModifier defaultOptions, omitNothingFields = True}++dropPrefix :: String -> String -> String+dropPrefix name = drop (length name)++stripFieldNamespace :: String -> String -> String+stripFieldNamespace prefix = __uncapitalize . dropPrefix prefix+  where+    __uncapitalize [] = []+    __uncapitalize (x : xs) = toLower x : xs  select :: (MonadError Issue m, Format t, Ord t) => Text -> t -> Map t a -> m a select e k = maybe (throwError $ fromString $ "Unknown " <> toString e <> ": " <> toString (format k) <> "!") pure . lookup k

@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Runtime.Network (uploadToGitHub) where++import Control.Monad.Except (MonadError (..))+import qualified Data.Text as T+import HWM.Core.Result (Issue (..))+import Network.HTTP.Req+import Relude+import System.FilePath (takeFileName)+import Text.URI (mkURI)++getGitHubToken :: (MonadIO m, MonadError Issue m) => m Text+getGitHubToken = do+  maybeToken <- liftIO $ lookupEnv "GITHUB_TOKEN"+  maybe+    (throwError "GITHUB_TOKEN environment variable not set. Please set it to a valid GitHub Personal Access Token with repo permissions.")+    (pure . T.pack)+    maybeToken++uploadToGitHub :: (MonadIO m, MonadError Issue m) => Text -> FilePath -> m ()+uploadToGitHub uploadUrl filePath = do+  token <- getGitHubToken+  liftIO $ runReq defaultHttpConfig $ do+    uri <- liftIO $ mkURI uploadUrl+    case useHttpsURI uri of+      Just (url, opts) -> do+        let fileName = T.pack $ takeFileName filePath+        void+          $ req+            POST+            url+            (ReqBodyFile filePath) -- Raw bytes, no multipart wrapping+            ignoreResponse+            ( opts+                <> queryParam "name" (Just fileName) -- Required by GitHub+                <> header "Authorization" ("Bearer " <> encodeUtf8 token)+                <> header "Content-Type" "application/octet-stream" -- Crucial!+                <> header "User-Agent" "hwm-tool" -- GitHub requires a User-Agent+            )+      Nothing -> liftIO $ putStrLn "GitHub Upload URLs must be HTTPS"

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Runtime.Platform+  ( OS (..),+    Arch (..),+    Platform (..),+    detectPlatform,+    platformFilePath,+  )+where++import Data.Char (toLower)+import HWM.Core.Formatting (Format (..))+import Relude+import qualified System.Environment as Env+import qualified System.Info as Info++-- | OS type+data OS = MacOS | Linux | Windows | UnknownOS deriving (Eq, Show)++-- | Arch type+data Arch = X64 | Arm64 | UnknownArch deriving (Eq, Show)++instance Format OS where+  format MacOS = "macos"+  format Linux = "linux"+  format Windows = "windows"+  format UnknownOS = "unknown"++instance Format Arch where+  format X64 = "x64"+  format Arm64 = "arm64"+  format UnknownArch = "unknown"++data Platform = Platform {os :: OS, arch :: Arch} deriving (Eq, Show)++instance Format Platform where+  format (Platform os' arch') = format os' <> "-" <> format arch'++platformFilePath :: Platform -> Text -> FilePath+platformFilePath (Platform Windows _) fileName = toString (fileName <> ".exe")+platformFilePath _ fileName = toString fileName++detectPlatform :: (MonadIO m) => m Platform+detectPlatform = liftIO $ do+  envOS <- Env.lookupEnv "RUNNER_OS"+  envArch <- Env.lookupEnv "RUNNER_ARCH"++  let finalOS = case envOS of+        Just val -> detectOS val+        Nothing -> detectOS Info.os++      finalArch = case envArch of+        Just val -> detectArch val+        Nothing -> detectArch Info.arch++  pure $ Platform finalOS finalArch++detectOS :: String -> OS+detectOS s = case map toLower s of+  "darwin" -> MacOS+  "macos" -> MacOS+  "linux" -> Linux+  "windows" -> Windows+  "mingw32" -> Windows -- The crucial fix for GHC on Windows+  _ -> UnknownOS++detectArch :: String -> Arch+detectArch s = case map toLower s of+  "x86_64" -> X64+  "x64" -> X64+  "amd64" -> X64+  "arm64" -> Arm64+  "aarch64" -> Arm64 -- GHC uses aarch64 for Apple Silicon/Linux ARM+  _ -> UnknownArch

@@ -4,6 +4,7 @@ module HWM.Runtime.Process   ( silentRun,     inheritRun,+    exec,   ) where @@ -13,7 +14,15 @@ import Relude import System.Environment (getEnvironment) import qualified System.IO as TIO+import System.Process (readProcessWithExitCode) import System.Process.Typed++exec :: (MonadIO m) => Text -> [Text] -> m (Bool, String)+exec name args = do+  (code, _, out) <- liftIO (readProcessWithExitCode (toString name) (map toString args) "")+  case code of+    ExitSuccess {} -> pure (True, out)+    ExitFailure {} -> pure (False, out)  provideYamlPath :: (MonadIO m) => String -> m [(String, String)] provideYamlPath yamlPath = do

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Runtime.Snapshots (fetchStackageSnapshots, fetchLtsSuggestions, SnapshotInfo (..)) where++import Control.Monad.Except (MonadError, throwError)+import Data.Aeson (FromJSON (..))+import Data.Aeson.Decoding (eitherDecode)+import qualified Data.ByteString.Lazy.Char8 as BL+import HWM.Core.Result (Issue)+import HWM.Runtime.Cache (http)+import Relude++data ValueWrapper = ValueWrapper+  { snapshots :: [[(Text, Text, Text)]],+    totalCount :: Int+  }+  deriving (Show, Eq, Generic, FromJSON)++data SnapshotInfo = SnapshotInfo+  { snapshotName :: Text,+    snapshotTitle :: Text,+    snapshotAge :: Text+  }+  deriving (Show, Eq, Generic, FromJSON)++stackageError :: String -> Issue+stackageError = fromString . ("Failed to decode Stackage API response: " <>)++decodeWithError :: (MonadError Issue m, FromJSON a) => BL.ByteString -> m a+decodeWithError bs =+  case eitherDecode bs of+    Right val -> pure val+    Left err -> throwError $ stackageError err++stackage :: (MonadError Issue m, MonadIO m, FromJSON b) => [Text] -> m b+stackage path = do+  body <- http "https://www.stackage.org" path+  decodeWithError body++-- | Fetches the list of available Stackage snapshots from the public API+fetchStackageSnapshots :: (MonadIO m, MonadError Issue m) => m [SnapshotInfo]+fetchStackageSnapshots = do+  stackage ["api/v1/snapshots"] >>= \ValueWrapper {..} -> pure $ map (\(name, title, age) -> SnapshotInfo name title age) $ concat snapshots++fetchLtsSuggestions :: (MonadIO m, MonadError Issue m) => m (Map Text Text)+fetchLtsSuggestions = stackage ["download/snapshots.json"]

@@ -23,15 +23,18 @@     printSummary,     statusIndicator,     runSpinner,+    printGenTable,+    mapMTable,   ) where  import Control.Concurrent (threadDelay) import Control.Monad.Error.Class (MonadError) import Control.Monad.Except (MonadError (..))-import Data.List (groupBy, maximum)+import Data.List (groupBy, maximum, (!!)) import qualified Data.Map.Strict as Map import qualified Data.Text as T+import HWM.Core.Common (Name) import HWM.Core.Formatting (Color (..), Format (..), Status (..), chalk, indentBlockNum, padDots, renderSummaryStatus, subPathSign) import HWM.Core.Result   ( Issue (..),@@ -93,20 +96,20 @@ indent :: (MonadUI m) => Int -> m a -> m a indent amount = uiWithIndent (+ amount) -sectionWithIcon :: (MonadUI m) => Text -> Text -> m a -> m ()-sectionWithIcon emoji title action = do+sectionBase :: (MonadUI m) => Text -> Text -> m a -> m a+sectionBase emoji title action = do   putLine ""   putLine (emoji <> " " <> chalk Bold title)-  indent 1 action $> ()+  indent 1 action  section :: (MonadUI m) => Text -> m a -> m ()-section = sectionWithIcon "•"+section t m = sectionBase "•" t m $> ()  sectionWorkspace :: (MonadUI m) => m a -> m ()-sectionWorkspace = sectionWithIcon "./" "workspace"+sectionWorkspace m = sectionBase "./" "workspace" m $> () -sectionEnvironments :: (MonadUI m) => m a -> m ()-sectionEnvironments = section "environments"+sectionEnvironments :: (MonadUI m) => Maybe Text -> m a -> m ()+sectionEnvironments title = section ("environments" <> maybe "" (\name -> chalk Dim " (default: " <> chalk Magenta name <> chalk Dim ")") title)  tableM :: (MonadUI m) => Int -> [(Text, m Text)] -> m () tableM minSize rows = traverse_ formatRow rows@@ -119,12 +122,33 @@ sectionTableM :: (MonadUI m) => Int -> Text -> [(Text, m Text)] -> m () sectionTableM size title = section title . tableM size +mapMTable :: (MonadUI m) => Text -> [(Name, m (Text, a))] -> m [(Name, a)]+mapMTable title rows = sectionBase "•" title $ traverse formatRow rows+  where+    maxLabelLen = maximum (0 : map (T.length . fst) rows) + 2+    formatRow (label, valueM) = do+      (value, mvalue) <- valueM+      putLine $ padDots maxLabelLen label <> value+      pure (label, mvalue)+ sectionConfig :: (MonadUI m) => Int -> [(Text, m Text)] -> m () sectionConfig size = section "config" . tableM size  forTable :: (MonadUI m) => Int -> [a] -> (a -> (Text, Text)) -> m () forTable minSize rows f =   tableM minSize (map (second pure . f) rows)++printGenTable :: (MonadUI m) => [[Text]] -> m ()+printGenTable rows =+  let n = if null rows then 0 else maximum (map length rows)+      padRow r = take n (r ++ repeat "")+      paddedRows = map padRow rows+      colWidths = [maximum (0 : map (T.length . (!! i)) paddedRows) | i <- [0 .. n - 1]]+      formatRow row =+        let padded = padRow row+            cells = zipWith (`T.justifyLeft` ' ') colWidths padded+         in putLine $ T.intercalate "  " cells+   in traverse_ formatRow rows  isError :: Issue -> Bool isError i = issueSeverity i == SeverityError