From 7241303cfa35774e0f5fc629ec1892a2832391e0 Mon Sep 17 00:00:00 2001 From: Torsten Schmits Date: Tue, 26 Sep 2023 03:50:51 +0200 Subject: [PATCH] default to main package for ghci --- changelog.md | 4 +++ lib/with-config.nix | 1 + packages/hix/lib/Hix/Component.hs | 39 ++++++++++++++------- packages/hix/lib/Hix/Data/GhciConfig.hs | 6 ++-- packages/hix/lib/Hix/Data/GhciTest.hs | 3 +- packages/hix/lib/Hix/Env.hs | 15 ++++++--- packages/hix/lib/Hix/Ghci.hs | 21 ++++++++---- packages/hix/lib/Hix/Preproc.hs | 4 +-- packages/hix/test/Hix/Test/GhciTest.hs | 45 +++++++++++++++++++++++-- 9 files changed, 108 insertions(+), 30 deletions(-) diff --git a/changelog.md b/changelog.md index 21c87bd..f9d8b23 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# Unreleased + +* Default to `main` package when none was specified for `ghci(d)` commands in multi-package projects. + # 0.6.6 * Expose environment packages as `legacyPackages...` for each entry in `ghcVersions`. diff --git a/lib/with-config.nix b/lib/with-config.nix index fb475d9..526c941 100644 --- a/lib/with-config.nix +++ b/lib/with-config.nix @@ -43,6 +43,7 @@ let packages = mapAttrs (_: packageConf) config.packages; env = default: { + mainPackage = config.main; inherit packages; defaultEnv = default.runner; }; diff --git a/packages/hix/lib/Hix/Component.hs b/packages/hix/lib/Hix/Component.hs index bffe503..23f7321 100644 --- a/packages/hix/lib/Hix/Component.hs +++ b/packages/hix/lib/Hix/Component.hs @@ -50,9 +50,19 @@ packageByDir :: packageByDir config dir = noteEnv [exon|No package at this directory: #{pathText dir}|] (tryPackageByDir config dir) -packageDefault :: PackagesConfig -> ResolvedPackage -packageDefault = \case +packageDefault :: Maybe PackageName -> PackagesConfig -> ResolvedPackage +packageDefault mainPkg = \case + [] -> NoPackage "Project has no packages." [(_, pkg)] -> ResolvedPackage False pkg + pkgs | Just name <- mainPkg -> + case Map.lookup name pkgs of + Just pkg -> + ResolvedPackage False pkg + Nothing -> + NoPackage ( + [exon|Project has multiple packages and the main package '##{name}' is not among them. |] <> + "Specify -p or -f to choose one explicitly." + ) _ -> NoPackage "Project has more than one package, specify -p or -f." packageForSpec :: @@ -75,12 +85,13 @@ packageForSpec root config = \case packageForSpecOrDefault :: Path Abs Dir -> + Maybe PackageName -> PackagesConfig -> Maybe PackageSpec -> M ResolvedPackage -packageForSpecOrDefault root config = \case +packageForSpecOrDefault root mainPkg config = \case Just pkg -> ResolvedPackage True <$> packageForSpec root config pkg - Nothing -> pure (packageDefault config) + Nothing -> pure (packageDefault mainPkg config) matchComponent :: ComponentConfig -> ComponentSpec -> Bool matchComponent candidate (ComponentSpec name dir) = @@ -126,11 +137,12 @@ targetInPackage (NoPackage err) _ = pure (NoDefaultTarget err) targetForComponent :: Path Abs Dir -> + Maybe PackageName -> PackagesConfig -> ComponentCoords -> M TargetOrDefault -targetForComponent root config spec = do - package <- packageForSpecOrDefault root config spec.package +targetForComponent root mainPkg config spec = do + package <- packageForSpecOrDefault root mainPkg config spec.package targetInPackage package spec.component targetForFile :: @@ -156,31 +168,34 @@ targetForFile root config file = do targetComponentIn :: Path Abs Dir -> + Maybe PackageName -> PackagesConfig -> TargetSpec -> M TargetOrDefault -targetComponentIn root config = \case +targetComponentIn root mainPkg config = \case TargetForComponent spec -> - targetForComponent root config spec + targetForComponent root mainPkg config spec TargetForFile spec -> ExplicitTarget <$> targetForFile root config spec targetComponent :: Maybe (Path Abs Dir) -> + Maybe PackageName -> PackagesConfig -> TargetSpec -> M TargetOrDefault -targetComponent cliRoot config spec = do +targetComponent cliRoot mainPkg config spec = do root <- rootDir cliRoot - targetComponentIn root config spec + targetComponentIn root mainPkg config spec targetComponentOrError :: Maybe (Path Abs Dir) -> + Maybe PackageName -> PackagesConfig -> TargetSpec -> M Target -targetComponentOrError cliRoot config spec = - targetComponent cliRoot config spec >>= \case +targetComponentOrError cliRoot mainPkg config spec = + targetComponent cliRoot mainPkg config spec >>= \case ExplicitTarget t -> pure t DefaultTarget t -> pure t NoDefaultTarget err -> throwM (EnvError err) diff --git a/packages/hix/lib/Hix/Data/GhciConfig.hs b/packages/hix/lib/Hix/Data/GhciConfig.hs index 999ca23..e68d097 100644 --- a/packages/hix/lib/Hix/Data/GhciConfig.hs +++ b/packages/hix/lib/Hix/Data/GhciConfig.hs @@ -3,7 +3,7 @@ module Hix.Data.GhciConfig where import Data.Aeson (FromJSON, FromJSONKey) import GHC.Exts (IsList) -import Hix.Data.ComponentConfig (EnvRunner, PackagesConfig) +import Hix.Data.ComponentConfig (EnvRunner, PackageName, PackagesConfig) newtype RunnerName = RunnerName { unRunnerName :: Text } @@ -32,7 +32,8 @@ newtype ChangeDir = data EnvConfig = EnvConfig { packages :: PackagesConfig, - defaultEnv :: EnvRunner + defaultEnv :: EnvRunner, + mainPackage :: Maybe PackageName } deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON) @@ -40,6 +41,7 @@ data EnvConfig = data GhciConfig = GhciConfig { packages :: PackagesConfig, + mainPackage :: Maybe PackageName, setup :: Map RunnerName GhciSetupCode, run :: Map RunnerName GhciRunExpr, args :: GhciArgs diff --git a/packages/hix/lib/Hix/Data/GhciTest.hs b/packages/hix/lib/Hix/Data/GhciTest.hs index 9163be3..214ea46 100644 --- a/packages/hix/lib/Hix/Data/GhciTest.hs +++ b/packages/hix/lib/Hix/Data/GhciTest.hs @@ -18,7 +18,8 @@ data GhciRun = test :: GhciTest, shell :: Text, run :: Maybe Text, - scriptFile :: Path Abs File + scriptFile :: Path Abs File, + cmdline :: Text } deriving stock (Eq, Show, Generic) diff --git a/packages/hix/lib/Hix/Env.hs b/packages/hix/lib/Hix/Env.hs index 19733ed..21c2b21 100644 --- a/packages/hix/lib/Hix/Env.hs +++ b/packages/hix/lib/Hix/Env.hs @@ -5,7 +5,12 @@ import Path (Abs, Dir, Path) import Hix.Component (targetComponent) import qualified Hix.Data.ComponentConfig -import Hix.Data.ComponentConfig (EnvRunner (EnvRunner), PackagesConfig, TargetOrDefault (DefaultTarget, ExplicitTarget)) +import Hix.Data.ComponentConfig ( + EnvRunner (EnvRunner), + PackageName, + PackagesConfig, + TargetOrDefault (DefaultTarget, ExplicitTarget), + ) import Hix.Data.Error (pathText) import qualified Hix.Data.GhciConfig import Hix.Json (jsonConfig) @@ -17,11 +22,12 @@ import Hix.Options (EnvRunnerOptions, TargetSpec) -- Nothing when the config requests it componentRunner :: Maybe (Path Abs Dir) -> + Maybe PackageName -> PackagesConfig -> TargetSpec -> M (Maybe EnvRunner) -componentRunner cliRoot config spec = - targetComponent cliRoot config spec <&> \case +componentRunner cliRoot defaultPkg config spec = + targetComponent cliRoot defaultPkg config spec <&> \case ExplicitTarget t -> t.component.runner DefaultTarget t -> t.component.runner _ -> Nothing @@ -29,7 +35,8 @@ componentRunner cliRoot config spec = envRunner :: EnvRunnerOptions -> M EnvRunner envRunner opts = do config <- either pure jsonConfig opts.config - fromMaybe config.defaultEnv . join <$> traverse (componentRunner opts.root config.packages) opts.component + let runner = componentRunner opts.root config.mainPackage config.packages + fromMaybe config.defaultEnv . join <$> traverse runner opts.component printEnvRunner :: EnvRunnerOptions -> M () printEnvRunner opts = do diff --git a/packages/hix/lib/Hix/Ghci.hs b/packages/hix/lib/Hix/Ghci.hs index 5d5805c..0cf5fc0 100644 --- a/packages/hix/lib/Hix/Ghci.hs +++ b/packages/hix/lib/Hix/Ghci.hs @@ -32,7 +32,7 @@ import Hix.Json (jsonConfig) import Hix.Monad (M, noteGhci) import qualified Hix.Options as Options import Hix.Options ( - ExtraGhciOptions, + ExtraGhciOptions (ExtraGhciOptions), ExtraGhcidOptions (ExtraGhcidOptions), GhciOptions (GhciOptions), GhcidOptions, @@ -110,7 +110,7 @@ assemble :: GhciOptions -> M GhciTest assemble opt = do config <- either pure jsonConfig opt.config root <- rootDir opt.root - Target {..} <- targetComponentOrError opt.root config.packages opt.component + Target {..} <- targetComponentOrError opt.root config.mainPackage config.packages opt.component script <- ghciScript config package sourceDir opt pure GhciTest { script, @@ -139,9 +139,16 @@ ghciScriptFile tmp text = hClose handle pure path +argFrag :: Text -> Text +argFrag "" = "" +argFrag s = [exon| #{s}|] + +optArg :: Maybe Text -> Text +optArg = foldMap argFrag + searchPathArg :: NonEmpty (Path Abs Dir) -> Text searchPathArg paths = - [exon| -i#{colonSeparated}|] + [exon|-i#{colonSeparated}|] where colonSeparated = Text.intercalate ":" (pathText <$> toList paths) @@ -154,10 +161,12 @@ ghciCmdline :: ghciCmdline test extra scriptFile runScriptFile = GhciRun {..} where - shell = [exon|##{Text.unwords (coerce test.args)}#{sp} -ghci-script=##{toFilePath scriptFile}#{extraOpts}|] + cmdline = [exon|ghci#{shell}#{optArg run}|] + shell = [exon|#{argFrag args}#{argFrag sp} -ghci-script=##{toFilePath scriptFile}#{argFrag extraOpts}|] + args = Text.unwords (coerce test.args) run = runScriptFile <&> \ f -> [exon|-ghci-script=##{toFilePath f}|] sp = foldMap searchPathArg (nonEmpty test.searchPath) - extraOpts | Just o <- extra = [exon| ##{o}|] + extraOpts | Just (ExtraGhciOptions o) <- extra = o | otherwise = "" ghciCmdlineFromOptions :: @@ -178,7 +187,7 @@ ghcidCmdlineFromOptions tmp opt = do ghci <- ghciCmdlineFromOptions tmp opt.ghci let test = fromMaybe "main" ghci.test.test - pure (GhcidRun [exon|ghcid --command="ghci #{ghci.shell}" --test='##{test}'#{foldMap extra opt.extra}|] ghci) + pure (GhcidRun [exon|ghcid --command="ghci#{ghci.shell}" --test='##{test}'#{foldMap extra opt.extra}|] ghci) where extra (ExtraGhcidOptions o) = [exon| ##{o}|] diff --git a/packages/hix/lib/Hix/Preproc.hs b/packages/hix/lib/Hix/Preproc.hs index e825cb6..a0a24d7 100644 --- a/packages/hix/lib/Hix/Preproc.hs +++ b/packages/hix/lib/Hix/Preproc.hs @@ -9,6 +9,7 @@ import Data.ByteString (elemIndex) import qualified Data.ByteString.Builder as ByteStringBuilder import Data.ByteString.Builder (Builder, byteString, charUtf8, stringUtf8) import Data.Generics.Labels () +import qualified Data.Map.Strict as Map import Distribution.PackageDescription (BuildInfo (..)) import Distribution.Simple (PerCompilerFlavor (PerCompilerFlavor)) import qualified Exon @@ -34,7 +35,6 @@ import Hix.Options (PreprocOptions (..), TargetSpec (TargetForFile)) import Hix.Optparse (JsonConfig) import qualified Hix.Prelude as Prelude import Hix.Prelude (Prelude (Prelude), findPrelude) -import qualified Data.Map.Strict as Map type Regex = IndexedTraversal' Int ByteString Match @@ -461,7 +461,7 @@ fromConfig :: M CabalConfig fromConfig cliRoot source pconf = do conf <- either pure jsonConfig pconf - target <- targetComponentOrError cliRoot conf.packages (TargetForFile source) + target <- targetComponentOrError cliRoot Nothing conf.packages (TargetForFile source) pure CabalConfig { extensions = stringUtf8 <$> target.component.language : target.component.extensions, ghcOptions = stringUtf8 <$> target.component.ghcOptions, diff --git a/packages/hix/test/Hix/Test/GhciTest.hs b/packages/hix/test/Hix/Test/GhciTest.hs index b6c321d..207225f 100644 --- a/packages/hix/test/Hix/Test/GhciTest.hs +++ b/packages/hix/test/Hix/Test/GhciTest.hs @@ -19,7 +19,7 @@ import Hix.Data.Error (pathText) import Hix.Data.GhciConfig (ChangeDir (ChangeDir), EnvConfig (EnvConfig), GhciConfig (..)) import qualified Hix.Data.GhciTest as GhciTest import Hix.Env (envRunner) -import Hix.Ghci (assemble, ghcidCmdlineFromOptions) +import Hix.Ghci (assemble, ghciCmdlineFromOptions, ghcidCmdlineFromOptions) import Hix.Monad (runM) import qualified Hix.Options as Options import Hix.Options ( @@ -95,8 +95,9 @@ ghciOptions = GhciOptions { config = Left GhciConfig { packages, + mainPackage = Nothing, setup = [("generic", "import Test.Tasty")], - run = [("generic", ("check . property . test"))], + run = [("generic", "check . property . test")], args = ["-Werror"] }, root = Nothing, @@ -132,6 +133,44 @@ test_ghcid = do cmdline <- evalEither res ghcidTarget root cmdline.ghci.scriptFile === cmdline.cmdline +mainOptions :: GhciOptions +mainOptions = + GhciOptions { + config = Left GhciConfig { + packages, + mainPackage = Just "core", + setup = [("generic", "import Test.Tasty")], + run = [("generic", "")], + args = [] + }, + root = Nothing, + component = TargetForComponent (ComponentCoords Nothing Nothing), + test = TestOptions { + mod = "Main", + test = Nothing, + runner = Nothing, + cd = ChangeDir True + }, + extra = Nothing + } + +mainPackageTarget :: + Path Abs Dir -> + Path Abs File -> + Text +mainPackageTarget cwd scriptFile = + [exon|ghci -i#{path} -ghci-script=#{pathText scriptFile}|] + where + path = [exon|#{dir}packages/core/test/:#{dir}packages/api/lib/:#{dir}packages/core/lib/|] + dir = pathText cwd + +test_mainPackage :: TestT IO () +test_mainPackage = do + res <- lift $ withSystemTempDir "hix-test" \ tmp -> + runM root (ghciCmdlineFromOptions tmp mainOptions) + cmdline <- evalEither res + mainPackageTarget root cmdline.scriptFile === cmdline.cmdline + spec2 :: TargetSpec spec2 = TargetForFile (root [relfile|packages/core/test/Main.hs|]) @@ -148,7 +187,7 @@ runnerFor target spec = do res <- evalEither =<< liftIO (runM root (envRunner conf)) target === res where - conf = EnvRunnerOptions (Left (EnvConfig packages defaultRunner)) Nothing (Just spec) + conf = EnvRunnerOptions (Left (EnvConfig packages defaultRunner Nothing)) Nothing (Just spec) test_componentEnv :: TestT IO () test_componentEnv = do