default to main package for ghci

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.<system>.<env>.<package>` for each entry in `ghcVersions`.

lib/with-config.nix

@@ -43,6 +43,7 @@ let
     packages = mapAttrs (_: packageConf) config.packages;
 
     env = default: {
+      mainPackage = config.main;
       inherit packages;
       defaultEnv = default.runner;
     };

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)

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,14 +32,16 @@ newtype ChangeDir =
 data EnvConfig =
   EnvConfig {
     packages :: PackagesConfig,
-    defaultEnv :: EnvRunner
+    defaultEnv :: EnvRunner,
+    mainPackage :: Maybe PackageName
   }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (FromJSON)
 
 data GhciConfig =
   GhciConfig {
     packages :: PackagesConfig,
+    mainPackage :: Maybe PackageName,
     setup :: Map RunnerName GhciSetupCode,
     run :: Map RunnerName GhciRunExpr,
     args :: GhciArgs

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)
 

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,19 +22,21 @@ 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
 
 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

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}|]
 

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,

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