packages feed

hwm 0.4.0 → 0.5.0

raw patch · 32 files changed

+1319/−461 lines, 32 filesdep ~hwmPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hwm

API changes (from Hackage documentation)

- HWM.CLI.Command.Release.Publish: newtype PublishOptions
- HWM.Domain.Build: ScopeGlobal :: TargetScope
- HWM.Domain.Build: ScopePkgs :: [Pkg] -> TargetScope
- HWM.Domain.Build: data TargetScope
- HWM.Domain.Build: instance GHC.Classes.Eq HWM.Domain.Build.TargetScope
- HWM.Domain.Build: instance GHC.Show.Show HWM.Domain.Build.TargetScope
- HWM.Domain.Environments: EnviromentProfile :: Version -> Maybe [WorkspaceRef] -> Maybe (Feature StackEnvironment) -> Maybe (Feature NixEnvironment) -> Maybe Builder -> Maybe Bool -> EnviromentProfile
- HWM.Domain.Environments: [buildAllowNewer] :: BuildEnvironment -> Maybe Bool
- HWM.Domain.Environments: [buildExtraDeps] :: BuildEnvironment -> Maybe Extras
- HWM.Domain.Environments: [buildHie] :: BuildEnvironment -> Bool
- HWM.Domain.Environments: [buildNix] :: BuildEnvironment -> Bool
- HWM.Domain.Environments: [buildResolver] :: BuildEnvironment -> Name
- HWM.Domain.Environments: [envsHie] :: Environments -> Maybe Bool
- HWM.Domain.Environments: [envsNix] :: Environments -> Maybe Bool
- HWM.Domain.Environments: [envsStack] :: Environments -> Maybe Bool
- HWM.Domain.Environments: [profileHie] :: EnviromentProfile -> Maybe Bool
- HWM.Domain.Environments: data EnviromentProfile
- HWM.Domain.Environments: existsEnviroment :: (MonadReader env m, Has env Environments) => Name -> m Bool
- HWM.Domain.Environments: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Domain.Environments.EnviromentProfile
- HWM.Domain.Environments: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Domain.Environments.EnviromentProfile
- HWM.Domain.Environments: instance GHC.Classes.Eq HWM.Domain.Environments.EnviromentProfile
- HWM.Domain.Environments: instance GHC.Classes.Ord HWM.Domain.Environments.EnviromentProfile
- HWM.Domain.Environments: instance GHC.Generics.Generic HWM.Domain.Environments.EnviromentProfile
- HWM.Domain.Environments: instance GHC.Show.Show HWM.Domain.Environments.EnviromentProfile
+ HWM.CLI.App: instance Data.Aeson.Types.FromJSON.FromJSON HWM.CLI.App.CliConfig
+ HWM.CLI.Command.Release.Publish: [publishDryRun] :: PublishOptions -> Bool
+ HWM.CLI.Command.Release.Publish: data PublishOptions
+ HWM.CLI.Command.Run: data InstallCommandOptions
+ HWM.CLI.Command.Run: instance GHC.Show.Show HWM.CLI.Command.Run.InstallCommandOptions
+ HWM.CLI.Command.Run: instance GHC.Show.Show HWM.CLI.Command.Run.TaskLocalOptions
+ HWM.CLI.Command.Run: instance HWM.Core.Parsing.ParseCLI HWM.CLI.Command.Run.InstallCommandOptions
+ HWM.Core.Formatting: Ignored :: Status
+ HWM.Core.Result: SourceInclusionIssue :: Text -> [Text] -> IssueDetails
+ HWM.Core.Result: [issueComponent] :: IssueDetails -> Text
+ HWM.Core.Result: [issueTargets] :: IssueDetails -> [Text]
+ HWM.Core.Sync: SyncModeCheck :: SyncMode
+ HWM.Core.Sync: SyncModeIgnore :: SyncMode
+ HWM.Core.Sync: SyncModeSync :: SyncMode
+ HWM.Core.Sync: data SyncMode
+ HWM.Core.Sync: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance GHC.Classes.Eq HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance GHC.Classes.Ord HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance GHC.Generics.Generic HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance GHC.Show.Show HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance HWM.Core.Formatting.Format HWM.Core.Sync.SyncMode
+ HWM.Core.Sync: instance HWM.Core.Parsing.Parse HWM.Core.Sync.SyncMode
+ HWM.Domain.Build: BuildArtifact :: FilePath -> BuilderCommand
+ HWM.Domain.Environments: EnvironmentProfile :: Version -> Maybe [WorkspaceRef] -> Maybe (Feature StackEnvironment) -> Maybe (Feature NixEnvironment) -> Maybe Builder -> Maybe TargetsPolicy -> EnvironmentProfile
+ HWM.Domain.Environments: StackBuildConfig :: Name -> Maybe Extras -> Maybe Bool -> StackBuildConfig
+ HWM.Domain.Environments: SyncModeCheck :: SyncMode
+ HWM.Domain.Environments: SyncModeIgnore :: SyncMode
+ HWM.Domain.Environments: SyncModeSync :: SyncMode
+ HWM.Domain.Environments: TargetModes :: SyncMode -> SyncMode -> SyncMode -> SyncMode -> SyncMode -> TargetModes
+ HWM.Domain.Environments: [buildTargets] :: BuildEnvironment -> TargetModes
+ HWM.Domain.Environments: [envsTargets] :: Environments -> Maybe TargetsPolicy
+ HWM.Domain.Environments: [profileTargets] :: EnvironmentProfile -> Maybe TargetsPolicy
+ HWM.Domain.Environments: [stackAllowNewer] :: StackBuildConfig -> Maybe Bool
+ HWM.Domain.Environments: [stackExtraDeps] :: StackBuildConfig -> Maybe Extras
+ HWM.Domain.Environments: [stackResolver] :: StackBuildConfig -> Name
+ HWM.Domain.Environments: [targetCabal] :: TargetModes -> SyncMode
+ HWM.Domain.Environments: [targetHie] :: TargetModes -> SyncMode
+ HWM.Domain.Environments: [targetNix] :: TargetModes -> SyncMode
+ HWM.Domain.Environments: [targetPackages] :: TargetModes -> SyncMode
+ HWM.Domain.Environments: [targetStack] :: TargetModes -> SyncMode
+ HWM.Domain.Environments: data EnvironmentProfile
+ HWM.Domain.Environments: data StackBuildConfig
+ HWM.Domain.Environments: data SyncMode
+ HWM.Domain.Environments: data TargetModes
+ HWM.Domain.Environments: existsEnvironment :: (MonadReader env m, Has env Environments) => Name -> m Bool
+ HWM.Domain.Environments: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance GHC.Classes.Eq HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance GHC.Classes.Eq HWM.Domain.Environments.StackBuildConfig
+ HWM.Domain.Environments: instance GHC.Classes.Eq HWM.Domain.Environments.TargetModes
+ HWM.Domain.Environments: instance GHC.Classes.Eq HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance GHC.Classes.Ord HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance GHC.Classes.Ord HWM.Domain.Environments.StackBuildConfig
+ HWM.Domain.Environments: instance GHC.Classes.Ord HWM.Domain.Environments.TargetModes
+ HWM.Domain.Environments: instance GHC.Classes.Ord HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance GHC.Generics.Generic HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance GHC.Generics.Generic HWM.Domain.Environments.StackBuildConfig
+ HWM.Domain.Environments: instance GHC.Generics.Generic HWM.Domain.Environments.TargetModes
+ HWM.Domain.Environments: instance GHC.Generics.Generic HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance GHC.Show.Show HWM.Domain.Environments.EnvironmentProfile
+ HWM.Domain.Environments: instance GHC.Show.Show HWM.Domain.Environments.StackBuildConfig
+ HWM.Domain.Environments: instance GHC.Show.Show HWM.Domain.Environments.TargetModes
+ HWM.Domain.Environments: instance GHC.Show.Show HWM.Domain.Environments.TargetsPolicy
+ HWM.Domain.Environments: instance HWM.Core.Formatting.Format HWM.Domain.Environments.TargetModes
+ HWM.Domain.Release: [arcEnvironments] :: ArtifactConfig -> Maybe [Name]
+ HWM.Domain.Release: getArtifactEnvironments :: (Has env Cache, MonadError Issue m, Has env Environments, Has env Workspace, MonadReader env m, MonadIO m) => Release -> m [(Pkg, [BuildEnvironment])]
+ HWM.Domain.Release: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Domain.Release.ArtifactConfigRaw
+ HWM.Domain.Release: instance GHC.Classes.Eq HWM.Domain.Release.ArtifactConfigRaw
+ HWM.Domain.Release: instance GHC.Classes.Ord HWM.Domain.Release.ArtifactConfigRaw
+ HWM.Domain.Release: instance GHC.Generics.Generic HWM.Domain.Release.ArtifactConfigRaw
+ HWM.Domain.Release: instance GHC.Show.Show HWM.Domain.Release.ArtifactConfigRaw
+ HWM.Domain.Release: isArtifactEnabledInEnvironment :: Name -> ArtifactConfig -> Bool
+ HWM.Domain.Release: resolveArtifactConfig :: (MonadError Issue m, Has env Workspace, MonadReader env m, MonadIO m) => ArtifactConfig -> m (Text, Pkg)
+ HWM.Domain.Schema: ScopeGlobal :: TargetScope
+ HWM.Domain.Schema: ScopePkgs :: [Pkg] -> TargetScope
+ HWM.Domain.Schema: data TargetScope
+ HWM.Domain.Schema: instance GHC.Classes.Eq HWM.Domain.Schema.TargetScope
+ HWM.Domain.Schema: instance GHC.Show.Show HWM.Domain.Schema.TargetScope
+ HWM.Integrations.Toolchain.Cabal: validateCabalSourceInclusion :: Pkg -> ConfigT Status
+ HWM.Integrations.Toolchain.Hie: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Integrations.Toolchain.Hie.HieConfig
+ HWM.Integrations.Toolchain.Hie: instance Data.Aeson.Types.FromJSON.FromJSON HWM.Integrations.Toolchain.Hie.HieCradle
+ HWM.Integrations.Toolchain.Hie: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Integrations.Toolchain.Hie.HieConfig
+ HWM.Integrations.Toolchain.Hie: instance Data.Aeson.Types.ToJSON.ToJSON HWM.Integrations.Toolchain.Hie.HieCradle
+ HWM.Integrations.Toolchain.Hie: instance GHC.Classes.Eq HWM.Integrations.Toolchain.Hie.Component
+ HWM.Integrations.Toolchain.Hie: instance GHC.Classes.Ord HWM.Integrations.Toolchain.Hie.Component
+ HWM.Integrations.Toolchain.Hie: instance GHC.Generics.Generic HWM.Integrations.Toolchain.Hie.HieConfig
+ HWM.Integrations.Toolchain.Hie: instance GHC.Generics.Generic HWM.Integrations.Toolchain.Hie.HieCradle
+ HWM.Integrations.Toolchain.Hie: instance GHC.Show.Show HWM.Integrations.Toolchain.Hie.HieConfig
+ HWM.Integrations.Toolchain.Hie: instance GHC.Show.Show HWM.Integrations.Toolchain.Hie.HieCradle
+ HWM.Integrations.Toolchain.Nix.Build: NixEnv :: Name -> NixEnv
+ HWM.Integrations.Toolchain.Nix.Build: [envName] :: NixEnv -> Name
+ HWM.Integrations.Toolchain.Nix.Build: genNixBinary :: (MonadIO m, MonadError Issue m, MonadError Issue m) => NixEnv -> TargetScope -> FilePath -> m (Exec m)
+ HWM.Integrations.Toolchain.Nix.Build: inNixDevelop :: forall (m :: Type -> Type). Name -> Bool -> Exec m -> Exec m
+ HWM.Integrations.Toolchain.Nix.Build: newtype NixEnv
+ HWM.Integrations.Toolchain.Nix.Build: nixBuild :: Applicative m => NixEnv -> TargetScope -> m (Exec m)
+ HWM.Integrations.Toolchain.Package: syncPackagesByMode :: SyncMode -> ConfigT ()
- HWM.CLI.Command: Install :: TaskCommandOptions -> Command
+ HWM.CLI.Command: Install :: InstallCommandOptions -> Command
- HWM.CLI.Command.Release.Publish: PublishOptions :: Maybe Name -> PublishOptions
+ HWM.CLI.Command.Release.Publish: PublishOptions :: Maybe Name -> Bool -> PublishOptions
- HWM.CLI.Command.Run: runInstall :: TaskCommandOptions -> ConfigT ()
+ HWM.CLI.Command.Run: runInstall :: InstallCommandOptions -> ConfigT ()
- HWM.Domain.Environments: BuildEnvironment :: Version -> [Pkg] -> Name -> Maybe Extras -> Name -> Maybe Bool -> Builder -> Bool -> Bool -> Bool -> BuildEnvironment
+ HWM.Domain.Environments: BuildEnvironment :: Version -> [Pkg] -> Name -> StackBuildConfig -> Builder -> TargetModes -> BuildEnvironment
- HWM.Domain.Environments: Environments :: Name -> Map Name EnviromentProfile -> Maybe Builder -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Environments
+ HWM.Domain.Environments: Environments :: Name -> Map Name EnvironmentProfile -> Maybe Builder -> Maybe TargetsPolicy -> Environments
- HWM.Domain.Environments: [buildStack] :: BuildEnvironment -> Bool
+ HWM.Domain.Environments: [buildStack] :: BuildEnvironment -> StackBuildConfig
- HWM.Domain.Environments: [envsProfiles] :: Environments -> Map Name EnviromentProfile
+ HWM.Domain.Environments: [envsProfiles] :: Environments -> Map Name EnvironmentProfile
- HWM.Domain.Environments: [profileBuilder] :: EnviromentProfile -> Maybe Builder
+ HWM.Domain.Environments: [profileBuilder] :: EnvironmentProfile -> Maybe Builder
- HWM.Domain.Environments: [profileExclude] :: EnviromentProfile -> Maybe [WorkspaceRef]
+ HWM.Domain.Environments: [profileExclude] :: EnvironmentProfile -> Maybe [WorkspaceRef]
- HWM.Domain.Environments: [profileGhc] :: EnviromentProfile -> Version
+ HWM.Domain.Environments: [profileGhc] :: EnvironmentProfile -> Version
- HWM.Domain.Environments: [profileNix] :: EnviromentProfile -> Maybe (Feature NixEnvironment)
+ HWM.Domain.Environments: [profileNix] :: EnvironmentProfile -> Maybe (Feature NixEnvironment)
- HWM.Domain.Environments: [profileStack] :: EnviromentProfile -> Maybe (Feature StackEnvironment)
+ HWM.Domain.Environments: [profileStack] :: EnvironmentProfile -> Maybe (Feature StackEnvironment)
- HWM.Domain.Environments: addProfile :: Name -> EnviromentProfile -> Environments -> Environments
+ HWM.Domain.Environments: addProfile :: Name -> EnvironmentProfile -> Environments -> Environments
- HWM.Domain.Environments: mkEnvironment :: Version -> EnviromentProfile
+ HWM.Domain.Environments: mkEnvironment :: Version -> EnvironmentProfile
- HWM.Domain.Environments: 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 ()
+ HWM.Domain.Environments: printEnvironments :: (Monad m, MonadUI m, MonadReader env m, Has env Workspace, Has env Environments, MonadIO m, MonadError Issue m, Has env Cache) => m ()
- HWM.Domain.Environments: removeEnvironmentByName :: Name -> Environments -> Environments
+ HWM.Domain.Environments: removeEnvironmentByName :: MonadError Issue m => Name -> Maybe Name -> Environments -> m Environments
- HWM.Domain.Release: ArtifactConfig :: Text -> [ArchiveFormat] -> [Text] -> Text -> ArtifactConfig
+ HWM.Domain.Release: ArtifactConfig :: Text -> Maybe [Name] -> [ArchiveFormat] -> [Text] -> Text -> ArtifactConfig
- HWM.Integrations.Toolchain.Cabal: syncCabalProject :: ConfigT Status
+ HWM.Integrations.Toolchain.Cabal: syncCabalProject :: SyncMode -> ConfigT Status
- HWM.Integrations.Toolchain.Hie: syncHie :: ConfigT Status
+ HWM.Integrations.Toolchain.Hie: syncHie :: SyncMode -> ConfigT Status
- HWM.Integrations.Toolchain.Nix: syncNixFile :: ConfigT Status
+ HWM.Integrations.Toolchain.Nix: syncNixFile :: SyncMode -> ConfigT Status
- HWM.Integrations.Toolchain.Stack: syncStackYaml :: ConfigT Status
+ HWM.Integrations.Toolchain.Stack: syncStackYaml :: SyncMode -> ConfigT Status

Files

hwm.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hwm-version:        0.4.0+version:        0.5.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@@ -59,6 +59,7 @@       HWM.Core.Parsing       HWM.Core.Pkg       HWM.Core.Result+      HWM.Core.Sync       HWM.Core.Version       HWM.Domain.Bounds       HWM.Domain.Build@@ -69,6 +70,7 @@       HWM.Domain.Environments       HWM.Domain.Registry       HWM.Domain.Release+      HWM.Domain.Schema       HWM.Domain.Workspace       HWM.Integrations.Scaffold       HWM.Integrations.Toolchain.Cabal@@ -76,6 +78,7 @@       HWM.Integrations.Toolchain.Hie       HWM.Integrations.Toolchain.Hpack       HWM.Integrations.Toolchain.Nix+      HWM.Integrations.Toolchain.Nix.Build       HWM.Integrations.Toolchain.Package       HWM.Integrations.Toolchain.Stack       HWM.Runtime.Archive@@ -148,7 +151,7 @@     , hpack >=0.34.6 && <=0.39.3     , http-client >=0.6.4.1 && <=0.7.19     , http-types >=0.12.3.0 && <=0.12.4-    , hwm >=0.4.0 && <0.5.0+    , hwm >=0.5.0 && <0.6.0     , modern-uri >=0.3.4.3 && <=0.3.6.1     , mtl >2.0.0 && <2.6.0     , optparse-applicative >=0.16.1.0 && <=0.19.0.0
src/HWM/CLI/App.hs view
@@ -9,7 +9,10 @@   ) where +import Data.Aeson (FromJSON (..), withObject, (.:?))+import qualified Data.Map as Map import qualified Data.Text as T+import qualified Data.Yaml as Yaml import HWM.CLI.Command (Command (..), Options (..), currentVersion, defaultOptions, runCommand) import HWM.Core.Parsing (ParseCLI (..), flag) import Options.Applicative@@ -29,6 +32,7 @@     subparser,   ) import Relude+import qualified System.Environment as Env  -- Helper for building commands (unchanged, just added type signature clarity) @@ -41,67 +45,63 @@         (fullDesc <> progDesc "HWM - Haskell Workspace Manager for Monorepos")     ) -commands :: [(String, String, Parser a)] -> Parser a+commands :: [CommandDef] -> Parser Command commands =   subparser     . mconcat     . map       (\(name, desc, value) -> command name (info (helper <*> value) (fullDesc <> progDesc desc))) +type CommandKey = String++type CommandDef = (CommandKey, String, Parser Command)++commandDefs :: [CommandDef]+commandDefs =+  [ ("init", "Initialize a new HWM workspace by scanning the directory structure.", Init <$> parseCLI),+    ("status", "Show current project version, active environment, and sync state.", pure Status),+    ("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", "Execute a script defined in hwm.yaml (e.g., build, test, lint).", Run <$> argument (T.pack <$> str) (metavar "SCRIPT" <> help "Script name") <*> parseCLI),+    ("workspace", "Manage workspace groups and package members.", Workspace <$> parseCLI),+    ("environments", "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),+    ("build", "Build the current workspace or specific targets.", Build <$> parseCLI),+    ("install", "Install the current workspace or specific targets.", Install <$> parseCLI),+    ("test", "Test the current workspace or specific targets.", Test <$> parseCLI),+    ("release", "Manage delivery: build artifacts or publish release trains.", Release <$> parseCLI)+  ]+ parseCommand :: Parser Command-parseCommand =-  commands-    [ ( "init",-        "Initialize a new HWM workspace by scanning the directory structure.",-        Init <$> parseCLI-      ),-      ( "status",-        "Show current project version, active environment, and sync state.",-        pure Status-      ),-      ( "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",-        "Execute a script defined in hwm.yaml (e.g., build, test, lint).",-        Run <$> argument (T.pack <$> str) (metavar "SCRIPT" <> help "Script name") <*> parseCLI-      ),-      ( "workspace",-        "Manage workspace groups and package members.",-        Workspace <$> parseCLI-      ),-      ( "environments",-        "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-      ),-      ( "build",-        "Build the current workspace or specific targets.",-        Build <$> parseCLI-      ),-      ( "install",-        "Install the current workspace or specific targets.",-        Install <$> parseCLI-      ),-      ( "test",-        "Test the current workspace or specific targets.",-        Test <$> parseCLI-      ),-      ( "release",-        "Manage delivery: build artifacts or publish release trains.",-        Release <$> parseCLI-      )-    ]-    <|> (Run <$> argument (T.pack <$> str) mempty <*> parseCLI)+parseCommand = commands commandDefs +newtype CliConfig = CliConfig {cfgScripts :: Maybe (Map.Map Text Text)}++instance FromJSON CliConfig where+  parseJSON = withObject "CliConfig" $ \obj -> CliConfig <$> obj .:? "scripts"++topLevelCommands :: [String]+topLevelCommands = map (\(name, _, _) -> name) commandDefs++scriptExists :: Text -> IO Bool+scriptExists scriptName = do+  cfg <- Yaml.decodeFileEither "hwm.yaml"+  pure $ case cfg of+    Right CliConfig {cfgScripts = Just scripts} -> Map.member scriptName scripts+    _ -> False++injectRunForScript :: [String] -> IO [String]+injectRunForScript args =+  case break isCommandToken args of+    (prefix, cmd : rest)+      | cmd `elem` topLevelCommands -> pure args+      | otherwise -> do+          hasScript <- scriptExists (toText cmd)+          pure $ if hasScript then prefix <> ["run", cmd] <> rest else args+    _ -> pure args+  where+    isCommandToken token = token /= "--" && not ("-" `isPrefixOf` token)+ data Input = Input   { v :: Bool,     q :: Bool,@@ -119,7 +119,9 @@  main :: IO () main = do-  Input {v, q, cmd} <- parseInput+  rawArgs <- Env.getArgs+  args <- injectRunForScript rawArgs+  Input {v, q, cmd} <- Env.withArgs args parseInput   if v     then putStrLn ("HWM v" ++ currentVersion)     else case cmd of
src/HWM/CLI/Command.hs view
@@ -16,7 +16,7 @@ import HWM.CLI.Command.Init (InitOptions (..), initWorkspace) import HWM.CLI.Command.Registry.Root (RegistryCommand, runRegistry) import HWM.CLI.Command.Release.Root (ReleaseCommand (..), runRelease)-import HWM.CLI.Command.Run (ScriptOptions, TaskCommandOptions, runBuild, runInstall, runScript, runTest)+import HWM.CLI.Command.Run (InstallCommandOptions, ScriptOptions, TaskCommandOptions, runBuild, runInstall, runScript, runTest) import HWM.CLI.Command.Status (showStatus) import HWM.CLI.Command.Sync (sync) import HWM.CLI.Command.Version (VersionOptions, runVersion)@@ -39,7 +39,7 @@   | Env EnvCommand   | Workspace WorkspaceCommand   | Release ReleaseCommand-  | Install TaskCommandOptions+  | Install InstallCommandOptions   | Build TaskCommandOptions   | Test TaskCommandOptions   deriving (Show)
src/HWM/CLI/Command/Environment/Add.hs view
@@ -11,7 +11,7 @@ import HWM.Core.Version (Version) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, updateConfig)-import HWM.Domain.Environments (addProfile, existsEnviroment, mkEnvironment, printEnvironments)+import HWM.Domain.Environments (addProfile, existsEnvironment, mkEnvironment, printEnvironments) import HWM.Runtime.UI (minRowSize, section, uiRow) import Options.Applicative (help, metavar, strArgument) import Options.Applicative.Builder (argument, str)@@ -31,16 +31,15 @@  runEnvAdd :: EnvAddOptions -> ConfigT () runEnvAdd EnvAddOptions {..} = do-  exists <- existsEnviroment envName+  exists <- existsEnvironment envName   if exists     then do-      printEnvironments Nothing+      printEnvironments       throwError $ fromString $ "Environment '" <> toString envName <> "' already exists."-    else section "new environment" $ do-      uiRow minRowSize "name" envName+    else do+      section "new environment" $ do+        uiRow minRowSize "name" envName+        uiRow minRowSize "ghc" (format envGHC)       updateConfig-        ( \cfg@Config {..} -> do-            uiRow minRowSize "ghc" (format envGHC)-            pure cfg {cfgEnvironments = addProfile envName (mkEnvironment envGHC) cfgEnvironments}-        )+        (\cfg@Config {..} -> pure cfg {cfgEnvironments = addProfile envName (mkEnvironment envGHC) cfgEnvironments})         (pure ())
src/HWM/CLI/Command/Environment/Ls.hs view
@@ -14,4 +14,4 @@   parseCLI = pure EnvLsOptions  runEnvLs :: EnvLsOptions -> ConfigT ()-runEnvLs _ = printEnvironments Nothing+runEnvLs _ = printEnvironments
src/HWM/CLI/Command/Environment/Remove.hs view
@@ -4,28 +4,37 @@  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 HWM.Domain.Environments (printEnvironments, removeEnvironmentByName)+import Options.Applicative (help, long, metavar, strArgument, strOption) import Relude -newtype EnvRemoveOptions = EnvRemoveOptions-  {envName :: Name}+data EnvRemoveOptions = EnvRemoveOptions+  { envName :: Name,+    envSetDefault :: Maybe Name+  }   deriving (Show)  instance ParseCLI EnvRemoveOptions where   parseCLI =     EnvRemoveOptions       <$> strArgument (metavar "ENVIRONMENT" <> help "Name of the environment to remove")+      <*> optional+        ( strOption+            ( long "set-default"+                <> metavar "ENV"+                <> help "Required when removing current default environment; choose the new default."+            )+        )  runEnvRemove :: EnvRemoveOptions -> ConfigT ()-runEnvRemove EnvRemoveOptions {..} = do-  exists <- existsEnviroment envName-  unless exists $ throwError $ fromString $ "Environment '" <> toString envName <> "' does not exist."+runEnvRemove EnvRemoveOptions {..} =   updateConfig-    (\cfg@Config {..} -> pure cfg {cfgEnvironments = removeEnvironmentByName envName cfgEnvironments})-    (printEnvironments Nothing)+    ( \cfg@Config {..} -> do+        nextEnvs <- removeEnvironmentByName envName envSetDefault cfgEnvironments+        pure cfg {cfgEnvironments = nextEnvs}+    )+    printEnvironments
src/HWM/CLI/Command/Environment/SetDefault.hs view
@@ -21,4 +21,4 @@ runEnvSetDefault EnvSetDefaultOptions {..} = do   _ <- getBuildEnvironment (Just envName)   let setDefaultEnv cfg = cfg {cfgEnvironments = (cfgEnvironments cfg) {envsDefault = envName}}-  updateConfig (pure . setDefaultEnv) $ printEnvironments Nothing+  updateConfig (pure . setDefaultEnv) printEnvironments
src/HWM/CLI/Command/Init.hs view
@@ -59,10 +59,7 @@     pkgs <- scanPkgs root     scanning "packages" pkgs     when (null pkgs)-      $ throwError-        "No Haskell packages detected in the current directory.\n\-        \Please ensure you are in the project's root and that your packages are discoverable.\n\-        \Try running 'hwm init' from the root directory containing your package sources."+      $ throwError "No Haskell packages detected in the current directory. Run 'hwm init' from your project root containing package sources."     packages <- traverse readCabalPackage pkgs     cfgVersion <- deriveVersion (map getPkgVersion packages)     cfgEnvironments <- buildMatrix pkgs stacks
src/HWM/CLI/Command/Release/Artifacts.hs view
@@ -9,20 +9,19 @@   ) where -import Control.Monad.Except (MonadError (..))-import qualified Data.Text as T+import Control.Monad.Error.Class (MonadError (throwError)) import Data.Traversable (for) import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (format), Status (..), formatList, statusIcon) import HWM.Core.Parsing (Parse (..), ParseCLI (..), parseLS) import HWM.Core.Result (fromEither)-import HWM.Domain.Build (BuildFlag (GHCOptionsFlag), Builder (..), BuilderCommand (..), TargetScope (ScopePkgs))+import HWM.Domain.Build (BuildFlag (GHCOptionsFlag), Builder (..), BuilderCommand (..)) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, Env (..), getArchiveConfigs) import HWM.Domain.Dispatcher (DispatcheCommand (..), dispatch) import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment, overrideBuilder)-import HWM.Domain.Release (ArchiveFormat, ArtifactConfig (..), ReleaseArtifactConfigs, selectedArtifacts)-import HWM.Domain.Workspace (resolveWorkspaces)+import HWM.Domain.Release (ArchiveFormat, ArtifactConfig (..), ReleaseArtifactConfigs, isArtifactEnabledInEnvironment, resolveArtifactConfig, selectedArtifacts)+import HWM.Domain.Schema (TargetScope (ScopePkgs)) import HWM.Integrations.Toolchain.Github (ensureIsLatestTag) import HWM.Runtime.Archive (ArchiveInfo (..), ArchivingPlan (..), createArchive) import HWM.Runtime.Network (getGHUploadUrl, uploadToGitHub)@@ -57,7 +56,7 @@             <> showDefault         )       <*> optional (option (parseLS <$> str) (long "format" <> metavar "FORMAT" <> help "Override the archive format for the release target. Supported: zip, tar.gz."))-      <*> optional (option (parseLS <$> str) (long "ghc-options" <> metavar "GHC_OPTION" <> help "Override GHC options for the release target. Can be specified multiple times."))+      <*> (mkOptional . concat <$> many (option (parseLS <$> str) (long "ghc-options" <> metavar "GHC_OPTION" <> help "Override GHC options for the release target. Repeatable; also accepts comma-separated values.")))       <*> optional (strOption (long "name-template" <> metavar "NAME_TEMPLATE" <> help "Override the name template for the release target. Use {name} and {version} as placeholders."))       <*> optional (option (str >>= parse) (long "builder" <> metavar "BUILDER" <> help "Override the builder for the release target. Supported: cabal, stack, nix.")) @@ -75,9 +74,25 @@   removePathForcibly dir   createDirectoryIfMissing True dir +mkOptional :: [a] -> Maybe [a]+mkOptional [] = Nothing+mkOptional xs = Just xs+ parseFormats :: [Text] -> ConfigT [ArchiveFormat] parseFormats = fromEither "can't parse archive format" . traverse parse +validateTargetEnvironment :: Name -> (Name, ArtifactConfig) -> ConfigT ()+validateTargetEnvironment envName (target, cfg@ArtifactConfig {arcEnvironments = allowedEnvs}) =+  unless (isArtifactEnabledInEnvironment envName cfg)+    $ throwError+    $ fromString+    $ "Artifact '"+    <> toString target+    <> "' is not enabled for environment '"+    <> toString envName+    <> "'. Allowed environments: "+    <> (if maybe True null allowedEnvs then "<none>" else toString (formatList ", " (fromMaybe [] allowedEnvs)))+ withOverrides :: ReleaseArchiveOptions -> ReleaseArtifactConfigs -> ConfigT [(Name, ArtifactConfig)] withOverrides ReleaseArchiveOptions {..} cfgs = do   parsedFormats <- traverse parseFormats ovFormat@@ -92,14 +107,18 @@  runReleaseArchive :: ReleaseArchiveOptions -> ConfigT () runReleaseArchive ops@ReleaseArchiveOptions {..} = do-  prepeareDir defaultOutputDir+  if outputDir == defaultOutputDir+    then prepeareDir defaultOutputDir+    else liftIO $ createDirectoryIfMissing True outputDir   cfg <- asks config   version <- asks (cfgVersion . config)   cfgs <- getArchiveConfigs >>= withOverrides ops   ghTag <- if ghPublish then Just <$> ensureIsLatestTag version else pure Nothing   uploadUrl <- maybe (pure Nothing) (fmap Just . getGHUploadUrl cfg) ghTag-  defaultBuilder <- buildBuilder <$> getBuildEnvironment Nothing+  activeEnv <- getBuildEnvironment Nothing+  let defaultBuilder = buildBuilder activeEnv   let builder = fromMaybe defaultBuilder opsBuilder+  traverse_ (validateTargetEnvironment (buildName activeEnv)) cfgs   sectionTableM     "artifacts"     [ ("destination", pure $ maybe (format outputDir) format uploadUrl),@@ -131,11 +150,9 @@       uiSubPath sha256Path  buildPkg :: FilePath -> Builder -> (Name, ArtifactConfig) -> ConfigT (Text, ArchivingPlan)-buildPkg outputDir builder (name, ArtifactConfig {..}) = do+buildPkg outputDir builder (name, cfg@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+  (executableName, pkg) <- resolveArtifactConfig cfg   env <- overrideBuilder builder <$> getBuildEnvironment Nothing-  dispatch (DispatcheCommand (Install binaryDir) (ScopePkgs [pkg]) (map GHCOptionsFlag arcGhcOptions)) env+  dispatch (DispatcheCommand (BuildArtifact binaryDir) (ScopePkgs [pkg]) (map GHCOptionsFlag arcGhcOptions)) env   pure (statusIcon Checked, ArchivingPlan {nameTemplate = arcNameTemplate, outDir = outputDir, sourceDir = binaryDir, name = executableName, archiveFormats = arcFormats})
src/HWM/CLI/Command/Release/Publish.hs view
@@ -33,7 +33,8 @@ import HWM.Integrations.Toolchain.Package (deriveDependencyGraph) import HWM.Runtime.Network (getHackageToken, uploadToHackage) import HWM.Runtime.UI (printSummary, sectionTableM, section_, uiSubPathRow)-import Options.Applicative (argument, help, metavar, str)+import Options.Applicative (argument, help, long, metavar, str)+import Options.Applicative.Builder (switch) import Relude hiding (intercalate) import System.Directory (getCurrentDirectory) import System.FilePath (makeRelative)@@ -50,8 +51,9 @@ unpackPath (pkg, Just path) = pure (pkg, path) unpackPath (pkg, Nothing) = throwError $ fromString $ "No file path found for package " <> toString (printPkgWSRef pkg) -newtype PublishOptions = PublishOptions-  { publishGroup :: Maybe Name+data PublishOptions = PublishOptions+  { publishGroup :: Maybe Name,+    publishDryRun :: Bool   }   deriving (Show) @@ -59,6 +61,7 @@   parseCLI =     PublishOptions       <$> optional (argument str (metavar "GROUP" <> help "Name of the release group to publish (default: all)"))+      <*> switch (long "dry-run" <> help "Validate publish prerequisites and show the plan without uploading to Hackage")  arrangePackageRelease :: [Pkg] -> ConfigT [Pkg] arrangePackageRelease pkgs = do@@ -84,7 +87,8 @@     "publish"     [ ("version", pure $ chalk Magenta (format version)),       ("target", pure $ chalk Cyan (fromMaybe "all" publishGroup)),-      ("registry", pure "hackage")+      ("registry", pure "hackage"),+      ("mode", pure $ if publishDryRun then chalk Yellow "dry-run" else chalk Cyan "publish")     ]    pkgs <- arrangePackageRelease (concatMap snd wgs)@@ -103,8 +107,14 @@       uiSubPathRow size (show idx <> ". " <> printPkgWSRef pkg) (format $ makeRelative cwd filePath)    token <- getHackageToken-  section_ "publishing" $ do-    for_ releasePkgs $ \(pkg, filePath) -> do+  if publishDryRun+    then section_ "publishing (dry-run)" $ do+      let _tokenUsed = token+      for_ releasePkgs $ \(pkg, _) -> uiSubPathRow size (printPkgWSRef pkg) (statusIcon Checked)+    else section_ "publishing" $ do+      for_ releasePkgs $ \pkg -> publishPackage size token pkg+  where+    publishPackage size token (pkg, filePath) = do       issues <- uploadToHackage token pkg filePath       let status = if null issues then Checked else Invalid       uiSubPathRow size (printPkgWSRef pkg) (statusIcon status)
src/HWM/CLI/Command/Run.hs view
@@ -7,21 +7,25 @@   ( runScript,     ScriptOptions,     TaskCommandOptions,+    InstallCommandOptions,     runBuild,     runInstall,     runTest,   ) where +import qualified Data.Text as T import HWM.Core.Common (Name) import HWM.Core.Parsing (ParseCLI (..), parseOptions)-import HWM.Domain.Build (BuildFlag (..), BuilderCommand (..), TargetScope (..))+import HWM.Domain.Build (BuildFlag (..), BuilderCommand (..)) import HWM.Domain.Config (getScript) import HWM.Domain.ConfigT (ConfigT, config) import HWM.Domain.Dispatcher (DispatcheCommand (..), dispatchForEach) import HWM.Domain.Environments (selectEnvironments)+import HWM.Domain.Schema (TargetScope (..)) import HWM.Domain.Workspace (printPkgWSRef, resolveWorkspaces) import HWM.Runtime.Files (getLocalBinDir, warnBindDir)+import HWM.Runtime.Platform (OS (..), detectPlatform, os) import HWM.Runtime.Process (Exec (..), inheritRun) import HWM.Runtime.UI (minRowSize, putLine, sectionWorkspace, uiRow, uiSubPath) import Options.Applicative@@ -44,16 +48,36 @@ runScript scriptName ScriptOptions {..} = do   cfg <- asks config   script <- getScript scriptName cfg-  putLine ("❯ " <> script)-  inheritRun Exec {execCmd = script, execArgs = scriptOptions, execEnv = [], postCommand = Nothing}+  platform <- liftIO detectPlatform+  let quoteArg = case os platform of+        Windows -> cmdEscape+        _ -> shEscape+  let scriptCmd = if null scriptOptions then script else script <> " " <> T.unwords (map quoteArg scriptOptions)+  putLine ("❯ " <> scriptCmd)+  inheritRun Exec {execCmd = scriptCmd, execArgs = [], execEnv = [], postCommand = Nothing}+  where+    shEscape :: Text -> Text+    shEscape arg = "'" <> T.replace "'" "'\"'\"'" arg <> "'" +    cmdEscape :: Text -> Text+    cmdEscape arg = "\"" <> T.replace "\"" "\"\"" arg <> "\""+ data TaskCommandOptions = TaskCommandOptions-  { opsEnviroments :: [Name],+  { opsEnvironments :: [Name],     opsWorkspaces :: [Name],     opsFast :: Bool   }   deriving (Show) +newtype InstallCommandOptions = InstallCommandOptions {installTaskOptions :: TaskLocalOptions}+  deriving (Show)++data TaskLocalOptions = TaskLocalOptions+  { localWorkspaces :: [Name],+    localFast :: Bool+  }+  deriving (Show)+ instance ParseCLI TaskCommandOptions where   parseCLI =     TaskCommandOptions@@ -61,6 +85,14 @@       <*> many (argument str (metavar "WORKSPACE" <> help "Limit to package (core) or group (libs)"))       <*> switch (long "fast" <> help "Enable fast mode") +instance ParseCLI InstallCommandOptions where+  parseCLI =+    InstallCommandOptions+      <$> ( TaskLocalOptions+              <$> many (argument str (metavar "WORKSPACE" <> help "Limit to package (core) or group (libs)"))+              <*> switch (long "fast" <> help "Enable fast mode")+          )+ parseTargets :: [Name] -> ConfigT TargetScope parseTargets names = case names of   [] -> do@@ -74,19 +106,19 @@ runBuild :: TaskCommandOptions -> ConfigT () runBuild TaskCommandOptions {..} = do   scope <- parseTargets opsWorkspaces-  envs <- selectEnvironments opsEnviroments+  envs <- selectEnvironments opsEnvironments   dispatchForEach (DispatcheCommand Build scope [BuildFastFlag | opsFast]) envs -runInstall :: TaskCommandOptions -> ConfigT ()-runInstall TaskCommandOptions {..} = do-  scope <- parseTargets opsWorkspaces-  envs <- selectEnvironments opsEnviroments+runInstall :: InstallCommandOptions -> ConfigT ()+runInstall (InstallCommandOptions TaskLocalOptions {..}) = do+  scope <- parseTargets localWorkspaces+  envs <- selectEnvironments []   binDir <- getLocalBinDir   warnBindDir binDir-  dispatchForEach (DispatcheCommand (Install binDir) scope [BuildFastFlag | opsFast]) envs+  dispatchForEach (DispatcheCommand (Install binDir) scope [BuildFastFlag | localFast]) envs  runTest :: TaskCommandOptions -> ConfigT () runTest TaskCommandOptions {..} = do   scope <- parseTargets opsWorkspaces-  envs <- selectEnvironments opsEnviroments+  envs <- selectEnvironments opsEnvironments   dispatchForEach (DispatcheCommand Test scope [BuildFastFlag | opsFast]) envs
src/HWM/CLI/Command/Status.hs view
@@ -20,5 +20,5 @@     [ ("name", pure $ chalk Magenta (cfgName cfg)),       ("version", pure $ chalk Green (format $ cfgVersion cfg))     ]-  printEnvironments Nothing+  printEnvironments   validatePackages
src/HWM/CLI/Command/Sync.hs view
@@ -4,13 +4,14 @@ module HWM.CLI.Command.Sync (sync) where  import HWM.Core.Common (Name)-import HWM.Core.Formatting (Color (..), Format (..), chalk)+import HWM.Core.Formatting (Color (..), Format (..), Status (..), chalk)+import HWM.Core.Sync (SyncMode (..)) import HWM.Domain.ConfigT (ConfigT)-import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment)+import HWM.Domain.Environments (BuildEnvironment (..), StackBuildConfig (..), TargetModes (..), getBuildEnvironment) import HWM.Integrations.Toolchain.Cabal (syncCabalProject) import HWM.Integrations.Toolchain.Hie (syncHie) import HWM.Integrations.Toolchain.Nix (syncNixFile)-import HWM.Integrations.Toolchain.Package (syncPackages)+import HWM.Integrations.Toolchain.Package (syncPackagesByMode) import HWM.Integrations.Toolchain.Stack (syncStackYaml) import HWM.Runtime.Cache (Registry (..), updateRegistry) import HWM.Runtime.UI (sectionConfig, sectionTableM)@@ -22,13 +23,23 @@   updateRegistry $ \reg -> reg {currentEnv = buildName env}   sectionTableM     "sync"-    [ ("enviroment", pure $ chalk Cyan $ format env),-      ("resolver", pure $ buildResolver env)+    [ ("environment", pure $ chalk Cyan $ format env),+      ("resolver", pure $ stackResolver (buildStack env))     ]-  sectionConfig-    ( [("cabal.project", syncCabalProject)]-        <> [("stack.yaml", syncStackYaml) | buildStack env]-        <> [("flake.nix", syncNixFile) | buildNix env]-        <> [("hie.yaml", syncHie) | buildHie env]-    )-  syncPackages+  sectionConfig (syncTargets env)+  syncPackagesByMode (targetPackages $ buildTargets env)++syncTargets :: BuildEnvironment -> [(Text, ConfigT Status)]+syncTargets env =+  [ (label, action mode)+  | (mode, label, action) <- targets,+    mode /= SyncModeIgnore+  ]+  where+    modes = buildTargets env+    targets =+      [ (targetCabal modes, "cabal.project", syncCabalProject),+        (targetStack modes, "stack.yaml", syncStackYaml),+        (targetNix modes, "flake.nix", syncNixFile),+        (targetHie modes, "hie.yaml", syncHie)+      ]
src/HWM/CLI/Command/Workspace/Add.hs view
@@ -10,8 +10,10 @@ import HWM.Core.Parsing (ParseCLI (..)) import HWM.Core.Pkg (PkgName (..), mkPkgDirPath, resolvePrefix) import HWM.Core.Result (Issue (..), MonadIssue (injectIssue), Severity (SeverityError, SeverityWarning))+import HWM.Core.Sync (SyncMode (..)) import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, Env (config), updateConfig, updateConfigM)+import HWM.Domain.Environments (BuildEnvironment (..), TargetModes (..), getBuildEnvironment) import HWM.Domain.Workspace (WorkGroup (..), WorkspaceRef (..), addWorkgroupMember, parseWorkspaceRef) import HWM.Integrations.Scaffold (scaffoldPackage) import HWM.Integrations.Toolchain.Hie (syncHie)@@ -62,8 +64,17 @@       xs <- scaffoldPackage (mkPkgDirPath (dir w) (prefix w) memberId) (PkgName $ resolvePrefix (prefix w) memberId)       displayStatusM xs >>= uiSubPathRow minRowSize memberId -  updateConfigM (\cfg -> pure $ cfg {cfgWorkspace = ws}) [("stack.yaml", syncStackYaml), ("hie.yaml", syncHie)] $ pure ()+  BuildEnvironment {buildTargets = TargetModes {..}} <- getBuildEnvironment Nothing+  let toolchainActions =+        catMaybes+          [ withMode targetStack "stack.yaml" syncStackYaml,+            withMode targetHie "hie.yaml" syncHie+          ]+  updateConfigM (\cfg -> pure $ cfg {cfgWorkspace = ws}) toolchainActions $ pure ()   where+    withMode SyncModeIgnore _ _ = Nothing+    withMode mode label action = Just (label, action mode)+     noEffect label =       Issue         { issueTopic = memberId,
src/HWM/Core/Formatting.hs view
@@ -91,7 +91,7 @@  type StatusM m = [(Name, m Status)] -data Status = Checked | Updated | Warning | Invalid+data Status = Checked | Ignored | Updated | Warning | Invalid   deriving (Show, Eq, Ord)  instance Semigroup Status where@@ -128,6 +128,7 @@  labelColor :: Status -> Color labelColor Checked = Dim+labelColor Ignored = Gray labelColor Updated = Dim labelColor Warning = Yellow labelColor Invalid = Red@@ -135,6 +136,7 @@ statusIcon :: Status -> Text statusIcon s = case s of   Checked -> chalk Green "✓"+  Ignored -> chalk Gray "⊘"   Updated -> chalk Cyan "⟳"   Invalid -> chalk Red "✖"   Warning -> chalk Yellow "!"
src/HWM/Core/Result.hs view
@@ -40,6 +40,10 @@       { issueDependencies :: [(Text, Text, Text, Text)],         issueFile :: FilePath       }+  | SourceInclusionIssue+      { issueComponent :: Text,+        issueTargets :: [Text]+      }   deriving (Show, Eq, Ord)  data Issue = Issue
+ src/HWM/Core/Sync.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Core.Sync (SyncMode (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..))+import HWM.Core.Formatting (Format (..))+import HWM.Core.Parsing (Parse (..))+import Relude++data SyncMode = SyncModeSync | SyncModeCheck | SyncModeIgnore+  deriving (Generic, Show, Ord, Eq)++instance Parse SyncMode where+  parse "sync" = pure SyncModeSync+  parse "check" = pure SyncModeCheck+  parse "ignore" = pure SyncModeIgnore+  parse x = fail $ "Invalid sync mode: " <> toString x <> ". Expected one of: sync, check, ignore"++instance Format SyncMode where+  format SyncModeSync = "sync"+  format SyncModeCheck = "check"+  format SyncModeIgnore = "ignore"++instance FromJSON SyncMode where+  parseJSON (String x) = parse x+  parseJSON _ = fail "Invalid sync mode. Expected one of: sync, check, ignore"++instance ToJSON SyncMode where+  toJSON = String . format
src/HWM/Domain/Build.hs view
@@ -7,7 +7,6 @@ module HWM.Domain.Build   ( Builder (..),     BuilderCommand (..),-    TargetScope (..),     BuildFlag (..),     toExec,     comandLabel,@@ -19,14 +18,14 @@ import Data.Aeson (FromJSON (..), ToJSON (toJSON)) import Data.Aeson.Types (Value (..)) import HWM.Core.Common (Name)-import HWM.Core.Formatting (Format (..), toCamelCase)+import HWM.Core.Formatting (Format (..)) import HWM.Core.Parsing (Parse (..))-import HWM.Core.Pkg (Pkg (..), PkgName)+import HWM.Core.Pkg (Pkg (..)) import HWM.Core.Result (Issue)+import HWM.Domain.Schema (TargetScope (..))+import HWM.Integrations.Toolchain.Nix.Build (NixEnv (..), inNixDevelop, nixBuild) import HWM.Runtime.Process (EnvVars, Exec (..), mkExec) import Relude-import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, doesPathExist, emptyPermissions, listDirectory, removeFile, removePathForcibly, setOwnerExecutable, setOwnerReadable, setOwnerWritable, setPermissions)-import System.FilePath ((</>))  data Builder   = CabalBuilder {inNixDevelopment :: Bool}@@ -43,7 +42,7 @@   parse "nix/cabal" = pure CabalBuilder {inNixDevelopment = True}   parse "stack" = pure StackBuilder   parse "nix" = pure NixBuilder-  parse _ = fail "Invalid builder. Expected 'cabal', 'stack', or 'nix'."+  parse _ = fail "Invalid builder. Expected 'cabal', 'stack', 'nix', or 'nix/cabal'."  instance ToJSON Builder where   toJSON = String . format@@ -61,80 +60,13 @@ comandLabel Build {} = "build" comandLabel Test {} = "test" comandLabel Install {} = "build"--extractNixArtifact :: (MonadIO m, MonadError Issue m) => PkgName -> FilePath -> m ()-extractNixArtifact pkgName distDir = do-  let resultLink = distDir </> "result"-      finalDest = distDir </> toString pkgName-      pkgStr = toString (format pkgName)--  liftIO $ createDirectoryIfMissing True distDir-  isLink <- liftIO $ doesPathExist resultLink-  unless isLink-    $ throwError-    $ fromString-    $ "Nix build completed, but did not create an output at: "-    <> resultLink-    <> "\n(This usually means the Nix derivation is empty or 'exec' hid a build failure.)"-  let searchPaths =-        [ resultLink </> "bin" </> pkgStr, -- Standard Haskell (Cabal/Stack)-          resultLink </> pkgStr, -- Simple/Single-binary derivation-          resultLink -- Derivation is the binary itself-        ]-  maybeSource <- findM (liftIO . doesFileExist) searchPaths--  case maybeSource of-    Just sourcePath -> do-      liftIO $ copyFile sourcePath finalDest-      -- Ensure the user can execute it (Nix store is read-only)-      liftIO $ do-        let properPerms =-              setOwnerReadable True-                $ setOwnerWritable True-                $ setOwnerExecutable True emptyPermissions-        setPermissions finalDest properPerms-      -- Cleanup: Remove the 'result' symlink to keep the folder clean-      liftIO $ removeFile resultLink-    Nothing -> throwError $ fromString $ "Nix build succeeded, but binary '" <> pkgStr <> "' not found inside the Nix store path.\n"--extractGlobalNixArtifacts :: (MonadIO m, MonadError Issue m) => FilePath -> m ()-extractGlobalNixArtifacts distDir = do-  let resultLink = distDir </> "result-global"-      binDir = resultLink </> "bin"--  isLink <- liftIO $ doesPathExist resultLink-  unless isLink $ throwError "Nix global build failed to produce a result symlink."--  hasBin <- liftIO $ doesPathExist binDir-  if hasBin-    then do-      -- Copy everything inside result-global/bin/-      files <- liftIO $ listDirectory binDir-      for_ files $ \file -> do-        let sourcePath = binDir </> file-        let destPath = distDir </> file-        liftIO $ copyFile sourcePath destPath-    -- (Apply the same executable permissions here as before)-    else-      -- Fallback if the default package is just a single binary at the root-      throwError "Global Nix install succeeded, but no 'bin/' directory was found in the output."--  -- Clean up the symlink-  liftIO $ removePathForcibly resultLink--findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)-findM _ [] = pure Nothing-findM p (x : xs) = ifM (p x) (pure $ Just x) (findM p xs)--data TargetScope-  = ScopeGlobal -- User typed: hwm build (Build everything)-  | ScopePkgs [Pkg] -- User typed: hwm build -w=libs/... (Build these)-  deriving (Eq, Show)+comandLabel BuildArtifact {} = "build"  data BuilderCommand   = Build   | Test   | Install {dirPath :: FilePath}+  | BuildArtifact {dirPath :: FilePath}   deriving (Eq, Show)  data BuildFlag@@ -144,7 +76,7 @@   deriving (Eq, Show)  formatFlag :: Builder -> BuildFlag -> [Text]--- WARNING: Nix does not accept '--ghc-options' via CLI; it must be set in the flake.+-- Nix does not accept '--ghc-options' via CLI; it must be set in the flake. formatFlag NixBuilder _ = [] formatFlag CabalBuilder {} BuildFastFlag = ["--disable-optimization"] formatFlag StackBuilder BuildFastFlag = ["--fast"]@@ -153,52 +85,44 @@  toExec :: (MonadIO m, MonadError Issue m) => Name -> Builder -> BuilderCommand -> TargetScope -> [BuildFlag] -> [(String, String)] -> m (Exec m) toExec envName builder cmd scope flags envs = do-  Exec {..} <- toAction (Env envName) builder cmd scope+  Exec {..} <- toAction (NixEnv envName) builder cmd scope   pure $ inNixDevelop envName nixEnabled $ Exec execCmd (execArgs <> concatMap (formatFlag builder) flags) envs postCommand   where     nixEnabled = CabalBuilder {inNixDevelopment = True} == builder -toNixEnv :: Text -> Text-toNixEnv name = ".#" <> toCamelCase name--inNixDevelop :: Name -> Bool -> Exec m -> Exec m-inNixDevelop envName True (Exec cmd ops env post) = Exec "nix" (["develop", toNixEnv envName, "--command", cmd] <> ops) env post-inNixDevelop _ False e = e--nixScope :: (Format p) => p -> TargetScope -> [Text]-nixScope envName ScopeGlobal =-  let envSuffix = toCamelCase (format envName)-   in [".#env-" <> envSuffix <> "-all"]-nixScope envName (ScopePkgs pkgs) =-  let envSuffix = toCamelCase (format envName)-   in map (\pkg -> ".#" <> format (pkgName pkg) <> "-" <> envSuffix) pkgs--handleScope :: Bool -> TargetScope -> [Text]-handleScope isCabal ScopeGlobal = ["all" | isCabal]+handleScope :: Maybe Text -> TargetScope -> [Text]+handleScope fb ScopeGlobal = maybeToList fb handleScope _ (ScopePkgs pkgs) = map (format . pkgName) pkgs  mkStack :: (Applicative m) => Text -> TargetScope -> [Text] -> m (Exec m)-mkStack cmd scope ops = mkExec "stack" ([cmd] <> handleScope False scope <> ops)+mkStack cmd scope ops = mkExec "stack" ([cmd] <> handleScope Nothing scope <> ops) -mkCabal :: (Applicative m) => Text -> TargetScope -> [Text] -> m (Exec m)-mkCabal cmd scope ops = mkExec "cabal" ([cmd] <> handleScope True scope <> ops)+mkCabal :: (Applicative m) => Bool -> Text -> TargetScope -> [Text] -> m (Exec m)+mkCabal install cmd scope ops = mkExec "cabal" ([cmd] <> handleScope (if install then Just "all:exes" else Just "all") scope <> ops) -newtype Env = Env {envName :: Name}+installCabal :: (Applicative m, Format a) => TargetScope -> a -> m (Exec m)+installCabal scope dirPath = mkCabal True "install" scope ["--install-method=copy", "--installdir", format dirPath, "--overwrite-policy=always"] -toAction :: (MonadError Issue m, MonadIO m) => Env -> Builder -> BuilderCommand -> TargetScope -> m (Exec m)+installStack :: (Applicative m, Format a) => TargetScope -> a -> m (Exec m)+installStack scope dirPath = mkStack "install" scope ["--local-bin-path", format dirPath]++toAction :: (MonadError Issue m, MonadIO m) => NixEnv -> Builder -> BuilderCommand -> TargetScope -> m (Exec m) -- Stack toAction _ StackBuilder Build scope = mkStack "build" scope []-toAction _ StackBuilder Install {..} scope = mkStack "install" scope ["--local-bin-path", format dirPath] toAction _ StackBuilder Test scope = mkStack "test" scope [] -- Cabal-toAction _ CabalBuilder {} Install {..} scope = mkCabal "install" scope ["--install-method=copy", "--installdir", format dirPath, "--overwrite-policy=always"]-toAction _ CabalBuilder {} Build scope = mkCabal "build" scope []-toAction _ CabalBuilder {} Test scope = mkCabal "test" scope []+toAction _ CabalBuilder {} Build scope = mkCabal False "build" scope []+toAction _ CabalBuilder {} Test scope = mkCabal False "test" scope [] -- Nix-toAction ctx NixBuilder Build scope = mkExec "nix" $ ["build", "--no-link"] <> nixScope (envName ctx) scope-toAction ctx NixBuilder Test scope = mkExec "nix" $ ["build", "--no-link"] <> nixScope (envName ctx) scope-toAction _ NixBuilder Install {..} scope =-  case scope of-    ScopeGlobal -> pure $ Exec "nix" ["build", ".#", "-o", format (dirPath </> "result-global")] [] (Just $ extractGlobalNixArtifacts dirPath)-    ScopePkgs [pkg] -> pure $ Exec "nix" ["build", ".#" <> format (pkgName pkg), "-o", format (dirPath </> "result")] [] (Just $ extractNixArtifact (pkgName pkg) dirPath)-    ScopePkgs _ -> throwError "Multiple package install is not supported with Nix builder."+toAction ctx NixBuilder Build scope = nixBuild ctx scope+toAction ctx NixBuilder Test scope = nixBuild ctx scope+-- INSTALL+toAction _ CabalBuilder {..} Install {..} scope+  | inNixDevelopment = throwError "Install command with Nix development environment is not supported"+  | otherwise = installCabal scope dirPath+toAction _ StackBuilder Install {..} scope = installStack scope dirPath+toAction _ NixBuilder Install {} _ = throwError "Install command with Nix builder is not supported"+--+toAction _ NixBuilder BuildArtifact {} _ = throwError "Nix Binaries is not supported yet"+toAction _ StackBuilder BuildArtifact {..} scope = installStack scope dirPath+toAction _ CabalBuilder {} BuildArtifact {..} scope = installCabal scope dirPath
src/HWM/Domain/Dispatcher.hs view
@@ -15,9 +15,10 @@ import HWM.Core.Formatting (Color (..), Format (..), andMore, chalk, indentBlockNum, padDots) import HWM.Core.Options (isCI) import HWM.Core.Pkg (Pkg (..))-import HWM.Domain.Build (BuildFlag (..), Builder (..), BuilderCommand (..), TargetScope (..), comandLabel, toExec)+import HWM.Domain.Build (BuildFlag (..), Builder (..), BuilderCommand (..), comandLabel, toExec) import HWM.Domain.ConfigT (ConfigT) import HWM.Domain.Environments (BuildEnvironment (..))+import HWM.Domain.Schema (TargetScope (..)) import HWM.Domain.Workspace (printPkgWSRef) import HWM.Integrations.Toolchain.Cabal (setupCabalMatrixEnvironment) import HWM.Integrations.Toolchain.Stack (setupStackMatrixEnvironment)
src/HWM/Domain/Environments.hs view
@@ -11,8 +11,11 @@  module HWM.Domain.Environments   ( Environments (..),-    EnviromentProfile (..),+    EnvironmentProfile (..),     BuildEnvironment (..),+    StackBuildConfig (..),+    SyncMode (..),+    TargetModes (..),     StackEnvironment (..),     getBuildEnvironments,     getBuildEnvironment,@@ -20,7 +23,7 @@     printEnvironments,     getTestedRange,     removeEnvironmentByName,-    existsEnviroment,+    existsEnvironment,     environmentHash,     NixEnvironment (..),     Feature (..),@@ -44,10 +47,11 @@   ( Check (..),     Name,   )-import HWM.Core.Formatting (Color (..), Format (..), availableOptions, chalk)+import HWM.Core.Formatting (Color (..), Format (..), availableOptions, chalk, formatList) import HWM.Core.Has (Has (..), HasAll, askEnv) import HWM.Core.Pkg (Pkg (..), PkgName) import HWM.Core.Result (Issue)+import HWM.Core.Sync (SyncMode (..)) import HWM.Core.Version (Era (..), Version, selectEra) import HWM.Domain.Bounds (TestedRange (..)) import HWM.Domain.Build (Builder (..))@@ -61,30 +65,27 @@  data Environments = Environments   { envsDefault :: Name,-    envsProfiles :: Map Name EnviromentProfile,+    envsProfiles :: Map Name EnvironmentProfile,     envsBuilder :: Maybe Builder,-    -- generators,-    envsNix :: Maybe Bool,-    envsStack :: Maybe Bool,-    envsHie :: Maybe Bool+    envsTargets :: Maybe TargetsPolicy   }   deriving     ( Generic,       Show     ) -addProfile :: Name -> EnviromentProfile -> Environments -> Environments+addProfile :: Name -> EnvironmentProfile -> Environments -> Environments addProfile name profile envs = envs {envsProfiles = Map.insert name profile (envsProfiles envs)} -mkEnvironment :: Version -> EnviromentProfile+mkEnvironment :: Version -> EnvironmentProfile mkEnvironment ghc =-  EnviromentProfile+  EnvironmentProfile     { profileGhc = ghc,       profileExclude = Nothing,       profileStack = Nothing,       profileNix = Nothing,       profileBuilder = Nothing,-      profileHie = Nothing+      profileTargets = Nothing     }  mkEnvironments :: Version -> Environments@@ -93,10 +94,8 @@    in Environments         { envsDefault = fst defaultEnv,           envsProfiles = Map.fromList [defaultEnv],-          envsStack = Nothing,-          envsNix = Nothing,-          envsBuilder = Nothing,-          envsHie = Nothing+          envsTargets = Nothing,+          envsBuilder = Nothing         }  environmentHash :: Environments -> Signature@@ -130,7 +129,7 @@     traverse_ (checkTarget fileSig) envsProfiles     where       signature = environmentHash Environments {..}-      checkTarget fileSig EnviromentProfile {..}+      checkTarget fileSig EnvironmentProfile {..}         | fileSig == signature = checkExclude         -- checking all hkgRefs is expensive, so we skip it if the signature matches         | otherwise = sequence_ [traverse_ check (maybe [] hkgRefs (extraDeps =<< unfeature =<< profileStack)), checkExclude]@@ -143,11 +142,6 @@ unfeature (Enabled a) = Just a unfeature Disabled = Nothing -isEnabled :: Maybe Bool -> Maybe (Feature a) -> Bool-isEnabled _ (Just (Enabled _)) = True-isEnabled _ (Just Disabled) = False-isEnabled global Nothing = fromMaybe False global- instance FromJSON (Feature StackEnvironment) where   parseJSON (Bool b) = pure $ if b then Enabled (StackEnvironment Nothing Nothing Nothing) else Disabled   parseJSON v = Enabled <$> parseJSON v@@ -169,13 +163,13 @@   parseJSON (Object _) = pure NixEnvironment   parseJSON _ = fail "Invalid Nix environment configuration. Expected an object or a boolean." -data EnviromentProfile = EnviromentProfile+data EnvironmentProfile = EnvironmentProfile   { profileGhc :: Version,     profileExclude :: Maybe [WorkspaceRef],     profileStack :: Maybe (Feature StackEnvironment),     profileNix :: Maybe (Feature NixEnvironment),     profileBuilder :: Maybe Builder,-    profileHie :: Maybe Bool+    profileTargets :: Maybe TargetsPolicy   }   deriving     ( Generic,@@ -187,10 +181,10 @@ profilePrefix :: String profilePrefix = "profile" -instance FromJSON EnviromentProfile where+instance FromJSON EnvironmentProfile where   parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced profilePrefix) -instance ToJSON EnviromentProfile where+instance ToJSON EnvironmentProfile where   toJSON = genericToJSON (aesonYAMLOptionsAdvanced profilePrefix)  data StackEnvironment = StackEnvironment@@ -206,17 +200,57 @@ instance ToJSON StackEnvironment where   toJSON = genericToJSON aesonYAMLOptions +data TargetsPolicy = TargetsPolicy+  { tpCabal :: Maybe SyncMode,+    tpStack :: Maybe SyncMode,+    tpNix :: Maybe SyncMode,+    tpHie :: Maybe SyncMode,+    tpPackages :: Maybe SyncMode+  }+  deriving (Generic, Show, Ord, Eq)++targetsPrefix :: String+targetsPrefix = "tp"++instance FromJSON TargetsPolicy where+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced targetsPrefix)++instance ToJSON TargetsPolicy where+  toJSON = genericToJSON (aesonYAMLOptionsAdvanced targetsPrefix)++data TargetModes = TargetModes+  { targetCabal :: SyncMode,+    targetStack :: SyncMode,+    targetNix :: SyncMode,+    targetHie :: SyncMode,+    targetPackages :: SyncMode+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )++data StackBuildConfig = StackBuildConfig+  { stackResolver :: Name,+    stackExtraDeps :: Maybe Extras,+    stackAllowNewer :: Maybe Bool+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )+ data BuildEnvironment = BuildEnvironment   { buildGHC :: Version,     buildPkgs :: [Pkg],     buildName :: Name,-    buildExtraDeps :: Maybe Extras,-    buildResolver :: Name,-    buildAllowNewer :: Maybe Bool,+    buildStack :: StackBuildConfig,     buildBuilder :: Builder,-    buildNix :: Bool,-    buildStack :: Bool,-    buildHie :: Bool+    buildTargets :: TargetModes   }   deriving     ( Generic,@@ -231,6 +265,59 @@ instance Format BuildEnvironment where   format BuildEnvironment {..} = buildName <> " (" <> format buildGHC <> ")" +instance Format TargetModes where+  format TargetModes {..} =+    let enabled :: [Text]+        enabled =+          ["cabal" | active targetCabal]+            <> ["stack" | active targetStack]+            <> ["nix" | active targetNix]+            <> ["hie" | active targetHie]+     in "targets=" <> if null enabled then "-" else formatList "," enabled+    where+      active mode = mode /= SyncModeIgnore++deriveTargetModes :: Builder -> Bool -> Bool -> TargetModes+deriveTargetModes builder stackEnabled nixEnabled =+  case builder of+    CabalBuilder {inNixDevelopment = False} -> TargetModes {targetCabal = SyncModeSync, targetStack = SyncModeIgnore, targetNix = SyncModeIgnore, targetHie = SyncModeSync, targetPackages = SyncModeSync}+    CabalBuilder {inNixDevelopment = True} ->+      TargetModes+        { targetCabal = SyncModeSync,+          targetStack = SyncModeIgnore,+          targetNix = if nixEnabled then SyncModeSync else SyncModeIgnore,+          targetHie = SyncModeSync,+          targetPackages = SyncModeSync+        }+    StackBuilder ->+      TargetModes+        { targetCabal = SyncModeIgnore,+          targetStack = if stackEnabled then SyncModeSync else SyncModeIgnore,+          targetNix = SyncModeIgnore,+          targetHie = SyncModeSync,+          targetPackages = SyncModeSync+        }+    NixBuilder ->+      TargetModes+        { targetCabal = SyncModeIgnore,+          targetStack = SyncModeIgnore,+          targetNix = if nixEnabled then SyncModeSync else SyncModeIgnore,+          targetHie = SyncModeSync,+          targetPackages = SyncModeSync+        }++applyTargetsPolicy :: Maybe TargetsPolicy -> Maybe TargetsPolicy -> TargetModes -> TargetModes+applyTargetsPolicy globalPolicy profilePolicy defaults =+  defaults+    { targetCabal = pick tpCabal (targetCabal defaults),+      targetStack = pick tpStack (targetStack defaults),+      targetNix = pick tpNix (targetNix defaults),+      targetHie = pick tpHie (targetHie defaults),+      targetPackages = pick tpPackages (targetPackages defaults)+    }+  where+    pick getter fallback = fromMaybe fallback ((getter =<< profilePolicy) <|> (getter =<< globalPolicy))+ getBuildEnvironments ::   ( MonadReader env m,     Has env Environments,@@ -244,18 +331,27 @@   envs <- envsProfiles <$> askEnv   for (Map.toList envs) $ \(name, env) -> do     pkgs <- allPackages+    let builder = fromMaybe (CabalBuilder False) (profileBuilder env <|> envsBuilder globalEnv)+    let stackEnabled = case profileStack env of+          Just Disabled -> False+          _ -> True+    let nixEnabled = case profileNix env of+          Just Disabled -> False+          _ -> True+    let targetModes = applyTargetsPolicy (envsTargets globalEnv) (profileTargets env) (deriveTargetModes builder stackEnabled nixEnabled)     pure       BuildEnvironment         { buildPkgs = excludePkgs env pkgs,           buildName = name,-          buildExtraDeps = extraDeps =<< unfeature =<< profileStack env,-          buildResolver = fromMaybe (eraStackageResolverName $ selectEra (profileGhc env)) (resolver =<< unfeature =<< profileStack env),+          buildStack =+            StackBuildConfig+              { stackExtraDeps = extraDeps =<< unfeature =<< profileStack env,+                stackResolver = fromMaybe (eraStackageResolverName $ selectEra (profileGhc env)) (resolver =<< unfeature =<< profileStack env),+                stackAllowNewer = profileStack env >>= unfeature >>= allowNewer+              },           buildGHC = profileGhc env,-          buildAllowNewer = profileStack env >>= unfeature >>= allowNewer,-          buildBuilder = fromMaybe (CabalBuilder False) (profileBuilder env <|> envsBuilder globalEnv),-          buildStack = isEnabled (envsStack globalEnv) (profileStack env),-          buildNix = isEnabled (envsNix globalEnv) (profileNix env),-          buildHie = fromMaybe True (profileHie env <|> envsHie globalEnv)+          buildBuilder = builder,+          buildTargets = targetModes         }   where     excludePkgs build pkgs =@@ -315,35 +411,47 @@ instance Format HkgRef where   format HkgRef {..} = format pkgName <> "-" <> format pkgVersion -existsEnviroment :: (MonadReader env m, Has env Environments) => Name -> m Bool-existsEnviroment n = do+existsEnvironment :: (MonadReader env m, Has env Environments) => Name -> m Bool+existsEnvironment n = do   envs <- envsProfiles <$> askEnv   pure $ isJust $ Map.lookup n envs -printEnvironments :: (Monad m, MonadUI m, MonadReader env m, Has env Workspace, Has env Environments, MonadIO m, MonadError Issue m, Has env Cache) => Maybe Name -> m ()-printEnvironments name = do-  active <- getBuildEnvironment name+printEnvironments :: (Monad m, MonadUI m, MonadReader env m, Has env Workspace, Has env Environments, MonadIO m, MonadError Issue m, Has env Cache) => m ()+printEnvironments = do+  active <- getBuildEnvironment Nothing   def <- envsDefault <$> askEnv   environments <- getBuildEnvironments   sectionEnvironments (Just $ format def) $ forTable_ environments $ \env ->     ( format env,       pure         $ if env == active-          then chalk Cyan (buildResolver env <> " (active)")-          else chalk Gray (buildResolver env)+          then chalk Cyan (stackResolver (buildStack env) <> " (active)")+          else chalk Gray (stackResolver (buildStack 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)+  legacy <- getSnapshot (minimum $ map (stackResolver . buildStack) 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 {envsProfiles = Map.delete envName (envsProfiles matrix)}+-- | Remove an environment from the matrix by name, with optional default migration.+removeEnvironmentByName :: (MonadError Issue m) => Name -> Maybe Name -> Environments -> m Environments+removeEnvironmentByName envName maybeNewDefault envs@Environments {..}+  | not (Map.member envName envsProfiles) = throwError $ fromString $ "Environment '" <> toString envName <> "' does not exist."+  | Map.size envsProfiles <= 1 = throwError "Cannot remove the last environment. Add another environment first."+  | envName /= envsDefault && isJust maybeNewDefault = throwError "--set-default can only be used when removing the current default environment."+  | otherwise =+      let nextProfiles = Map.delete envName envsProfiles+       in if envName /= envsDefault+            then pure envs {envsProfiles = nextProfiles}+            else case maybeNewDefault of+              Nothing -> throwError "Removing the current default environment requires --set-default <ENV>."+              Just newDefault+                | newDefault == envName -> throwError "--set-default cannot point to the environment being removed."+                | not (Map.member newDefault nextProfiles) -> throwError $ fromString $ "Environment '" <> toString newDefault <> "' does not exist after removal."+                | otherwise -> pure envs {envsProfiles = nextProfiles, envsDefault = newDefault}  selectEnvironments :: (MonadError Issue m, MonadIO m, MonadReader env m, Has env Workspace, Has env Environments, Has env Cache) => [Name] -> m [BuildEnvironment] selectEnvironments ["all"] = getBuildEnvironments
src/HWM/Domain/Release.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-}  module HWM.Domain.Release@@ -11,24 +12,28 @@     ReleaseArtifactConfigs,     getArtifact,     selectedArtifacts,+    resolveArtifactConfig,+    getArtifactEnvironments,+    isArtifactEnabledInEnvironment,   ) where  import Control.Monad.Error.Class (MonadError (..))-import Data.Aeson-  ( FromJSON (..),-    ToJSON (toJSON),-    genericParseJSON,-    genericToJSON,-  )+import Data.Aeson (FromJSON (..), ToJSON (toJSON), genericParseJSON, genericToJSON) import qualified Data.Map as Map+import qualified Data.Text as T+import Data.Traversable (for) import Data.Yaml (Value (..)) import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (..), formatTemplate)+import HWM.Core.Has (Has) import HWM.Core.Parsing (Parse (..))+import HWM.Core.Pkg (Pkg) import HWM.Core.Result (Issue) import HWM.Core.Version (Version)-import HWM.Domain.Workspace (WorkspaceRef)+import HWM.Domain.Environments (BuildEnvironment, Environments, getBuildEnvironment)+import HWM.Domain.Workspace (Workspace, WorkspaceRef, resolveWorkspaces)+import HWM.Runtime.Cache (Cache) import HWM.Runtime.Files (aesonYAMLOptionsAdvanced) import HWM.Runtime.Platform (Platform (..)) import Relude@@ -66,8 +71,47 @@   pure [(target, cfg)] selectedArtifacts Nothing cfgs = pure $ Map.toList cfgs +prefixArtifactConfigRaw :: String+prefixArtifactConfigRaw = "_arc"++instance FromJSON ArtifactConfigRaw where+  parseJSON = genericParseJSON (aesonYAMLOptionsAdvanced prefixArtifactConfigRaw)++data ArtifactConfigRaw = ArtifactConfigRaw+  { _arcSource :: Text,+    _arcEnvironments :: Maybe [Name],+    _arcFormats :: Maybe [ArchiveFormat],+    _arcGhcOptions :: Maybe [Text],+    _arcNameTemplate :: Maybe Text+  }+  deriving+    ( Generic,+      Show,+      Ord,+      Eq+    )++instance FromJSON ArtifactConfig where+  parseJSON (String x) = pure $ defaultArchiveConfig x+  parseJSON v = do+    ArtifactConfigRaw {..} <- parseJSON v+    pure+      $ ArtifactConfig+        { arcSource = _arcSource,+          arcEnvironments = _arcEnvironments,+          arcFormats = fromMaybe (arcFormats $ defaultArchiveConfig _arcSource) _arcFormats,+          arcGhcOptions = fromMaybe (arcGhcOptions $ defaultArchiveConfig _arcSource) _arcGhcOptions,+          arcNameTemplate = fromMaybe (arcNameTemplate $ defaultArchiveConfig _arcSource) _arcNameTemplate+        }++instance ToJSON ArtifactConfig where+  toJSON v+    | isDefaultArchiveConfig v = String (arcSource v)+    | otherwise = genericToJSON (aesonYAMLOptionsAdvanced prefix) v+ data ArtifactConfig = ArtifactConfig   { arcSource :: Text,+    arcEnvironments :: Maybe [Name],     arcFormats :: [ArchiveFormat],     arcGhcOptions :: [Text],     arcNameTemplate :: Text@@ -79,6 +123,27 @@       Eq     ) +getArtifactEnvironments :: (Has env Cache, MonadError Issue m, Has env Environments, Has env Workspace, MonadReader env m, MonadIO m) => Release -> m [(Pkg, [BuildEnvironment])]+getArtifactEnvironments Release {..} = do+  let cfgs = toList (fromMaybe mempty rlsArtifacts)+  for cfgs $ \(ArtifactConfig {..}) -> do+    (_, pkg) <- resolveArtifactConfig ArtifactConfig {..}+    envs <- case arcEnvironments of+      Nothing -> pure []+      Just selected -> traverse (getBuildEnvironment . Just) selected+    pure (pkg, envs)++isArtifactEnabledInEnvironment :: Name -> ArtifactConfig -> Bool+isArtifactEnabledInEnvironment _ ArtifactConfig {arcEnvironments = Nothing} = True+isArtifactEnabledInEnvironment envName ArtifactConfig {arcEnvironments = Just selected} = envName `elem` selected++resolveArtifactConfig :: (MonadError Issue m, Has env Workspace, MonadReader env m, MonadIO m) => ArtifactConfig -> m (Text, Pkg)+resolveArtifactConfig ArtifactConfig {..} = do+  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+  pure (executableName, pkg)+ data ArchiveFormat = Zip | TarGz   deriving (Generic, Show, Ord, Eq) @@ -110,6 +175,7 @@ defaultArchiveConfig src =   ArtifactConfig     { arcSource = src,+      arcEnvironments = Nothing,       arcFormats = [TarGz, Zip],       arcGhcOptions =         [ "-O2", -- High-level optimization@@ -122,12 +188,3 @@  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
+ src/HWM/Domain/Schema.hs view
@@ -0,0 +1,8 @@+module HWM.Domain.Schema (TargetScope (..)) where++import HWM.Core.Pkg (Pkg)++data TargetScope+  = ScopeGlobal -- User typed: hwm build (Build everything)+  | ScopePkgs [Pkg] -- User typed: hwm build -w=libs/... (Build these)+  deriving (Eq, Show)
src/HWM/Integrations/Toolchain/Cabal.hs view
@@ -8,6 +8,7 @@  module HWM.Integrations.Toolchain.Cabal   ( validateHackage,+    validateCabalSourceInclusion,     syncCabalProject,     HasSourceDirs (..),     CabalPackage,@@ -23,10 +24,14 @@ import Control.Monad.Except (MonadError (throwError)) import qualified Data.ByteString as BS import Data.Foldable (Foldable (..))+import qualified Data.List import qualified Data.Map as Map+import qualified Data.Set as Set import qualified Data.Text as T+import Distribution.ModuleName (ModuleName)+import qualified Distribution.ModuleName as ModuleName import Distribution.Package (packageVersion)-import Distribution.PackageDescription (Benchmark (..), Executable (..), GenericPackageDescription (..), PackageDescription (..), PackageIdentifier (..), TestSuite (..), UnqualComponentName, emptyBuildInfo, emptyLibrary, emptyPackageDescription, mkPackageName, packageDescription)+import Distribution.PackageDescription (Benchmark (..), Executable (..), ForeignLib (..), GenericPackageDescription (..), PackageDescription (..), PackageIdentifier (..), TestSuite (..), UnqualComponentName, emptyBuildInfo, emptyLibrary, emptyPackageDescription, mkPackageName, packageDescription) import Distribution.PackageDescription.Check (PackageCheck (..), checkPackage) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Parsec@@ -38,7 +43,7 @@ import Distribution.Simple.SrcDist (sdist) import Distribution.Text (display) import Distribution.Types.BuildInfo (BuildInfo (..))-import Distribution.Types.CondTree (CondTree (..))+import Distribution.Types.CondTree (CondBranch (..), CondTree (..)) import Distribution.Types.Library (Library (..)) import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath) import Distribution.Verbosity (normal)@@ -48,7 +53,8 @@ import HWM.Core.Options (Options (..)) import HWM.Core.Pkg (IsPkg (..), PackageIO, Pkg (..), PkgName) import qualified HWM.Core.Pkg as P-import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (..))+import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (..), Severity (..))+import HWM.Core.Sync (SyncMode (..)) import HWM.Core.Version (Version, toCabalVersion) import HWM.Domain.Build (Builder (CabalBuilder, NixBuilder)) import HWM.Domain.ConfigT (ConfigT)@@ -61,8 +67,8 @@ import qualified Hpack as H import Hpack.Config (ProgramName (..)) import Relude-import System.Directory (createDirectoryIfMissing, doesFileExist, makeAbsolute, removePathForcibly, renameFile, withCurrentDirectory)-import System.FilePath (takeDirectory, (</>))+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute, removePathForcibly, renameFile, withCurrentDirectory)+import System.FilePath (dropExtension, isExtensionOf, makeRelative, normalise, splitDirectories, takeDirectory, (</>))  toStatus :: PackageCheck -> Status toStatus p@@ -92,39 +98,99 @@   for_ ls $ \l -> injectIssue (toIssue pkg l)   pure (maximum (Checked : map toStatus ls)) +validateCabalSourceInclusion :: Pkg -> ConfigT Status+validateCabalSourceInclusion pkg = do+  gpd <- liftIO $ readGenericPackageDescription normal (P.cabalFile pkg)+  issues <- liftIO $ sourceInclusionIssues pkg gpd+  for_ issues injectIssue+  pure $ if null issues then Checked else Warning++sourceInclusionIssues :: Pkg -> GenericPackageDescription -> IO [Issue]+sourceInclusionIssues pkg gpd = do+  expected <- syncGenericPackageDescription (takeDirectory (P.cabalFile pkg)) gpd+  let declared = declaredModules gpd+  let target = declaredModules expected+  pure (mkSourceIssues pkg declared target)++declaredModules :: GenericPackageDescription -> Map Text (Set.Set ModuleName)+declaredModules GenericPackageDescription {..} =+  Map.fromList+    $ maybeToList ((\tree -> ("library", moduleSetLibrary (condTreeData tree))) <$> condLibrary)+    <> map (\(name, tree) -> ("library:" <> format name, moduleSetLibrary (condTreeData tree))) condSubLibraries+    <> map (\(name, tree) -> ("foreign:" <> format name, moduleSetForeign (condTreeData tree))) condForeignLibs+    <> map (\(name, tree) -> ("exe:" <> format name, moduleSetExecutable (condTreeData tree))) condExecutables+    <> map (\(name, tree) -> ("test:" <> format name, moduleSetTest (condTreeData tree))) condTestSuites+    <> map (\(name, tree) -> ("bench:" <> format name, moduleSetBenchmark (condTreeData tree))) condBenchmarks++moduleSetLibrary :: Library -> Set.Set ModuleName+moduleSetLibrary Library {..} = Set.fromList (exposedModules <> otherModules libBuildInfo)++moduleSetForeign :: ForeignLib -> Set.Set ModuleName+moduleSetForeign ForeignLib {..} = Set.fromList (otherModules foreignLibBuildInfo)++moduleSetExecutable :: Executable -> Set.Set ModuleName+moduleSetExecutable Executable {..} = Set.fromList (otherModules buildInfo)++moduleSetTest :: TestSuite -> Set.Set ModuleName+moduleSetTest TestSuite {..} = Set.fromList (otherModules testBuildInfo)++moduleSetBenchmark :: Benchmark -> Set.Set ModuleName+moduleSetBenchmark Benchmark {..} = Set.fromList (otherModules benchmarkBuildInfo)++mkSourceIssues :: Pkg -> Map Text (Set.Set ModuleName) -> Map Text (Set.Set ModuleName) -> [Issue]+mkSourceIssues pkg declared target = concatMap toIssues (Set.toList labels)+  where+    labels = Set.union (Map.keysSet declared) (Map.keysSet target)+    toIssues label =+      let current = Map.findWithDefault Set.empty label declared+          expected = Map.findWithDefault Set.empty label target+          missingInCabal = map moduleToFile (Set.toList (Set.difference expected current))+          missingInCode = map moduleToFile (Set.toList (Set.difference current expected))+       in catMaybes+            [ mkIssue SeverityWarning "Source files exist in codebase but are missing in .cabal" label missingInCabal,+              mkIssue SeverityError "Modules/files declared in .cabal are missing in codebase" label missingInCode+            ]++    mkIssue severity message component targets =+      if null targets+        then Nothing+        else+          Just+            Issue+              { issueTopic = P.pkgMemberId pkg,+                issueSeverity = severity,+                issueMessage = message,+                issueDetails = Just (SourceInclusionIssue component targets)+              }++moduleToFile :: ModuleName -> Text+moduleToFile m = toText (ModuleName.toFilePath m <> ".hs")+ instance PackageIO CabalPackage ConfigT where   rewritePackage = rewriteCabalPackage   readPackage = readCabalPackage -getChanges :: Pkg -> (CabalPackage -> ConfigT (Maybe CabalPackage)) -> ConfigT (Maybe CabalPackage)-getChanges pkg mapCabal = do-  original <- readCabalPackage pkg-  updated <- mapCabal original-  case updated of-    Nothing -> pure Nothing-    Just newpackage ->-      if cbContent newpackage == cbContent original-        then pure Nothing-        else pure (Just newpackage)--forChanges :: (Applicative f) => Maybe t -> (t -> f a) -> f Status-forChanges changes f = do-  case changes of-    Nothing -> pure Checked-    Just newpackage -> f newpackage $> Updated- rewriteCabalPackage :: (CabalPackage -> ConfigT (Maybe CabalPackage)) -> Pkg -> ConfigT Status-rewriteCabalPackage mapCabal pkg@Pkg {hpackFile = Just path} = do-  changes <- getChanges pkg mapCabal-  update <- forChanges changes $ \_ -> hpackForceUpdate pkg path-  validation <- validateHackage pkg-  pure $ max validation update rewriteCabalPackage mapCabal pkg = do-  changes <- getChanges pkg mapCabal-  update <- forChanges changes $ \package -> liftIO $ writeGenericPackageDescription (P.cabalFile pkg) (cbContent package)+  original <- readCabalPackage pkg+  synced <- runCabalSync mapCabal pkg original+  let changed = cbContent synced /= cbContent original+  update <-+    if changed+      then case hpackFile pkg of+        Just path -> hpackForceUpdate pkg path+        Nothing -> liftIO (writeGenericPackageDescription (P.cabalFile pkg) (cbContent synced)) $> Updated+      else pure Checked   validation <- validateHackage pkg   pure $ max validation update +runCabalSync :: (CabalPackage -> ConfigT (Maybe CabalPackage)) -> Pkg -> CabalPackage -> ConfigT CabalPackage+runCabalSync mapCabal pkg original = do+  mapped <- fromMaybe original <$> mapCabal original+  case hpackFile pkg of+    Just _ -> pure mapped+    Nothing -> liftIO (syncDiscoveredModules mapped)+ hpackForceUpdate :: (MonadIO m) => Pkg -> FilePath -> m Status hpackForceUpdate pkg path = do   let programName = ProgramName $ toString $ P.pkgName pkg@@ -151,11 +217,16 @@   _ <- syncFile projectPath (generateCabalProject "../../" env)   pure [("CABAL_PROJECT_FILE", projectPath)] -syncCabalProject :: ConfigT Status-syncCabalProject = do+syncCabalProject :: SyncMode -> ConfigT Status+syncCabalProject SyncModeSync = do   cabalFilePath <- asks (optionsCabal . CT.options)   env <- getBuildEnvironment Nothing   syncFile cabalFilePath (generateCabalProject "" env)+syncCabalProject SyncModeCheck = do+  cabalFilePath <- asks (optionsCabal . CT.options)+  exists <- liftIO $ doesFileExist cabalFilePath+  pure $ if exists then Checked else Warning+syncCabalProject SyncModeIgnore = pure Ignored  data CabalPackage = CabalPackage   { cbDirectory :: FilePath,@@ -180,6 +251,143 @@       { cbDirectory = takeDirectory (P.cabalFile pkg),         cbContent = gpd       }++syncDiscoveredModules :: CabalPackage -> IO CabalPackage+syncDiscoveredModules pkg@CabalPackage {..} = do+  nextContent <- syncGenericPackageDescription cbDirectory cbContent+  pure pkg {cbContent = nextContent}++syncGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO GenericPackageDescription+syncGenericPackageDescription dir gpd@GenericPackageDescription {..} = do+  nextLibrary <- traverse (mapCondTree syncLibraryModules dir) condLibrary+  nextSubLibraries <- traverse (syncNamedCondTree syncLibraryModules dir) condSubLibraries+  nextForeignLibs <- traverse (syncNamedCondTree syncForeignLibraryModules dir) condForeignLibs+  nextExecutables <- traverse (syncNamedCondTree syncExecutableModules dir) condExecutables+  nextTests <- traverse (syncNamedCondTree syncTestModules dir) condTestSuites+  nextBenches <- traverse (syncNamedCondTree syncBenchmarkModules dir) condBenchmarks+  pure+    gpd+      { condLibrary = nextLibrary,+        condSubLibraries = nextSubLibraries,+        condForeignLibs = nextForeignLibs,+        condExecutables = nextExecutables,+        condTestSuites = nextTests,+        condBenchmarks = nextBenches+      }++syncNamedCondTree :: (FilePath -> a -> IO a) -> FilePath -> (k, CondTree v c a) -> IO (k, CondTree v c a)+syncNamedCondTree syncComponent dir (name, tree) = do+  nextTree <- mapCondTree syncComponent dir tree+  pure (name, nextTree)++mapCondTree :: (FilePath -> a -> IO a) -> FilePath -> CondTree v c a -> IO (CondTree v c a)+mapCondTree syncComponent dir tree@CondNode {..} = do+  nextData <- syncComponent dir condTreeData+  nextComponents <-+    forM condTreeComponents $ \CondBranch {..} -> do+      nextIf <- mapCondTree syncComponent dir condBranchIfTrue+      nextElse <- traverse (mapCondTree syncComponent dir) condBranchIfFalse+      pure CondBranch {condBranchCondition = condBranchCondition, condBranchIfTrue = nextIf, condBranchIfFalse = nextElse}+  pure tree {condTreeData = nextData, condTreeComponents = nextComponents}++syncLibraryModules :: FilePath -> Library -> IO Library+syncLibraryModules dir lib@Library {..} = do+  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs libBuildInfo))+  let generated = filter isGeneratedModule (otherModules libBuildInfo)+  let expected = sort (Data.List.nub (generated <> discovered))+  let declared = sort (Data.List.nub (exposedModules <> otherModules libBuildInfo))+  if moduleListsEqual declared expected+    then pure lib+    else+      pure+        lib+          { exposedModules = discovered,+            libBuildInfo = libBuildInfo {otherModules = sort (Data.List.nub generated)}+          }++syncForeignLibraryModules :: FilePath -> ForeignLib -> IO ForeignLib+syncForeignLibraryModules dir foreignLib@ForeignLib {..} = do+  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs foreignLibBuildInfo))+  let generated = filter isGeneratedModule (otherModules foreignLibBuildInfo)+  let expected = sort (Data.List.nub (generated <> discovered))+  let declared = sort (Data.List.nub (otherModules foreignLibBuildInfo))+  if moduleListsEqual declared expected+    then pure foreignLib+    else pure foreignLib {foreignLibBuildInfo = foreignLibBuildInfo {otherModules = expected}}++syncExecutableModules :: FilePath -> Executable -> IO Executable+syncExecutableModules dir exe@Executable {..} = do+  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs buildInfo))+  let mainModule = toModuleName modulePath+  let generated = filter isGeneratedModule (otherModules buildInfo)+  let discoveredWithoutMain = maybe discovered (`Data.List.delete` discovered) mainModule+  let expected = sort (Data.List.nub (generated <> discoveredWithoutMain))+  let declared = sort (Data.List.nub (otherModules buildInfo))+  if moduleListsEqual declared expected+    then pure exe+    else pure exe {buildInfo = buildInfo {otherModules = expected}}++syncTestModules :: FilePath -> TestSuite -> IO TestSuite+syncTestModules dir test@TestSuite {..} = do+  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs testBuildInfo))+  let generated = filter isGeneratedModule (otherModules testBuildInfo)+  let expected = sort (Data.List.nub (generated <> discovered))+  let declared = sort (Data.List.nub (otherModules testBuildInfo))+  if moduleListsEqual declared expected+    then pure test+    else pure test {testBuildInfo = testBuildInfo {otherModules = expected}}++syncBenchmarkModules :: FilePath -> Benchmark -> IO Benchmark+syncBenchmarkModules dir bench@Benchmark {..} = do+  discovered <- discoverModules dir (map getSymbolicPath (hsSourceDirs benchmarkBuildInfo))+  let generated = filter isGeneratedModule (otherModules benchmarkBuildInfo)+  let expected = sort (Data.List.nub (generated <> discovered))+  let declared = sort (Data.List.nub (otherModules benchmarkBuildInfo))+  if moduleListsEqual declared expected+    then pure bench+    else pure bench {benchmarkBuildInfo = benchmarkBuildInfo {otherModules = expected}}++discoverModules :: FilePath -> [FilePath] -> IO [ModuleName]+discoverModules dir sourceDirs = do+  files <- concat <$> traverse (discoverModulesInDir dir) sourceDirs+  pure (sort (Data.List.nub files))++discoverModulesInDir :: FilePath -> FilePath -> IO [ModuleName]+discoverModulesInDir base sourceDir = do+  let root = normalise (base </> sourceDir)+  exists <- doesDirectoryExist root+  if not exists+    then pure []+    else do+      hsFiles <- walkHsFiles root+      pure (mapMaybe (toModuleName . makeRelative root) hsFiles)++walkHsFiles :: FilePath -> IO [FilePath]+walkHsFiles dir = do+  children <- listDirectory dir+  paths <-+    forM children $ \name -> do+      let path = dir </> name+      isDir <- doesDirectoryExist path+      if isDir+        then walkHsFiles path+        else pure [path | ".hs" `isExtensionOf` path]+  pure (concat paths)++toModuleName :: FilePath -> Maybe ModuleName+toModuleName path =+  if ".hs" `isExtensionOf` path+    then+      let parts = splitDirectories (dropExtension path)+          cleaned = filter (not . null) parts+       in if null cleaned then Nothing else Just (ModuleName.fromString (Data.List.intercalate "." cleaned))+    else Nothing++isGeneratedModule :: ModuleName -> Bool+isGeneratedModule moduleName = "Paths_" `isPrefixOf` ModuleName.toFilePath moduleName++moduleListsEqual :: [ModuleName] -> [ModuleName] -> Bool+moduleListsEqual a b = Set.fromList a == Set.fromList b  class HasSourceDirs a where   getSourceDirs :: [Text] -> a -> [(Text, Name)]
src/HWM/Integrations/Toolchain/Hie.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -13,17 +10,30 @@   ) where -import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object)+import Control.Monad.Except (catchError)+import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Text as T import HWM.Core.Common (Name) import HWM.Core.Formatting (Format (format), Status (..)) import HWM.Core.Options (Options (..), askOptions) import HWM.Core.Pkg (Pkg (..), pkgFile)+import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (injectIssue), Severity (..))+import HWM.Core.Sync (SyncMode (..))+import HWM.Domain.Build (Builder (..)) import HWM.Domain.ConfigT (ConfigT)+import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment) import HWM.Domain.Workspace (allPackages) import HWM.Integrations.Toolchain.Cabal (HasSourceDirs (..), readCabalPackage)-import HWM.Runtime.Files (rewrite_)+import HWM.Runtime.Files (readYaml, rewrite_) import Relude+import System.Directory (doesFileExist) +-- -----------------------------------------------------------------------------+-- HIE file model+-- -----------------------------------------------------------------------------+ data Component = Component   { path :: FilePath,     component :: Name@@ -32,7 +42,9 @@     ( ToJSON,       FromJSON,       Generic,-      Show+      Show,+      Eq,+      Ord     )  data Components = Components@@ -46,17 +58,170 @@       Show     ) -packHie :: Components -> Value-packHie value = object [("cradle", object [("stack", toJSON value)])]+data HieCradle = HieCradle+  { stack :: Maybe Components,+    cabal :: Maybe [Component]+  }+  deriving+    ( FromJSON,+      ToJSON,+      Generic,+      Show+    ) +newtype HieConfig = HieConfig+  { cradle :: HieCradle+  }+  deriving+    ( FromJSON,+      ToJSON,+      Generic,+      Show+    )++packHie :: Builder -> Components -> HieConfig+packHie StackBuilder value = HieConfig {cradle = HieCradle {stack = Just value, cabal = Nothing}}+packHie CabalBuilder {} Components {components} = HieConfig {cradle = HieCradle {stack = Nothing, cabal = Just components}}+packHie NixBuilder Components {components} = HieConfig {cradle = HieCradle {stack = Nothing, cabal = Just components}}++-- -----------------------------------------------------------------------------+-- Public API+-- -----------------------------------------------------------------------------++syncHie :: SyncMode -> ConfigT Status+syncHie SyncModeSync = syncHieFile+syncHie SyncModeCheck = checkHieFile+syncHie SyncModeIgnore = pure Ignored++-- -----------------------------------------------------------------------------+-- Sync mode+-- -----------------------------------------------------------------------------++syncHieFile :: ConfigT Status+syncHieFile = do+  Options {..} <- askOptions+  BuildEnvironment {buildBuilder} <- getBuildEnvironment Nothing+  expectedComponents <- collectExpectedComponents+  issues <- validateExistingHie optionsHie buildBuilder optionsStack expectedComponents+  if null issues+    then pure Checked+    else rewrite_ optionsHie (const $ pure $ packHie buildBuilder Components {stackYaml = optionsStack, components = expectedComponents})++collectExpectedComponents :: ConfigT [Component]+collectExpectedComponents = do+  pkgs <- allPackages+  concat <$> traverse genComponents pkgs+ genComponents :: Pkg -> ConfigT [Component] genComponents pkg = map comp . getSourceDirs [format $ pkgName pkg] <$> readCabalPackage pkg   where     comp (tag, sourceDirs) = Component {path = "./" <> pkgFile pkg (toString sourceDirs), component = tag} -syncHie :: ConfigT Status-syncHie = do+-- -----------------------------------------------------------------------------+-- Check mode+-- -----------------------------------------------------------------------------++checkHieFile :: ConfigT Status+checkHieFile = do   Options {..} <- askOptions-  pkgs <- allPackages-  components <- concat <$> traverse genComponents pkgs-  rewrite_ optionsHie (const $ pure $ packHie Components {stackYaml = optionsStack, components})+  BuildEnvironment {buildBuilder} <- getBuildEnvironment Nothing+  expectedComponents <- collectExpectedComponents+  issues <- validateExistingHie optionsHie buildBuilder optionsStack expectedComponents+  if null issues+    then pure Checked+    else do+      traverse_ (reportHieError optionsHie) issues+      pure Invalid++reportHieError :: FilePath -> Text -> ConfigT ()+reportHieError hiePath message =+  injectIssue+    Issue+      { issueTopic = "hie.yaml",+        issueSeverity = SeverityError,+        issueMessage = message,+        issueDetails = Just (GenericIssue hiePath)+      }++validateExistingHie :: FilePath -> Builder -> FilePath -> [Component] -> ConfigT [Text]+validateExistingHie hiePath buildBuilder expectedStackYaml expectedComponents = do+  exists <- liftIO $ doesFileExist hiePath+  if not exists+    then pure ["hie.yaml is missing"]+    else do+      parsed <- (Right <$> (readYaml hiePath :: ConfigT HieConfig)) `catchError` (pure . Left)+      case parsed of+        Left issue -> pure ["Unable to parse hie.yaml: " <> issueMessage issue]+        Right hieConfig -> pure $ validateHieConfig buildBuilder expectedStackYaml expectedComponents hieConfig++validateHieConfig :: Builder -> FilePath -> [Component] -> HieConfig -> [Text]+validateHieConfig StackBuilder expectedStackYaml expectedComponents HieConfig {cradle = HieCradle {stack, cabal = _}} =+  case stack of+    Nothing -> ["hie.yaml cradle is not stack-based for the active stack environment"]+    Just Components {stackYaml, components} ->+      ["hie.yaml stackYaml mismatch: expected '" <> toText expectedStackYaml <> "', got '" <> toText stackYaml <> "'" | stackYaml /= expectedStackYaml]+        <> validateComponentDetails expectedComponents components+validateHieConfig CabalBuilder {inNixDevelopment = False} _ expectedComponents HieConfig {cradle = HieCradle {stack = _, cabal}} =+  case cabal of+    Nothing -> ["hie.yaml cradle is not cabal-based for the active cabal environment"]+    Just components -> validateComponentDetails expectedComponents components+validateHieConfig CabalBuilder {inNixDevelopment = True} _ expectedComponents HieConfig {cradle = HieCradle {stack = _, cabal}} =+  case cabal of+    Nothing -> ["hie.yaml cradle is not cabal-based for the active nix/cabal environment"]+    Just components -> validateComponentDetails expectedComponents components+validateHieConfig NixBuilder _ expectedComponents HieConfig {cradle = HieCradle {stack = _, cabal}} =+  case cabal of+    Nothing -> ["hie.yaml cradle is not cabal-based for the active nix environment"]+    Just components -> validateComponentDetails expectedComponents components++validateComponentDetails :: [Component] -> [Component] -> [Text]+validateComponentDetails expected actual =+  missingComponentErrors+    <> unknownComponentErrors+    <> wrongPathErrors+  where+    expectedByComponent = groupPathsByComponent expected+    actualByComponent = groupPathsByComponent actual++    expectedNames = Map.keysSet expectedByComponent+    actualNames = Map.keysSet actualByComponent++    missingComponentNames = sort $ Set.toList (Set.difference expectedNames actualNames)+    unknownComponentNames = sort $ Set.toList (Set.difference actualNames expectedNames)+    commonComponentNames = sort $ Set.toList (Set.intersection expectedNames actualNames)++    missingComponentErrors =+      [ "hie.yaml is missing components: " <> T.intercalate ", " missingComponentNames+      | not (null missingComponentNames)+      ]++    unknownComponentErrors =+      [ "hie.yaml has unknown components: " <> T.intercalate ", " unknownComponentNames+      | not (null unknownComponentNames)+      ]++    wrongPathErrors = mapMaybe componentPathMismatch commonComponentNames++    componentPathMismatch name = do+      expectedPaths <- Map.lookup name expectedByComponent+      actualPaths <- Map.lookup name actualByComponent+      guard (expectedPaths /= actualPaths)+      pure+        $ "hie.yaml component '"+        <> name+        <> "' has mismatched paths: expected "+        <> renderPathList expectedPaths+        <> ", got "+        <> renderPathList actualPaths++groupPathsByComponent :: [Component] -> Map Name (Set FilePath)+groupPathsByComponent = foldl' insert Map.empty+  where+    insert acc Component {component, path} =+      Map.insertWith Set.union component (Set.singleton path) acc++renderPathList :: Set FilePath -> Text+renderPathList paths =+  case sort (Set.toList paths) of+    [singlePath] -> "'" <> toText singlePath <> "'"+    xs -> "[" <> T.intercalate ", " (map toText xs) <> "]"
src/HWM/Integrations/Toolchain/Nix.hs view
@@ -5,52 +5,67 @@  module HWM.Integrations.Toolchain.Nix (syncNixFile) where +import qualified Data.Set as Set import qualified Data.Text as T import HWM.Core.Common (Name)-import HWM.Core.Formatting (Status, format, toCamelCase)+import HWM.Core.Formatting (Status (..), format, toCamelCase) import HWM.Core.Options (Options (..)) import HWM.Core.Pkg (Pkg (..))+import HWM.Core.Sync (SyncMode (..)) import HWM.Core.Version (Era (eraNixpkgs), formatNixGhc, selectEra)-import HWM.Domain.Config (Config (Config, cfgName))+import HWM.Domain.Config (Config (..)) import HWM.Domain.ConfigT (ConfigT, Env (..))-import HWM.Domain.Environments (BuildEnvironment (..), getBuildEnvironment, getBuildEnvironments)+import HWM.Domain.Environments (BuildEnvironment (..), Environments (envsDefault), TargetModes (..), getBuildEnvironment, getBuildEnvironments)+import HWM.Domain.Release (getArtifactEnvironments) import HWM.Runtime.Files (syncFile) import Relude+import System.Directory (doesFileExist) -syncNixFile :: ConfigT Status-syncNixFile = do+enabled :: SyncMode -> Bool+enabled mode = mode /= SyncModeIgnore++syncNixFile :: SyncMode -> ConfigT Status+syncNixFile SyncModeSync = do   Config {..} <- asks config   ops <- asks options-  benv <- getBuildEnvironment Nothing-  benvs <- filter buildNix <$> getBuildEnvironments-  syncFile (optionsNix ops) (deriveFlakeNix (cfgName, benv) (map (cfgName,) benvs))--renderName :: Context -> Text-renderName (name, BuildEnvironment {..}) = toCamelCase (name <> T.toTitle (format buildName) <> "WorkspacePackages")+  benv <- getBuildEnvironment (Just $ envsDefault cfgEnvironments)+  benvs <- filter (enabled . targetNix . buildTargets) <$> getBuildEnvironments+  releasePkgs <- maybe (pure []) getArtifactEnvironments cfgRelease+  syncFile (optionsNix ops) (deriveFlakeNix (Context releasePkgs cfgName (map (cfgName,) benvs)) (cfgName, benv) (map (cfgName,) benvs))+syncNixFile SyncModeCheck = do+  nixPath <- optionsNix <$> asks options+  exists <- liftIO $ doesFileExist nixPath+  pure $ if exists then Checked else Warning+syncNixFile SyncModeIgnore = pure Ignored -pkgsNixName :: Context -> Text-pkgsNixName ctx = "pkgs." <> renderName ctx+genName :: (Text, Text) -> Text+genName (name, subName) = toCamelCase (name <> T.toTitle subName <> "WorkspacePackages") -type Context = (Name, BuildEnvironment)+genNixName :: BCOntext -> Text+genNixName (name, BuildEnvironment {..}) = genName (name, format buildName) -generateOverlay :: [Context] -> [Text]-generateOverlay benvs =-  ["haskellOverlay = final: prev: {"]-    <> concatMap rendergOverlayItem benvs-    <> ["};"]+type BCOntext = (Name, BuildEnvironment) -rendergOverlayItem :: Context -> [Text]-rendergOverlayItem ctx@(_, BuildEnvironment {..}) =-  [ "  " <> renderName ctx <> " = prev.haskell.packages." <> formatNixGhc buildGHC <> ".extend (hfinal: hprev: {"+systems :: [Text]+systems =+  [ "x86_64-linux",+    "aarch64-linux",+    "x86_64-darwin",+    "aarch64-darwin"   ]-    <> map renderPackage buildPkgs-    <> ["  });"] -renderPackage :: Pkg -> Text-renderPackage pkg = "    " <> format (pkgName pkg) <> " = hfinal.callCabal2nix \"" <> format (pkgName pkg) <> "\" ./" <> format (pkgDirPath pkg) <> " {};"+type ReleasePkg = (Pkg, [BuildEnvironment]) -deriveFlakeNix :: Context -> [Context] -> Text-deriveFlakeNix ctx@(projectName, benv) ctxs =+type Release = [ReleasePkg]++data Context = Context+  { release :: Release,+    projectName :: Text,+    environments :: [BCOntext]+  }++deriveFlakeNix :: Context -> BCOntext -> [BCOntext] -> Text+deriveFlakeNix context ctx@(projectName, benv) ctxs =   T.unlines     $ braces       ( [ "description = \"A Haskell " <> projectName <> " workspace generated by HWM(Haskell Workspace Manager)\";",@@ -60,60 +75,109 @@           "outputs = { self, nixpkgs }:"         ]           <> letBlock-            ( [ "supportedSystems = [ \"x86_64-linux\" \"aarch64-linux\" \"x86_64-darwin\" \"aarch64-darwin\" ];",+            ( [ "supportedSystems = [ " <> T.intercalate " " (map show systems) <> " ];",                 "forAllSystems = nixpkgs.lib.genAttrs supportedSystems;"               ]-                <> generateOverlay ctxs+                -- OVERLAY+                <> genOverlay context             )-            ( forAllSystems "packages" (generatePublicPackages projectName benv (map snd ctxs))-                <> forAllSystems "devShells" (generateDevShell True ctx <> concatMap (generateDevShell False) ctxs)+            -- PACKAGES+            ( forAllSystems "packages" (nixPkgs <> artifactEngine) (genPackages context ctx ctxs)+                -- DEVSHELLS+                <> forAllSystems "devShells" nixPkgs (genDevShell True ctx <> concatMap (genDevShell False) ctxs)+                -- CHECKS                 <> ["checks = forAllSystems (system: self.packages.${system});"]             )             False       ) -braces :: [Text] -> [Text]-braces body =-  ["{"] <> map ("  " <>) body <> ["}"]+-- OVERLAY+genOverlay :: Context -> [Text]+genOverlay ctx@Context {..} =+  scoped+    "haskellOverlay = final: prev:"+    (concatMap rendergOverlayItem environments <> concatMap (rendergOverlayStatic ctx) staticEnvs)+  where+    staticEnvs = Set.toList $ Set.fromList (concatMap snd release) --- Notice the new signature: we pass the default environment, then all environments-generatePublicPackages :: Name -> BuildEnvironment -> [BuildEnvironment] -> [Text]-generatePublicPackages projectName defaultEnv allEnvs =-  defaultPkgAlias <> basePkgs <> matrixPkgs+rendergOverlayItem :: BCOntext -> [Text]+rendergOverlayItem (name, BuildEnvironment {..}) =+  overlayFun+    (genName (name, buildName))+    ["haskell", "packages", formatNixGhc buildGHC]+    (map (renderPackageDef renderPackageBody) buildPkgs)++genStaticEnvName :: Text -> BuildEnvironment -> Text+genStaticEnvName projectName buildEnv = genName (projectName, format (buildName buildEnv) <> "-static")++rendergOverlayStatic :: Context -> BuildEnvironment -> [Text]+rendergOverlayStatic Context {..} env@BuildEnvironment {..} =+  overlayFun+    (genStaticEnvName projectName env)+    ["pkgsStatic", "haskell", "packages", formatNixGhc buildGHC]+    (map (renderPackageDef (stripExecutables . renderPackageBody)) buildPkgs)++overlayFun :: Text -> [Text] -> [Text] -> [Text]+overlayFun name extend = fun name (concatName $ ["prev"] <> extend <> ["extend"]) "hfinal: hprev:"++stripExecutables :: (Semigroup a, IsString a) => a -> a+stripExecutables x = "prev.haskell.lib.justStaticExecutables ( " <> x <> ")"++renderPackageDef :: (Pkg -> Text) -> Pkg -> Text+renderPackageDef body pkg = format (pkgName pkg) <> " = " <> body pkg <> ";"++renderPackageBody :: Pkg -> Text+renderPackageBody pkg = "hfinal.callCabal2nix \"" <> format (pkgName pkg) <> "\" ./" <> format (pkgDirPath pkg) <> " {}"++-- PACKAGES+genPackages :: Context -> BCOntext -> [BCOntext] -> [Text]+genPackages context ctx@(projectName, defaultEnv) allEnvs =+  map (\pkg -> "default = pkgs." <> genNixName ctx <> "." <> format (pkgName pkg) <> ";") defaultPkg+    <> map (\pkg -> format (pkgName pkg) <> " = pkgs." <> genNixName ctx <> "." <> format (pkgName pkg) <> ";") (buildPkgs defaultEnv)+    <> concatMap genEnvPackages allEnvs+    <> concatMap allEnvPackages allEnvs+    <> concatMap (genReleasePkgs context) (release context)   where-    defaultOverlay = renderName (projectName, defaultEnv)-    defaultPkgAlias =-      let defaultPkg = filter ((projectName ==) . format . pkgName) (buildPkgs defaultEnv)-       in map (\pkg -> "default = pkgs." <> defaultOverlay <> "." <> format (pkgName pkg) <> ";") defaultPkg-    basePkgs =-      map (\pkg -> format (pkgName pkg) <> " = pkgs." <> defaultOverlay <> "." <> format (pkgName pkg) <> ";") (buildPkgs defaultEnv)-    matrixPkgs = concatMap (generateMatrixPkgs . (projectName,)) allEnvs+    defaultPkg = filter ((projectName ==) . format . pkgName) (buildPkgs defaultEnv) -individualPkg :: Text -> Text -> Pkg -> Text-individualPkg overlay envName pkg = format (pkgName pkg) <> "-" <> envName <> " = pkgs." <> overlay <> "." <> format (pkgName pkg) <> ";"+genPackage :: Text -> Text -> Pkg -> Text+genPackage overlay envName pkg = format (pkgName pkg) <> "-" <> envName <> " = pkgs." <> overlay <> "." <> format (pkgName pkg) <> ";" -generateMatrixPkgs :: (Name, BuildEnvironment) -> [Text]-generateMatrixPkgs (projectName, env) =-  let overlay = renderName (projectName, env)-      envRaw = format (buildName env)-      envName = toCamelCase envRaw-      pathList = map (\pkg -> "    pkgs." <> overlay <> "." <> format (pkgName pkg)) (buildPkgs env)-   in map (individualPkg overlay envName) (buildPkgs env)-        <> [ "env-" <> envName <> "-all = pkgs.symlinkJoin {",-             "  name = \"" <> envRaw <> "-workspace\";",-             "  paths = [ "-           ]-        <> pathList-        <> [ " ];",-             "};"-           ]+genEnvPackages :: BCOntext -> [Text]+genEnvPackages ctx@(_, env) = map (genPackage (genNixName ctx) (toCamelCase (format (buildName env)))) (buildPkgs env) -generateDevShell :: Bool -> Context -> [Text]-generateDevShell _ (_, BuildEnvironment {buildPkgs = []}) = [] -- Handle empty workspace-generateDevShell isDefault (projectName, benv@BuildEnvironment {..}) =-  [ name <> " = " <> pkgsNixName (projectName, benv) <> ".shellFor {",+allEnvPackages :: BCOntext -> [Text]+allEnvPackages ctx@(_, env) =+  genSymlinkJoin+    ("env-" <> toCamelCase (format (buildName env)) <> "-all")+    (format (buildName env) <> "-workspace")+    (map (\pkg -> "pkgs." <> genNixName ctx <> "." <> format (pkgName pkg)) (buildPkgs env))++genReleasePkgs :: Context -> ReleasePkg -> [Text]+genReleasePkgs ctx (pkg, envs) = map (genReleasePkg ctx pkg) envs++genReleasePkg :: Context -> Pkg -> BuildEnvironment -> Text+genReleasePkg ctx pkg env = name <> "-release = " <> genReleasePkgBody ctx pkg env <> ";"+  where+    name = format (pkgName pkg) <> "-" <> buildName env++genReleasePkgBody :: Context -> Pkg -> BuildEnvironment -> Text+genReleasePkgBody Context {..} pkg env = "mkReleaseArtifact \"" <> format (pkgName pkg) <> "\" pkgs." <> genNixName (projectName, env) <> "." <> format (pkgName pkg) <> " pkgs." <> genStaticEnvName projectName env <> "." <> format (pkgName pkg)++-- genReleaseGroup :: BCOntext -> [Pkg] -> [Text]+-- genReleaseGroup ctx pkgs =+--   genSymlinkJoin+--     "release"+--     "release-artifacts"+--     (map (\pkg -> "(" <> genReleasePkgBody ctx pkg <> ")") pkgs)++-- DEVSHELL+genDevShell :: Bool -> BCOntext -> [Text]+genDevShell _ (_, BuildEnvironment {buildPkgs = []}) = [] -- Handle empty workspace+genDevShell isDefault ctx@(_, BuildEnvironment {buildTargets = TargetModes {..}, ..}) =+  [ name <> " = " <> devShellPackageName ctx <> ".shellFor {",     "  packages = p: [ " <> renderPackageList buildPkgs <> " ];",-    "  buildInputs = with " <> pkgsNixName (projectName, benv) <> "; ["+    "  buildInputs = with " <> devShellPackageName ctx <> "; ["   ]     <> map ("    " <>) libs     <> [ "  ];",@@ -121,23 +185,68 @@        ]   where     name = if isDefault then "default" else toCamelCase (format buildName)-    libs = ["cabal-install", "hlint"] <> ["stack" | buildStack] <> ["haskell-language-server" | buildHie]+    libs = ["cabal-install", "hlint"] <> ["stack" | enabled targetStack] <> ["haskell-language-server" | enabled targetHie]     renderPackageList = T.intercalate " " . map (\pkg -> "p." <> format (pkgName pkg)) +devShellPackageName :: BCOntext -> Text+devShellPackageName ctx = "pkgs." <> genNixName ctx++artifactEngine :: [Text]+artifactEngine =+  [ "mkReleaseArtifact = pkgName: basePkg: staticPkg:",+    "  if pkgs.stdenv.hostPlatform.isLinux then",+    "    # LINUX: Return the fully static (musl), zero-dependency executable",+    "    staticPkg",+    "  else if pkgs.stdenv.hostPlatform.isDarwin then",+    "    # MACOS: We \"Bundle\" the dynamic dependencies since strict static is hard on Mac.",+    "    pkgs.runCommand \"${pkgName}-macos-bundle\" {",+    "      nativeBuildInputs = [ pkgs.macdylibbundler pkgs.darwin.autoSignDarwinBinariesHook ];",+    "    } ''",+    "      mkdir -p $out/bin",+    "",+    "      # 1. Copy the fast, dynamically linked binary (stripping docs/libs first)",+    "      cp ${pkgs.haskell.lib.justStaticExecutables basePkg}/bin/${pkgName} $out/bin/${pkgName}",+    "      chmod 755 $out/bin/${pkgName}",+    "",+    "      # 2. Run dylibbundler to pull all Nix store .dylibs into the local folder",+    "      dylibbundler -b --no-codesign -x $out/bin/${pkgName} -d $out/bin -p '@executable_path'",+    "",+    "      # 3. Re-sign the binary so Apple Silicon (M1/M2/M3) allows it to run natively",+    "      signDarwinBinariesInAllOutputs",+    "    ''",+    "  else",+    "    # Fallback for unexpected systems",+    "    basePkg;"+  ]++-- SYNTAX++concatName :: [Text] -> Text+concatName = T.intercalate "."++nixPkgs :: [Text]+nixPkgs = ["pkgs = import nixpkgs { inherit system; overlays = [ haskellOverlay ]; };"]++forAllSystems :: Text -> [Text] -> [Text] -> [Text]+forAllSystems system h body = [system <> " = forAllSystems (system:"] <> letBlock h body True+ letBlock :: [Text] -> [Text] -> Bool -> [Text]-letBlock h body end =-  ["  let"]-    <> map ("    " <>) h-    <> [ "  in",-         "  {"-       ]-    <> map ("    " <>) body-    <> if end then ["  });"] else ["  };"]+letBlock h body end = ["let"] <> indent h <> ["in", "{"] <> indent body <> if end then ["});"] else ["};"] -forAllSystems :: Text -> [Text] -> [Text]-forAllSystems system body =-  [system <> " = forAllSystems (system:"]-    <> letBlock-      ["pkgs = import nixpkgs { inherit system; overlays = [ haskellOverlay ]; };"]-      body-      True+braces :: [Text] -> [Text]+braces body = ["{"] <> indent body <> ["}"]++scoped :: Text -> [Text] -> [Text]+scoped name body = [name <> " {"] <> indent body <> ["};"]++fun :: Text -> Text -> Text -> [Text] -> [Text]+fun varName name args body = [varName <> " = " <> name <> " (" <> args <> " {"] <> indent body <> ["});"]++genSymlinkJoin :: Text -> Text -> [Text] -> [Text]+genSymlinkJoin varName name pkgs =+  scoped+    (varName <> " = pkgs.symlinkJoin")+    (["name = \"" <> name <> "\";", "paths = ["] <> indent pkgs <> ["];"])++indent :: [Text] -> [Text]+indent = map ("  " <>)
+ src/HWM/Integrations/Toolchain/Nix/Build.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module HWM.Integrations.Toolchain.Nix.Build+  ( genNixBinary,+    nixBuild,+    inNixDevelop,+    NixEnv (..),+  )+where++import Control.Monad.Error.Class (MonadError)+import Control.Monad.Except (throwError)+import HWM.Core.Common (Name)+import HWM.Core.Formatting (Format (..), toCamelCase)+import HWM.Core.Pkg (Pkg (..), PkgName)+import HWM.Core.Result (Issue)+import HWM.Domain.Schema (TargetScope (..))+import HWM.Runtime.Process (Exec (..), mkExec)+import Relude+import System.Directory (copyFile, doesFileExist, doesPathExist, emptyPermissions, removePathForcibly, setOwnerExecutable, setOwnerReadable, setOwnerWritable, setPermissions)+import System.FilePath ((</>))++forNixLink :: (MonadIO m, MonadError Issue m) => FilePath -> (FilePath -> m ()) -> m ()+forNixLink dir f = do+  let linkPath = dir </> "result"+  isLink <- liftIO $ doesPathExist linkPath+  unless isLink+    $ throwError+    $ fromString+      ( "Nix build completed, but did not create an output at: "+          <> linkPath+          <> "\n(This usually means the Nix derivation is empty or build failed silently.)"+      )+  f linkPath+  liftIO $ removePathForcibly linkPath++copyBinary :: (MonadIO m) => FilePath -> FilePath -> m ()+copyBinary fromPath toPath = liftIO $ do+  liftIO $ copyFile fromPath toPath+  let properPerms =+        setOwnerReadable True+          $ setOwnerWritable True+          $ setOwnerExecutable True emptyPermissions+  setPermissions toPath properPerms++extractNixArtifact :: (MonadIO m, MonadError Issue m) => PkgName -> FilePath -> m ()+extractNixArtifact pkgName dir = forNixLink dir $ \link -> do+  let bin = link </> "bin" </> toString pkgName+  exists <- liftIO $ doesFileExist bin+  if exists+    then copyBinary bin (dir </> toString pkgName)+    else throwError $ fromString $ "Nix build succeeded, but binary '" <> bin <> "' not found inside the Nix store path.\n"++toNixEnv :: Text -> Text+toNixEnv name = ".#" <> toCamelCase name++inNixDevelop :: Name -> Bool -> Exec m -> Exec m+inNixDevelop envName True (Exec cmd ops env post) = Exec "nix" (["develop", toNixEnv envName, "--command", cmd] <> ops) env post+inNixDevelop _ False e = e++nixScope :: (Format p) => p -> TargetScope -> [Text]+nixScope envName ScopeGlobal =+  let envSuffix = toCamelCase (format envName)+   in [".#env-" <> envSuffix <> "-all"]+nixScope envName (ScopePkgs pkgs) =+  let envSuffix = toCamelCase (format envName)+   in map (\pkg -> ".#" <> format (pkgName pkg) <> "-" <> envSuffix) pkgs++newtype NixEnv = NixEnv {envName :: Name}++nixBuild :: (Applicative m) => NixEnv -> TargetScope -> m (Exec m)+nixBuild ctx scope = mkExec "nix" $ ["build", "--no-link"] <> nixScope (envName ctx) scope++getNixtScope :: (MonadError Issue m, MonadIO m) => TargetScope -> m PkgName+getNixtScope (ScopePkgs [pkg]) = pure $ pkgName pkg+getNixtScope _ = throwError "BuildArtifact command with Nix builder is only supported for a single package"++buildNixArtifact :: NixEnv -> FilePath -> PkgName -> m () -> Exec m+buildNixArtifact NixEnv {..} dirPath scope m = Exec "nix" ["build", ".#" <> format scope <> "-" <> format envName <> "-release", "-o", format (dirPath </> "result")] [] (Just m)++genNixBinary :: (MonadIO m, MonadError Issue m, MonadError Issue m) => NixEnv -> TargetScope -> FilePath -> m (Exec m)+genNixBinary ctx scope dirPath = do+  pkgName <- getNixtScope scope+  pure $ buildNixArtifact ctx dirPath pkgName (extractNixArtifact pkgName dirPath)
src/HWM/Integrations/Toolchain/Package.hs view
@@ -7,6 +7,7 @@  module HWM.Integrations.Toolchain.Package   ( syncPackages,+    syncPackagesByMode,     validatePackages,     addPkgDependency,     newPackage,@@ -18,6 +19,7 @@ import HWM.Core.Formatting (Status, StatusM, monadStatus) import HWM.Core.Pkg (IsPkg (..), PackageIO (..), Pkg (..), PkgName (PkgName), PkgSource (..), cabalSource, getVersionIssues, hpackSource) import HWM.Core.Result (Issue, MonadIssue (injectIssue))+import HWM.Core.Sync (SyncMode (..)) import HWM.Domain.Bounds (Bounds (Bounds)) import HWM.Domain.Config (getRegistryBounds) import HWM.Domain.ConfigT (ConfigT, askVersion)@@ -37,7 +39,7 @@   ) import qualified HWM.Domain.Dependencies as M import HWM.Domain.Workspace (allPackages, forWorkspace)-import HWM.Integrations.Toolchain.Cabal (CabalPackage, newCabalPackage, readCabalPackage, validateHackage)+import HWM.Integrations.Toolchain.Cabal (CabalPackage, newCabalPackage, readCabalPackage, validateCabalSourceInclusion, validateHackage) import HWM.Integrations.Toolchain.Hpack (HpackPackage, newHpackPackage, readHpackPackage) import Relude @@ -54,6 +56,11 @@ syncPackages :: ConfigT () syncPackages = forWorkspace $ updatePackage syncPackage syncPackage +syncPackagesByMode :: SyncMode -> ConfigT ()+syncPackagesByMode SyncModeSync = syncPackages+syncPackagesByMode SyncModeCheck = validatePackages+syncPackagesByMode SyncModeIgnore = pure ()+ syncPackage :: (MapDeps a, IsPkg a, HasDependencies a) => PkgSource -> a -> ConfigT (Maybe a) syncPackage pkg package = do   noIssues <- hasNoIssues pkg package@@ -103,7 +110,8 @@     cabal _ pkg = do       s1 <- readCabalPackage pkg >>= validatePackage (cabalSource pkg)       s2 <- validateHackage pkg-      pure (s1 <> s2)+      s3 <- validateCabalSourceInclusion pkg+      pure (s1 <> s2 <> s3)  hasNoIssues :: (IsPkg a, HasDependencies a) => PkgSource -> a -> ConfigT Bool hasNoIssues source pkg = do
src/HWM/Integrations/Toolchain/Stack.hs view
@@ -30,10 +30,11 @@ import HWM.Core.Parsing (Parse (..)) import HWM.Core.Pkg (Pkg (..), PkgName) import HWM.Core.Result (Issue (..), fromEither)+import HWM.Core.Sync (SyncMode (..)) import HWM.Core.Version (Version, latestGHCVersion, parseGHCVersion) import HWM.Domain.Build (Builder (StackBuilder)) import HWM.Domain.ConfigT (ConfigT)-import HWM.Domain.Environments (BuildEnvironment (..), EnviromentProfile (..), Environments (..), Feature (..), StackEnvironment (..), getBuildEnvironment, hkgRefs, mkEnvironment, mkEnvironments)+import HWM.Domain.Environments (BuildEnvironment (..), EnvironmentProfile (..), Environments (..), Feature (..), StackBuildConfig (..), StackEnvironment (..), getBuildEnvironment, hkgRefs, mkEnvironment, mkEnvironments) import HWM.Domain.Workspace (toWorkspaceRef) import HWM.Runtime.Cache (getSnapshotGHC) import HWM.Runtime.Files (aesonYAMLOptions, readYaml, rewrite_)@@ -81,21 +82,26 @@   version <- fromEither ("Invalid version: " <> versionPart) (parse versionPart)   pure (pkgName, version) -syncStackYaml :: ConfigT Status-syncStackYaml = do+syncStackYaml :: SyncMode -> ConfigT Status+syncStackYaml SyncModeSync = do   stackYamlPath <- optionsStack <$> askOptions   rewrite_ stackYamlPath $ const $ do     BuildEnvironment {..} <- getBuildEnvironment Nothing     pure       Stack         { saveHackageCreds = Just False,-          extraDeps = map format . sort . hkgRefs <$> buildExtraDeps,+          extraDeps = map format . sort . hkgRefs <$> stackExtraDeps buildStack,           packages = map pkgDirPath buildPkgs,           compiler = Nothing,-          resolver = buildResolver,-          allowNewer = buildAllowNewer,+          resolver = stackResolver buildStack,+          allowNewer = stackAllowNewer buildStack,           ..         }+syncStackYaml SyncModeCheck = do+  stackYamlPath <- optionsStack <$> askOptions+  exists <- liftIO $ doesFileExist stackYamlPath+  pure $ if exists then Checked else Warning+syncStackYaml SyncModeIgnore = pure Ignored  setupStackMatrixEnvironment :: BuildEnvironment -> ConfigT EnvVars setupStackMatrixEnvironment env = do@@ -118,11 +124,11 @@     pure       Stack         { saveHackageCreds = Just False,-          extraDeps = map format . sort . hkgRefs <$> buildExtraDeps,+          extraDeps = map format . sort . hkgRefs <$> stackExtraDeps buildStack,           packages = map (("../../" <>) . pkgDirPath) buildPkgs,           compiler = Nothing,-          resolver = buildResolver,-          allowNewer = buildAllowNewer,+          resolver = stackResolver buildStack,+          allowNewer = stackAllowNewer buildStack,           ..         }   pure ()@@ -136,19 +142,19 @@   where     loadEnv path = do       seConfig <- readYaml path-      let stackName = fromMaybe "default" (deriveEnviromentName path)+      let stackName = fromMaybe "default" (deriveEnvironmentName path)       pure (stackName, seConfig) -deriveEnviromentName :: FilePath -> Maybe Text-deriveEnviromentName path = slugify <$> T.stripPrefix "stack-" (toText (dropExtension (takeFileName path)))+deriveEnvironmentName :: FilePath -> Maybe Text+deriveEnvironmentName path = slugify <$> T.stripPrefix "stack-" (toText (dropExtension (takeFileName path)))  buildMatrix :: (MonadIO m, MonadError Issue m) => [Pkg] -> [(Name, Stack)] -> m Environments buildMatrix pkgs (defaultEnv : envs) = do   environments <- sortOn (profileGhc . snd) <$> traverse (inferBuildEnv pkgs) (defaultEnv : envs)-  pure Environments {envsDefault = fst defaultEnv, envsProfiles = Map.fromList environments, envsStack = Just True, envsNix = Nothing, envsBuilder = Just StackBuilder, envsHie = Nothing}+  pure Environments {envsDefault = fst defaultEnv, envsProfiles = Map.fromList environments, envsTargets = Nothing, envsBuilder = Just StackBuilder} buildMatrix _ [] = pure $ mkEnvironments latestGHCVersion -inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m (Name, EnviromentProfile)+inferBuildEnv :: (MonadIO m, MonadError Issue m) => [Pkg] -> (Name, Stack) -> m (Name, EnvironmentProfile) inferBuildEnv allPkgs (name, Stack {extraDeps = deps, ..}) = do   ghc <- maybe (getSnapshotGHC resolver) (fromEither "GHC Parsing" . parseGHCVersion) compiler   extraDeps <- parseExtraDeps (fromMaybe [] deps)
src/HWM/Runtime/Logging.hs view
@@ -12,6 +12,7 @@ import HWM.Runtime.UI (MonadUI, putLine) import Relude import System.Directory (createDirectoryIfMissing, listDirectory, removeFile)+import qualified System.Environment as Env import System.FilePath ((</>)) import qualified System.IO as TIO import System.Process.Typed (ExitCode (..))@@ -53,8 +54,12 @@ -- 1. Generate the Timestamp once per CLI run genLogId :: (MonadIO m) => Text -> m Text genLogId prefix = liftIO $ do-  timestamp <- formatTime defaultTimeLocale "%Y%m%d-%H%M%S" <$> getCurrentTime-  pure $ slugifyList [format timestamp, prefix]+  fixed <- Env.lookupEnv "HWM_LOG_ID_FIXED"+  case fixed of+    Just seed -> pure $ slugifyList [toText seed, prefix]+    Nothing -> do+      timestamp <- formatTime defaultTimeLocale "%Y%m%d-%H%M%S" <$> getCurrentTime+      pure $ slugifyList [format timestamp, prefix]  -- 2. The Cleanup Function rotateLogs :: (MonadIO m) => m ()
src/HWM/Runtime/Platform.hs view
@@ -62,18 +62,32 @@ detectOS s = case map toLower s of   "darwin" -> MacOS   "macos" -> MacOS+  "mac os" -> MacOS+  "mac os x" -> MacOS+  "osx" -> MacOS   "linux" -> Linux+  "linux-gnu" -> Linux   "windows" -> Windows+  "windows_nt" -> Windows+  "win32" -> Windows   "mingw32" -> Windows -- The crucial fix for GHC on Windows+  "mingw64" -> Windows+  "msys" -> Windows+  "cygwin" -> Windows   _ -> UnknownOS  detectArch :: String -> Arch detectArch s = case map toLower s of   "x86_64" -> X64+  "x86-64" -> X64   "x64" -> X64   "amd64" -> X64+  "x86_64h" -> X64   "arm64" -> Arm64+  "arm64e" -> Arm64   "aarch64" -> Arm64 -- GHC uses aarch64 for Apple Silicon/Linux ARM+  "armv8" -> Arm64+  "armv8l" -> Arm64   _ -> UnknownArch  toNixSystem :: Platform -> Text
src/HWM/Runtime/Process.hs view
@@ -23,9 +23,11 @@ import HWM.Core.Result (Issue (..), IssueDetails (..), Severity (..)) import HWM.Runtime.Files (prepareDir) import HWM.Runtime.Logging (genLogId, logCommandEnd, logCommandStart, logPath, logRoot)+import HWM.Runtime.Platform (OS (..), Platform (..), detectPlatform) import HWM.Runtime.UI import Relude import System.Environment (getEnvironment)+import qualified System.Environment as Env import qualified System.IO as TIO import System.Process (readProcessWithExitCode) import System.Process.Typed@@ -89,7 +91,6 @@   currentEnv <- liftIO getEnvironment   let targetEnv = execEnv <> currentEnv   status <- liftIO $ TIO.withFile processLogPath TIO.WriteMode $ \logHandle -> do-    unless fxEnabled (uiIndicator fx fxEnabled Nothing)     logCommandStart logHandle cmd     let config = setEnv targetEnv $ setStdout (useHandleOpen logHandle) $ setStderr (useHandleOpen logHandle) $ shell (toString cmd)     withProcessWait config $ processHandle (uiIndicator fx fxEnabled Nothing) fxEnabled logHandle@@ -107,10 +108,27 @@             issueDetails = Just CommandIssue {issueCommand = cmd, issueLogFile = processLogPath}           } +data ShellSpec = ShellSpec+  { shellCmd :: FilePath,+    shellPrefixArgs :: [String]+  }++resolveShell :: IO ShellSpec+resolveShell = do+  platform <- detectPlatform+  case os platform of+    Windows -> do+      cmd <- fromMaybe "cmd.exe" <$> Env.lookupEnv "COMSPEC"+      pure ShellSpec {shellCmd = cmd, shellPrefixArgs = ["/d", "/s", "/c"]}+    _ -> do+      sh <- fromMaybe "sh" <$> Env.lookupEnv "SHELL"+      pure ShellSpec {shellCmd = sh, shellPrefixArgs = ["-c"]}+ inheritRun :: (MonadIO m, MonadUI m) => Exec m -> m ()-inheritRun Exec {..} = do+inheritRun Exec {execCmd = cmd, execEnv = env, postCommand = post} = do   currentEnv <- liftIO getEnvironment-  let targetEnv = execEnv <> currentEnv-  let processConfig = setEnv targetEnv $ proc "/bin/sh" (["-c", toString execCmd] <> map toString execArgs)+  let targetEnv = env <> currentEnv+  ShellSpec {..} <- liftIO resolveShell+  let processConfig = setEnv targetEnv $ proc shellCmd (shellPrefixArgs <> [toString cmd])   liftIO (runProcess_ processConfig)-  sequence_ postCommand+  sequence_ post
src/HWM/Runtime/UI.hs view
@@ -200,12 +200,17 @@             step = l1 <> subPathSign <> chalk Dim "• "             l2 = l1 <> "    " <> subPathSign             headerText = l1 <> chalk Dim "• " <> chalk Bold header+            renderMultilineIssue prefix continuation severity message =+              case T.lines message of+                [] -> [prefix]+                (line1 : restLines) ->+                  (prefix <> chalk (levelColor severity) line1)+                    : map (\line -> continuation <> chalk (levelColor severity) line) restLines             renderIssue Issue {issueDetails = Nothing, issueSeverity, issueMessage} =-              [step <> chalk (levelColor issueSeverity) issueMessage]+              renderMultilineIssue step (l1 <> "    ") issueSeverity issueMessage             renderIssue Issue {issueDetails = Just (GenericIssue {issueFile}), issueSeverity, issueMessage} =-              [ step <> chalk (levelColor issueSeverity) issueMessage,-                l2 <> chalk Dim ("file: " <> format issueFile)-              ]+              renderMultilineIssue step (l1 <> "    ") issueSeverity issueMessage+                <> [l2 <> chalk Dim ("file: " <> format issueFile)]             renderIssue Issue {issueDetails = Just (CommandIssue {issueCommand, issueLogFile}), issueSeverity, issueMessage} =               let cmd =                     if T.length issueCommand > 60@@ -224,6 +229,13 @@                in step <> chalk (levelColor issueSeverity) issueMessage                     : l2 <> chalk Dim ("file: " <> format issueFile)                     : depLines+            renderIssue Issue {issueDetails = Just (SourceInclusionIssue {issueComponent, issueTargets}), issueSeverity, issueMessage} =+              let targets = take 8 issueTargets+                  rest = length issueTargets - length targets+               in (step <> chalk (levelColor issueSeverity) issueMessage)+                    : (l2 <> chalk Dim ("component: " <> issueComponent <> " (" <> show (length issueTargets) <> ")"))+                    : map (\file -> l1 <> "        " <> subPathSign <> chalk Dim file) targets+                      <> [l1 <> "        " <> subPathSign <> chalk Dim ("… (+" <> show rest <> " more)") | rest > 0]             detailLines = concatMap renderIssue pkgIssues          in headerText : detailLines    in ["", headerLine, ""] <> concatMap renderGroup grouped <> [""]