packages feed

cabal-buck2 0.1.0.0 → 0.2.0.0

raw patch · 55 files changed

+1845/−302 lines, 55 filesdep +cabal-install-solverdep ~processPVP ok

version bump matches the API change (PVP)

Dependencies added: cabal-install-solver

Dependency ranges changed: process

API changes (from Hackage documentation)

- Distribution.Client.Buck2.Spec: specSchemaVersion :: Int
+ Distribution.Client.Buck2.Cache: CacheOff :: CacheSetting
+ Distribution.Client.Buck2.Cache: CacheOn :: String -> CacheSetting
+ Distribution.Client.Buck2.Cache: CacheUnchanged :: CacheSetting
+ Distribution.Client.Buck2.Cache: cacheBlock :: String -> [String]
+ Distribution.Client.Buck2.Cache: cacheSetting :: Buck2Flags -> Either String CacheSetting
+ Distribution.Client.Buck2.Cache: configureCache :: Verbosity -> FilePath -> CacheSetting -> IO ()
+ Distribution.Client.Buck2.Cache: data CacheSetting
+ Distribution.Client.Buck2.Cache: instance GHC.Classes.Eq Distribution.Client.Buck2.Cache.CacheSetting
+ Distribution.Client.Buck2.Cache: instance GHC.Show.Show Distribution.Client.Buck2.Cache.CacheSetting
+ Distribution.Client.Buck2.Cache: spliceBlock :: Maybe [String] -> String -> String
+ Distribution.Client.Buck2.Fingerprint: ccFingerprint :: Compiler -> IO String
+ Distribution.Client.Buck2.Fingerprint: ccFingerprintOf :: [(String, String)] -> String
+ Distribution.Client.Buck2.Fingerprint: fingerprintOf :: Map String String -> [(FilePath, ByteString)] -> String
+ Distribution.Client.Buck2.Fingerprint: ghcFingerprint :: Compiler -> FilePath -> IO String
+ Distribution.Client.Buck2.Flags: Buck2Flags :: Flag String -> Flag Bool -> Flag Bool -> Buck2Flags
+ Distribution.Client.Buck2.Flags: [buck2CacheAddress] :: Buck2Flags -> Flag String
+ Distribution.Client.Buck2.Flags: [buck2NoCache] :: Buck2Flags -> Flag Bool
+ Distribution.Client.Buck2.Flags: [buck2SourceDeps] :: Buck2Flags -> Flag Bool
+ Distribution.Client.Buck2.Flags: buck2FlagOptions :: ShowOrParseArgs -> [OptionField Buck2Flags]
+ Distribution.Client.Buck2.Flags: data Buck2Flags
+ Distribution.Client.Buck2.Flags: defaultBuck2Flags :: Buck2Flags
+ Distribution.Client.Buck2.Flags: dependencyMode :: Buck2Flags -> DependencyMode
+ Distribution.Client.Buck2.Generate: LocalPackage :: FilePath -> PackageDescription -> LocalPackage
+ Distribution.Client.Buck2.Generate: [lpDescription] :: LocalPackage -> PackageDescription
+ Distribution.Client.Buck2.Generate: [lpDir] :: LocalPackage -> FilePath
+ Distribution.Client.Buck2.Generate: [ptNotes] :: PackageTargets -> [String]
+ Distribution.Client.Buck2.Generate: data LocalPackage
+ Distribution.Client.Buck2.LocalPackages: BuiltPackage :: FilePath -> PackageDescription -> Bool -> BuiltPackage
+ Distribution.Client.Buck2.LocalPackages: DependenciesFromSource :: DependencyMode
+ Distribution.Client.Buck2.LocalPackages: DependenciesFromStore :: DependencyMode
+ Distribution.Client.Buck2.LocalPackages: ToolTarget :: String -> Maybe (String, String) -> ToolTarget
+ Distribution.Client.Buck2.LocalPackages: [bpDescription] :: BuiltPackage -> PackageDescription
+ Distribution.Client.Buck2.LocalPackages: [bpDir] :: BuiltPackage -> FilePath
+ Distribution.Client.Buck2.LocalPackages: [bpInProject] :: BuiltPackage -> Bool
+ Distribution.Client.Buck2.LocalPackages: [toolData] :: ToolTarget -> Maybe (String, String)
+ Distribution.Client.Buck2.LocalPackages: [toolLabel] :: ToolTarget -> String
+ Distribution.Client.Buck2.LocalPackages: builtLocalElabs :: DependencyMode -> ElaboratedInstallPlan -> [ElaboratedConfiguredPackage]
+ Distribution.Client.Buck2.LocalPackages: data BuiltPackage
+ Distribution.Client.Buck2.LocalPackages: data DependencyMode
+ Distribution.Client.Buck2.LocalPackages: data ToolTarget
+ Distribution.Client.Buck2.LocalPackages: instance GHC.Classes.Eq Distribution.Client.Buck2.LocalPackages.DependencyMode
+ Distribution.Client.Buck2.LocalPackages: localBuildTools :: FilePath -> [BuiltPackage] -> Map String String
+ Distribution.Client.Buck2.LocalPackages: localToolTargets :: FilePath -> [BuiltPackage] -> Map String ToolTarget
+ Distribution.Client.Buck2.LocalPackages: nonLibraryTargetName :: String -> PackageDescription -> UnqualComponentName -> String
+ Distribution.Client.Buck2.LocalPackages: planElab :: GenericPlanPackage ipkg srcpkg -> Maybe srcpkg
+ Distribution.Client.Buck2.LocalPackages: prebuiltUnits :: DependencyMode -> ElaboratedInstallPlan -> Set UnitId
+ Distribution.Client.Buck2.LocalPackages: rootRelativeDir :: FilePath -> FilePath -> FilePath
+ Distribution.Client.Buck2.LocalPackages: setupDependencyUnits :: DependencyMode -> ElaboratedInstallPlan -> Set UnitId
+ Distribution.Client.Buck2.Spec: SpecReexport :: String -> String -> Maybe SpecDep -> SpecReexport
+ Distribution.Client.Buck2.Spec: [reFrom] :: SpecReexport -> Maybe SpecDep
+ Distribution.Client.Buck2.Spec: [reModule] :: SpecReexport -> String
+ Distribution.Client.Buck2.Spec: [reOriginal] :: SpecReexport -> String
+ Distribution.Client.Buck2.Spec: [scAsmOptions] :: SpecComponent -> [String]
+ Distribution.Client.Buck2.Spec: [scAsmSources] :: SpecComponent -> [FilePath]
+ Distribution.Client.Buck2.Spec: [scCcOptions] :: SpecComponent -> [String]
+ Distribution.Client.Buck2.Spec: [scCmmSources] :: SpecComponent -> [FilePath]
+ Distribution.Client.Buck2.Spec: [scExeName] :: SpecComponent -> Maybe String
+ Distribution.Client.Buck2.Spec: [scGeneratedIncludeDirs] :: SpecComponent -> [FilePath]
+ Distribution.Client.Buck2.Spec: [scHscOptions] :: SpecComponent -> [String]
+ Distribution.Client.Buck2.Spec: [scReexports] :: SpecComponent -> [SpecReexport]
+ Distribution.Client.Buck2.Spec: [specDataDir] :: BuildSpec -> FilePath
+ Distribution.Client.Buck2.Spec: [specDataFiles] :: BuildSpec -> [FilePath]
+ Distribution.Client.Buck2.Spec: [specPackageVersion] :: BuildSpec -> String
+ Distribution.Client.Buck2.Spec: data SpecReexport
+ Distribution.Client.Buck2.Version: cabalBuck2Version :: String
- Distribution.Client.Buck2.BuildDependencies: buildDependencies :: Verbosity -> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext
+ Distribution.Client.Buck2.BuildDependencies: buildDependencies :: Verbosity -> DependencyMode -> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext
- Distribution.Client.Buck2.Configure: configureComponents :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> InstalledPackageIndex -> IO (Map (PackageName, ComponentName) LocalBuildInfo)
+ Distribution.Client.Buck2.Configure: configureComponents :: Verbosity -> DependencyMode -> ProjectBaseContext -> ProjectBuildContext -> InstalledPackageIndex -> IO (Map (PackageName, ComponentName) LocalBuildInfo)
- Distribution.Client.Buck2.Generate: PackageTargets :: BuildSpec -> Int -> [AutogenFile] -> PackageTargets
+ Distribution.Client.Buck2.Generate: PackageTargets :: BuildSpec -> Int -> [AutogenFile] -> [String] -> PackageTargets
- Distribution.Client.Buck2.Generate: generatePackageTargets :: LocalPackageIndex -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> Set FilePath -> PackageDescription -> (Maybe PackageTargets, [String])
+ Distribution.Client.Buck2.Generate: generatePackageTargets :: LocalPackageIndex -> FilePath -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> Set FilePath -> Set (PackageName, LibraryName) -> Bool -> PackageDescription -> (PackageTargets, [String])
- Distribution.Client.Buck2.Generate: type LocalPackageIndex = Map PackageName (FilePath, [PackageName])
+ Distribution.Client.Buck2.Generate: type LocalPackageIndex = Map PackageName LocalPackage
- Distribution.Client.Buck2.LocalPackages: builtLocalPackages :: Verbosity -> DistDirLayout -> ElaboratedInstallPlan -> IO [(FilePath, PackageDescription)]
+ Distribution.Client.Buck2.LocalPackages: builtLocalPackages :: Verbosity -> DependencyMode -> DistDirLayout -> ElaboratedInstallPlan -> IO [BuiltPackage]
- Distribution.Client.Buck2.LocalPackages: isBuiltLocally :: ElaboratedConfiguredPackage -> Bool
+ Distribution.Client.Buck2.LocalPackages: isBuiltLocally :: DependencyMode -> ElaboratedConfiguredPackage -> Bool
- Distribution.Client.Buck2.LocalPackages: projectTestOptions :: ElaboratedInstallPlan -> Map (PackageName, ComponentName) [PathTemplate]
+ Distribution.Client.Buck2.LocalPackages: projectTestOptions :: DependencyMode -> ElaboratedInstallPlan -> Map (PackageName, ComponentName) [PathTemplate]
- Distribution.Client.Buck2.LocalPackages: wantedBuildTools :: [(FilePath, PackageDescription)] -> [(PackageName, UnqualComponentName)]
+ Distribution.Client.Buck2.LocalPackages: wantedBuildTools :: [BuiltPackage] -> [(PackageName, UnqualComponentName)]
- Distribution.Client.Buck2.Prebuilt: generatePrebuilt :: Verbosity -> FilePath -> CabalDirLayout -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> [(PackageName, UnqualComponentName)] -> IO (Set String, [InstalledPackageInfo])
+ Distribution.Client.Buck2.Prebuilt: generatePrebuilt :: Verbosity -> FilePath -> CabalDirLayout -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> Set UnitId -> Map String ToolTarget -> Map String String -> [(PackageName, UnqualComponentName)] -> IO (Set String, [InstalledPackageInfo])
- Distribution.Client.Buck2.Spec: BuildSpec :: String -> FilePath -> [String] -> [SpecComponent] -> BuildSpec
+ Distribution.Client.Buck2.Spec: BuildSpec :: String -> String -> FilePath -> [String] -> FilePath -> [FilePath] -> [SpecComponent] -> BuildSpec
- Distribution.Client.Buck2.Spec: SpecComponent :: ComponentKind -> String -> Maybe Src -> [(String, Src)] -> [String] -> [String] -> [String] -> Maybe String -> [String] -> [String] -> [SpecDep] -> [SpecBuildTool] -> [FilePath] -> [FilePath] -> [String] -> [FilePath] -> [String] -> SpecComponent
+ Distribution.Client.Buck2.Spec: SpecComponent :: ComponentKind -> String -> Maybe String -> Maybe Src -> [(String, Src)] -> [String] -> [String] -> [String] -> Maybe String -> [String] -> [String] -> [SpecDep] -> [SpecReexport] -> [SpecBuildTool] -> [FilePath] -> [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> [String] -> [FilePath] -> [String] -> [FilePath] -> [String] -> SpecComponent
- Distribution.Client.Buck2.Write: writeAllPackages :: Verbosity -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> [(FilePath, PackageDescription)] -> IO ()
+ Distribution.Client.Buck2.Write: writeAllPackages :: Verbosity -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> [BuiltPackage] -> Bool -> IO ()
- Distribution.Client.CmdBuck2: buck2Action :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
+ Distribution.Client.CmdBuck2: buck2Action :: NixStyleFlags Buck2Flags -> [String] -> GlobalFlags -> IO ()
- Distribution.Client.CmdBuck2: buck2Command :: CommandUI (NixStyleFlags ())
+ Distribution.Client.CmdBuck2: buck2Command :: CommandUI (NixStyleFlags Buck2Flags)

Files

README.md view
@@ -19,10 +19,17 @@ Then in the root of your project or package:  ```-git clone https://github.com/simonmar/haskell-buck2.git buck2+git clone https://github.com/simonmar/haskell-buck2.git buck2 -b <version> cabal buck2 --enable-tests ``` +Where `<version>` is the version of `cabal-buck`,+e.g. `0.2.0.0`. Checking out the branch ensures that you get a+compatible copy of the Buck2 support code. `cabal buck2` checks that+`buck2/` is for its release (the `CABAL_BUCK2_VERSION` in+`buck2/version.bzl`), and so does buck2 when it reads the files that+`cabal buck2` generated, and the error says which branch to switch to.+ Then you can use `buck2` as the build tool, e.g.  ```@@ -72,7 +79,7 @@   * Buck2 understands dependencies between C/C++ source files and header files (Cabal doesn't: [issue #4306](https://github.com/haskell/cabal/issues/4306)), so when you modify a C/C++ header the correct things are rebuilt.   * Buck2 builds C/C++ files in parallel, while Cabal doesn't ([issue #7127](https://github.com/haskell/cabal/issues/7127)) -* You can use [remote execution and caching](https://buck2.build/docs/users/remote_execution/) (I haven't tried this with `cabal buck2` yet).+* You can use [remote execution and caching](https://buck2.build/docs/users/remote_execution/). There is built-in support for using a build cache, see [Sharing build results (a build cache)](#sharing-build-results-a-build-cache) below.  Finally, if you have an existing codebase using Buck2 then this is the basis of something that could "buckify" Cabal packages to integrate@@ -84,7 +91,7 @@  # How complete is it? -I've used it to build a few largish projects, in particular the Cabal+I've used it to build a few large projects, in particular the Cabal project itself which consists of about 16 packages and a few hundred source files. It can also build [Glean](https://glean.software), which has some complex build requirements including custom codegen, FFI &@@ -112,9 +119,14 @@     * `third-party/haskell`: tells Buck2 about all the prebuilt package      dependencies, either in the Cabal store or in GHC's package-     DB. In here we also record the GHC version you're using, and the+     DB (unless you build the dependencies from source, see below). In here we also record the GHC version you're using, and the      paths to any tool dependencies. +A component that can't be built with buck2 (e.g. `build-type: Custom`)+is an error: `cabal buck2` lists them and aborts, unless you give the+`--keep-going` flag in which case it will translate everything it+can and warn about the missing components.+ # Buck2 quick start  To build your code:@@ -208,6 +220,84 @@  There are other build options that can be selected in a similar way, such as `-m prof` to enable profiling. See `constraints/BUCK` for details. +# Sharing build results (a build cache)++By default buck2 keeps nothing between runs of its daemon, nor between+checkouts: after `buck2 kill`, or in a new worktree, everything is built again.+A cache of build results fixes that. Buck2 can use any server that implements+the Bazel remote execution API's action cache and CAS, **only to look results+up and store them: nothing is run remotely**. For example+[bazel-remote](https://github.com/buchgr/bazel-remote):++```+bazel-remote --dir ~/.cache/buck2 --max_size 20 --grpc_address 127.0.0.1:9092 --http_address 127.0.0.1:8080+cabal buck2 --cache=grpc://127.0.0.1:9092+```++`--cache` adds a block to `.buckconfig` (between `# >>> cabal buck2: cache`+and `# <<< cabal buck2: cache <<<`; anything else in the file is left alone),+which later runs keep. `cabal buck2 --no-cache` removes it. **Run+`buck2 kill` after changing it**: buck2 reads the cache's address when its+daemon starts, and a daemon that was already running keeps the old settings.++Things to know:++* **The server has to be running.** When it isn't, buck2 retries connecting+  for about 45 seconds on each build before carrying on without the cache.+  Re-run `cabal buck2` with `--no-cache` to stop using the cache.+* The key of a cached result includes the command line, the environment and+  the contents of the inputs. It includes the exact packages from the Cabal+  store (their unit ids), a fingerprint of the GHC installation (its version,+  platform, source commit and the interface hashes of its boot packages) and+  a fingerprint of the C toolchain (the versions of the C compiler, `ld`, the+  C library and `libstdc++`). It does **not** include other files that are+  found on the system, such as headers and libraries that are not part of+  those. That is fine on one machine; **sharing a cache between machines with+  different system software is not safe yet**.+* Compiling and linking C/C++ code is cached, `pkg-config` queries are not.+* **buck2 only downloads what is needed.** A result that is found in the cache+  is not downloaded until something needs its files: a local action that has+  it as an input, `buck2 run` or `buck2 test`, or it is what you asked to+  build. So most intermediate results (the compiled modules of a library+  that was cached as a whole, say) are never fetched. `buck2 build -M none+  //...` goes further and does not download what you asked for either, which+  is a fast way to find out whether everything is already in the cache: the+  summary line shows how many actions were cache hits.++# Building the dependencies with buck2++By default the dependencies of your packages are built by `cabal`, into its+store, and Buck2 uses them from there. With `--source-deps` Buck2 builds them+too:++```+cabal buck2 --source-deps+```++The source of each dependency is unpacked under `dist-newstyle/src` and the+package gets a `BUCK` and `BUCK.cabal.bzl` like those of your own packages.+Only the packages that come with GHC are used from its package database; the+build then doesn't depend on the Cabal store at all. Together with a+[build cache](#sharing-build-results-a-build-cache) that means a dependency is+built once, and then found in the cache by every other checkout, which is the+job the store does for `cabal`.++Things to know:++* If any dependency package isn't supported by `cabal buck2`,+  `--source-deps` will fail. The most common cause of this is a+  package that uses `build-type: Custom` (see+  [Custom build type](#custom-build-type)). In case of failure you can+  either fall back to not using `--source-deps` or use `--keep-going`+  to continue without the unsupported dependencies.+* Running `cabal buck2` again without `--source-deps` goes back to the store,+  and removes the packages that were unpacked for the previous run.+* The tools that dependencies need to preprocess sources (`alex` and `happy`)+  are built by buck2 too, when the project needs them.+* The build plan can only have one version of each package, because a package+  in a `.cabal` file is referred to by its name. `cabal buck2` stops and lists+  the packages that need more than one.+ # Performance  I ran some experiments building the Cabal project itself - 16 packages@@ -285,9 +375,21 @@  ## Custom build type -The `cabal buck2` command doesn't run the actual `Setup.hs` code for a-package with the (legacy) Custom build type. If you rely on this, use-Hooks instead.+Build-type `Custom` isn't supported, and can't be in general, so+`cabal buck2` will fail if any package requires it. Note that this+also applies to dependencies when `--source-deps` is being used.  As+with other unsupported features, you can use `--keep-going` to just+skip all the affected packages.++## Hooks build type++There is partial support for `build-type: Hooks`: only configure hooks+are supported so far; files generated by pre-build rules are not.++The `SetupHooks` executable is built (by cabal) during `cabal buck2`,+including the package's `setup-depends`. It has to be built with the+same Cabal version as `cabal-buck2`, so `cabal-buck2` injects a+solver constraint to ensure that.  ## **Template Haskell and `prof`** 
cabal-buck2.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.8 name:               cabal-buck2-version:            0.1.0.0+version:            0.2.0.0 synopsis:           Build a Cabal project with buck2 (the `cabal buck2` external command) license:            BSD-3-Clause build-type:         Simple@@ -17,6 +17,10 @@ extra-doc-files:    README.md, changelog.md extra-source-files:   test/fixtures/**/*.c+  test/fixtures/**/*.cmm+  test/fixtures/**/*.S+  test/fixtures/**/*.js+  test/fixtures/**/*.ly   test/fixtures/**/*.cabal   test/fixtures/**/*.h   test/fixtures/**/*.hs@@ -24,6 +28,7 @@   test/fixtures/**/.buckconfig   test/fixtures/**/.gitkeep   test/fixtures/**/PACKAGE+  test/fixtures/**/*.txt  homepage:            https://github.com/simonmar/cabal-buck2 bug-reports:         https://github.com/simonmar/cabal-buck2/issues@@ -43,7 +48,10 @@   exposed-modules:     Distribution.Client.CmdBuck2     Distribution.Client.Buck2.BuildDependencies+    Distribution.Client.Buck2.Cache     Distribution.Client.Buck2.Configure+    Distribution.Client.Buck2.Fingerprint+    Distribution.Client.Buck2.Flags     Distribution.Client.Buck2.Generate     Distribution.Client.Buck2.LocalPackages     Distribution.Client.Buck2.Prebuilt@@ -52,7 +60,12 @@     Distribution.Client.Buck2.Spec     Distribution.Client.Buck2.Starlark     Distribution.Client.Buck2.Unpack+    Distribution.Client.Buck2.Version     Distribution.Client.Buck2.Write+  other-modules:+    Paths_cabal_buck2+  autogen-modules:+    Paths_cabal_buck2   build-depends:     , async         >=2.2.6 && <2.3     , base          >=4.17 && <4.24@@ -60,14 +73,17 @@     , Cabal         ==3.18.*     , Cabal-syntax  ==3.18.*     , cabal-install ==3.18.1.0+    , cabal-install-solver ==3.18.*     , containers    >=0.6.7 && <0.7     , directory     >=1.3.8 && <1.4     , filepath      ==1.4.*+    , process       >=1.6 && <1.7     , stm           >=2.5.1 && <2.6  executable cabal-buck2   import:           warnings   main-is:          Main.hs+  ghc-options:      -threaded -rtsopts   hs-source-dirs:   app   default-language: GHC2021   build-depends:@@ -79,8 +95,8 @@ -- `cabal test` runs `cabal-buck2` on the projects in `test/fixtures` -- and checks the files it generates. The tests don't need buck2, and -- use a private `CABAL_DIR` and the packages installed with GHC only--- (the fixtures set `active-repositories: :none`), so they need no--- network access.+-- (the fixtures set `active-repositories: :none`, or a local repository+-- made with `tar`), so they need no network access.  test-suite fixtures   import:             warnings@@ -91,6 +107,9 @@   build-tool-depends: cabal-buck2:cabal-buck2   build-depends:     , base          >=4.17 && <4.24+    , bytestring    >=0.11.5 && <0.12+    , cabal-buck2+    , containers    >=0.6.7 && <0.7     , directory     , filepath     , process
changelog.md view
@@ -1,3 +1,29 @@ # 0.1.0.0    * For `cabal-install` version 3.18++# 0.2.0.0++  * For `cabal-install` version 3.18+  * Major new features (see the README for more details):+    * Support for a build cache (`cabal buck2 --cache=...`), setup+      instructions in the README.+    * Support for building the whole dependency tree with Buck2,+      avoiding the Cabal store entirely (`cabal buck2+      --source-deps`). This works particularly well in conjunction+      with a build cache, because the cache does the job of the Cabal+      store. The biggest blocker here is that packages using+      `build-type: Custom` are not supported, however.+    * Partial support for `build-type: hooks`.+  * Minor new features:+    * Support for `asm-sources` and `cmm-sources`.+    * `cabal buck2` now aborts with an error if any components cannot+      be translated due to an unsupported feature (e.g. `build-type:+      Custom`). Use `--keep-going` to skip unsupported components+      instead of failing.+  * Fixes:+    * Various fixes for `hsc2hs`+    * Handle Happy parsers with a `.ly` extension+    * Module re-exports are handled correctly+    * Fix name clash problem with prebuilt sublibraries+    * Fix broken `cabal buck2 -j`
src/Distribution/Client/Buck2/BuildDependencies.hs view
@@ -23,15 +23,15 @@  import Distribution.Simple.Utils (dieWithException, notice) -import Distribution.Client.Buck2.LocalPackages (isBuiltLocally)+import Distribution.Client.Buck2.LocalPackages (DependencyMode, builtLocalElabs, isBuiltLocally, planElab, setupDependencyUnits) import Distribution.Client.Buck2.Unpack (unpackInplaceSources) import Distribution.Client.Errors (CabalInstallException (ReportCannotPruneDependencies))  -- | Build every dependency of the selected targets, excluding packages -- that are forced to build locally (see 'isBuiltLocally'). -- This is similar but not quite the same as the code for @CmdBuild@.-buildDependencies :: Verbosity -> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext-buildDependencies verbosity baseCtx targetSelectors = do+buildDependencies :: Verbosity -> DependencyMode -> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext+buildDependencies verbosity mode baseCtx targetSelectors = do   buildCtx@ProjectBuildContext{elaboratedPlanOriginal, elaboratedShared} <-     runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do       targets <-@@ -43,12 +43,14 @@             Nothing             targetSelectors       let elaboratedPlan' = pruneInstallPlanToTargets TargetActionBuild targets elaboratedPlan+          setupUnits = setupDependencyUnits mode elaboratedPlan           excluded =             Map.keysSet targets               <> Set.fromList                 [ elabUnitId elab-                | InstallPlan.Configured elab <- InstallPlan.toList elaboratedPlan'-                , isBuiltLocally elab+                | Just elab <- map planElab (InstallPlan.toList elaboratedPlan')+                , isBuiltLocally mode elab+                , elabUnitId elab `Set.notMember` setupUnits                 ]       elaboratedPlan'' <-         either (dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies) return $@@ -66,8 +68,7 @@     elaboratedShared     (projectConfigWithBuilderRepoContext verbosity (buildSettings baseCtx))     [ elab-    | InstallPlan.Configured elab <- InstallPlan.toList elaboratedPlanOriginal-    , isBuiltLocally elab+    | elab <- builtLocalElabs mode elaboratedPlanOriginal     , not (elabLocalToProject elab)     ]   return buildCtx
+ src/Distribution/Client/Buck2/Cache.hs view
@@ -0,0 +1,114 @@+-- | Using a remote action cache, so that buck2 can reuse the results of+-- actions that were run before, in another checkout of the project or by an+-- earlier build with the same inputs.+--+-- Nothing is run remotely: the cache server (anything that speaks the Bazel+-- remote execution API's action cache and CAS, such as @bazel-remote@) only+-- stores results. Turning this on adds a block to the project's+-- @.buckconfig@ (see 'cacheBlock'); the buck2 support code reads+-- @[cabal_buck2] cache@ from it to enable the cache in its execution platform+-- and C\/C++ toolchain.+module Distribution.Client.Buck2.Cache+  ( CacheSetting (..)+  , cacheSetting+  , configureCache+  , cacheBlock+  , spliceBlock+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++import System.Directory (doesFileExist)+import System.FilePath ((</>))++import Distribution.Simple.Flag (flagToMaybe, fromFlagOrDefault)+import Distribution.Simple.Utils (die', notice)++import Distribution.Client.Buck2.Flags (Buck2Flags (..))++data CacheSetting+  = -- | Leave .buckconfig as it is.+    CacheUnchanged+  | CacheOn String+  | CacheOff+  deriving (Eq, Show)++-- | What the flags ask for, or an error if they contradict each other.+cacheSetting :: Buck2Flags -> Either String CacheSetting+cacheSetting flags =+  case (flagToMaybe (buck2CacheAddress flags), fromFlagOrDefault False (buck2NoCache flags)) of+    (Just _, True) -> Left "--cache and --no-cache can't be used together"+    (Just address, False)+      | any (`isPrefixOf` address) ["grpc://", "grpcs://"] -> Right (CacheOn address)+      | otherwise -> Left ("--cache: the address should start with grpc:// or grpcs://, not " ++ show address)+    (Nothing, True) -> Right CacheOff+    (Nothing, False) -> Right CacheUnchanged++-- | Add, change or remove the cache's block of @.buckconfig@.+configureCache :: Verbosity -> FilePath -> CacheSetting -> IO ()+configureCache _ _ CacheUnchanged = return ()+configureCache verbosity projectRoot setting = do+  let path = projectRoot </> ".buckconfig"+  exists <- doesFileExist path+  unless exists $ die' verbosity (path ++ " doesn't exist")+  old <- readFile path+  let new = spliceBlock (case setting of CacheOn address -> Just (cacheBlock address); _ -> Nothing) old+  when (new /= old) $ do+    length old `seq` writeFile path new+    notice verbosity $+      unlines+        [ case setting of+            CacheOn address -> "cabal buck2: using the action cache at " ++ address ++ " (see .buckconfig)"+            _ -> "cabal buck2: no longer using an action cache"+        , "cabal buck2: run `buck2 kill` now: a running buck2 daemon keeps using the old settings"+        , "(with a cache address but half of the new settings it retries connecting for ~45s on every build)"+        ]++-- | The lines @cabal buck2 --cache=ADDRESS@ puts in @.buckconfig@, without the+-- markers. @default_allow_cache_upload@ is needed because most actions of+-- the prelude don't opt in to having their results uploaded, and+-- @engine_address@ because buck2 won't connect to the cache without it, even+-- though nothing is run there. buck2 reads @[buck2_re_client]@ when its daemon+-- starts, but @[cabal_buck2] cache@ on every command, so a daemon that was+-- running before these settings were added has to be restarted.+cacheBlock :: String -> [String]+cacheBlock address =+  [ "[cabal_buck2]"+  , "  cache = true"+  , ""+  , "[buck2]"+  , "  default_allow_cache_upload = true"+  , ""+  , "[buck2_re_client]"+  , "  action_cache_address = " ++ address+  , "  cas_address = " ++ address+  , "  engine_address = " ++ address+  , "  tls = " ++ (if "grpcs://" `isPrefixOf` address then "true" else "false")+  ]++beginMarker, endMarker :: String+beginMarker = "# >>> cabal buck2: cache (generated by `cabal buck2 --cache`: change it with --cache, remove it with --no-cache) >>>"+endMarker = "# <<< cabal buck2: cache <<<"++-- | Replace the block between the markers in a config file by the given+-- lines (or remove it, if there are none). If there is no block the new one+-- is added at the end. Anything outside the markers is left as it is.+spliceBlock :: Maybe [String] -> String -> String+spliceBlock block contents = case break isBegin ls of+  (before, _ : rest)+    | (_, _ : after) <- break (== endMarker) rest -> unlines ((if null new then dropSeparator before else before) ++ new ++ after)+  _ | null new -> contents+  _ -> unlines (ls ++ separator ++ new)+  where+    ls = lines contents+    isBegin = ("# >>> cabal buck2: cache" `isPrefixOf`)+    new = maybe [] (\b -> [beginMarker] ++ b ++ [endMarker]) block+    -- A blank line between what is there and the new block.+    separator = case reverse ls of+      (l : _) | any (not . isSpace) l -> [""]+      _ -> []+    -- ... which goes when the block does.+    dropSeparator xs = case reverse xs of+      (l : rest) | all isSpace l -> reverse rest+      _ -> xs
src/Distribution/Client/Buck2/Configure.hs view
@@ -17,6 +17,9 @@   , readTVarIO   ) +import Distribution.Client.JobControl (newLock)+import Distribution.Client.Setup (filterConfigureFlags)+import Distribution.Client.SetupWrapper (InLibraryArgs (..), InLibraryLBI (..), SetupRunnerArgs (..), setupWrapper) import Distribution.Client.DistDirLayout   ( DistDirLayout (distBuildDirectory)   )@@ -25,24 +28,29 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning hiding (pruneInstallPlanToTargets) import Distribution.Client.ProjectPlanning.Types-  ( elabDistDirParams+  ( elabComponentName+  , elabDistDirParams   , elabExeDependencyPaths+  , elabOrderExeDependencies   , elabOrderLibDependencies   ) import Distribution.Client.Types.ReadyPackage (GenericReadyPackage (ReadyPackage)) import Distribution.Client.Utils (numberOfProcessors) import Distribution.Types.ParStrat (ParStratInstall, ParStratX (..)) -import Distribution.Package (PackageName, packageName)+import Distribution.Package (PackageName, packageId, packageName, packageVersion) import Distribution.PackageDescription (PackageDescription) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Compiler (PackageDBX (GlobalPackageDB)) import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.Program.Builtin (builtinPrograms)-import Distribution.Simple.Program.Db (prependProgramSearchPathNoLogging, restoreProgramDb, userSpecifyArgss)+import Distribution.Simple.Program.Db (prependProgramSearchPathNoLogging, restoreProgramDb, updateProgram, userSpecifyArgss)+import Distribution.Simple.Program.Types (ProgramLocation (FoundOnSystem), ConfiguredProgram (programVersion), simpleConfiguredProgram) import Distribution.Simple.Register (generateRegistrationInfo)-import Distribution.Simple.Utils (info)+import qualified Distribution.Simple.Setup as Cabal+import Distribution.Simple.Program (defaultProgramDb)+import Distribution.Simple.Utils (die', info) import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Types.LocalBuildInfo   ( LocalBuildInfo@@ -51,13 +59,14 @@   , relocatable   ) import Distribution.Types.UnitId (UnitId)+import Distribution.Types.UnqualComponentName (unUnqualComponentName) import Distribution.Utils.Path (makeSymbolicPath) import Distribution.Verbosity (defaultVerbosityHandles)  import System.Directory (canonicalizePath) import System.FilePath ((</>)) -import Distribution.Client.Buck2.LocalPackages (componentNamesFor, isBuiltLocally, packageSourceDir)+import Distribution.Client.Buck2.LocalPackages (DependencyMode, builtLocalElabs, componentNamesFor, isBuiltLocally, packageSourceDir, planElab) import Distribution.Client.Buck2.Schedule (runDependencyGraph)  -- | Get a real 'LocalBuildInfo' for every component in the@@ -73,13 +82,15 @@ -- this can take a while for projects with a lot of components to build. configureComponents   :: Verbosity+  -> DependencyMode   -> ProjectBaseContext   -> ProjectBuildContext   -> InstalledPackageIndex   -> IO (Map (PackageName, ComponentName) LocalBuildInfo)-configureComponents verbosity baseCtx buildCtx installedIndex =+configureComponents verbosity mode baseCtx buildCtx installedIndex =   configureComponentsConcurrently     verbosity+    mode     (distDirLayout baseCtx)     (parStratNumJobs (buildSettingNumJobs (buildSettings baseCtx)))     (pruneInstallPlanToTargets TargetActionBuild (targetsMap buildCtx) (elaboratedPlanOriginal buildCtx))@@ -89,13 +100,14 @@ -- | A real 'LocalBuildInfo' for one local (or quasi-local) *component*. localBuildInfoFor   :: Verbosity+  -> DependencyMode   -> DistDirLayout   -> ElaboratedInstallPlan   -> ElaboratedSharedConfig   -> InstalledPackageIndex   -> ElaboratedConfiguredPackage   -> IO LocalBuildInfo-localBuildInfoFor verbosity distDirLayout plan shared ipi elab = do+localBuildInfoFor verbosity mode distDirLayout plan shared ipi elab = do   -- Real Cabal's own 'InLibrary.configure' falls back to *searching* the   -- working directory for a @<pkgname>.cabal@ file whenever   -- 'Cabal.configCabalFilePath' isn't set (see its own use of@@ -128,12 +140,27 @@       -- top-level @configure@, which 'InLibrary.configure' skips - so       -- without this the 'LocalBuildInfo' wouldn't have them, unlike one       -- from a real @Setup configure@.+      --+      -- A tool that buck2 is going to build doesn't exist yet when the+      -- component is configured, but Cabal wants to know that it is there+      -- and of a version that suits: it is told so (the tool is put on the+      -- @PATH@ of the compile actions that use it by buck2).       progDb =+        foldr updateProgram userProgDb builtTools+      userProgDb =         userSpecifyArgss (Map.toList (elabProgramArgs elab)) $           prependProgramSearchPathNoLogging             (elabExeDependencyPaths elab ++ elabProgramPathExtra elab)             []             (restoreProgramDb builtinPrograms (pkgConfigCompilerProgs shared))+      builtTools =+        [ (simpleConfiguredProgram name (FoundOnSystem name)){programVersion = Just (packageVersion depElab)}+        | uid <- elabOrderExeDependencies elab+        , Just depElab <- [InstallPlan.lookup plan uid >>= planElab]+        , isBuiltLocally mode depElab+        , Just (CExeName exe) <- [elabComponentName depElab]+        , let name = unUnqualComponentName exe+        ]       buildType = PD.buildType (elabPkgDescription elab)       inputs =         InLibrary.libraryConfigureInputsFromElabPackage@@ -153,8 +180,48 @@       (ReadyPackage elab)       shared       commonFlags-  InLibrary.configure inputs cfg+  if buildType == PD.Hooks+    then configureWithHooks verbosity distDirLayout plan shared ipi elab pkgDir cfg+    else InLibrary.configure inputs cfg +-- | Configure a package with a @Hooks@ build type: its hooks are in an+-- executable that is built from its @SetupHooks.hs@ first, which is what+-- 'setupWrapper' does.+configureWithHooks+  :: Verbosity+  -> DistDirLayout+  -> ElaboratedInstallPlan+  -> ElaboratedSharedConfig+  -> InstalledPackageIndex+  -> ElaboratedConfiguredPackage+  -> FilePath+  -> Cabal.ConfigFlags+  -> IO LocalBuildInfo+configureWithHooks verbosity distDirLayout plan shared ipi elab pkgDir cfg = do+  lock <- newLock+  ipiVar <- newTVarIO ipi+  let srcdir = makeSymbolicPath pkgDir+      builddir = makeSymbolicPath (distBuildDirectory distDirLayout (elabDistDirParams shared elab) </> "build")+      options = setupHsScriptOptions (ReadyPackage elab) plan shared distDirLayout srcdir builddir lock+  res <-+    setupWrapper+      verbosity+      options+      (Just (elabPkgDescription elab))+      (Cabal.configureCommand defaultProgramDb)+      Cabal.configCommonFlags+      (return . filterConfigureFlags cfg)+      (const [])+      (InLibraryArgs (InLibraryConfigureArgs shared (ReadyPackage elab) ipiVar))+  case res of+    InLibraryLBI lbi -> return lbi+    NotInLibraryNoLBI ->+      die' verbosity $+        "cabal buck2: the Cabal library of "+          ++ prettyShow (packageId elab)+          ++ "'s setup dependencies doesn't match the one cabal-buck2 uses, so its hooks can't be run: it needs Cabal-hooks "+          ++ "from the same release (add a lower bound on Cabal-hooks in its setup-depends)"+ -- | If @cname@ names a library component, produce the real, in-place -- 'InstalledPackageInfo' for it. libraryInstalledPackageInfo :: Verbosity -> LocalBuildInfo -> PackageDescription -> ComponentName -> IO (Maybe InstalledPackageInfo)@@ -170,6 +237,7 @@ -- and the @-jNUM@ flag. configureComponentsConcurrently   :: Verbosity+  -> DependencyMode   -> DistDirLayout   -> Int   -- ^ Maximum number of components to configure at once (from@@ -178,7 +246,7 @@   -> ElaboratedSharedConfig   -> InstalledPackageIndex   -> IO (Map (PackageName, ComponentName) LocalBuildInfo)-configureComponentsConcurrently verbosity distDirLayout numJobs plan shared installedIndex = do+configureComponentsConcurrently verbosity mode distDirLayout numJobs plan shared installedIndex = do   numCaps <- getNumCapabilities   info verbosity $ "cabal buck2: configuring components with up to " ++ show numJobs ++ " job(s)"   let wantedCaps = min numJobs numberOfProcessors@@ -189,8 +257,7 @@       localElabs =         Map.fromList           [ (elabUnitId elab, elab)-          | InstallPlan.Configured elab <- InstallPlan.toList plan-          , isBuiltLocally elab+          | elab <- builtLocalElabs mode plan           ]    indexVar <- newTVarIO installedIndex@@ -200,7 +267,7 @@     let elab = localElabs Map.! uid         pkgDesc = elabPkgDescription elab     idx <- readTVarIO indexVar-    lbi <- localBuildInfoFor verbosity distDirLayout plan shared idx elab+    lbi <- localBuildInfoFor verbosity mode distDirLayout plan shared idx elab     for_ (componentNamesFor elab pkgDesc) $ \cname -> do       mipi <- libraryInstalledPackageInfo verbosity lbi pkgDesc cname       for_ mipi $ \ipi -> atomically $ modifyTVar' indexVar (PackageIndex.insert ipi)
+ src/Distribution/Client/Buck2/Fingerprint.hs view
@@ -0,0 +1,131 @@+-- | A fingerprint of the GHC installation, for the buck2 action cache.+--+-- The cache key of a compile action covers its command line, environment and+-- inputs, but not the compiler itself: GHC is found on the @PATH@ by its+-- versioned name, and the files of its installation are not tracked. The+-- fingerprint makes it part of the key, so that the cache can be shared (and+-- kept across upgrades) without serving the output of a different GHC.+module Distribution.Client.Buck2.Fingerprint+  ( ghcFingerprint+  , fingerprintOf+  , ccFingerprint+  , ccFingerprintOf+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import Data.Char (isSpace)+import Data.List (isPrefixOf, sort)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (mapMaybe)+import Control.Exception (SomeException, try)+import System.Directory (canonicalizePath, listDirectory)+import System.Exit (ExitCode (..))+import System.FilePath (isExtensionOf, takeFileName, (</>))+import System.Process (readProcessWithExitCode)++import Distribution.Simple.Compiler (Compiler, compilerProperties)+import Distribution.Utils.MD5 (md5, showMD5)++-- | The fingerprint of a GHC installation, given its global package db (the+-- @package.conf.d@ directory).+ghcFingerprint :: Compiler -> FilePath -> IO String+ghcFingerprint compiler globalDb = do+  names <- filter ("conf" `isExtensionOf`) <$> listDirectory globalDb+  confs <- mapM (\n -> (,) n <$> BS8.readFile (globalDb </> n)) names+  return (fingerprintOf (compilerProperties compiler) confs)++-- | The fingerprint is made of the GHC version, target platform and source+-- commit, which make it readable, and a hash of everything that identifies the+-- build: the properties that @ghc --info@ reports, and the @abi:@ hash that+-- every package of the global db records for its interface. Two installations+-- of the same bindist (ghcup's, say) have the same fingerprint, wherever they+-- are; a GHC of the same version built differently almost certainly does not.+fingerprintOf+  :: Map String String+  -- ^ What @ghc --info@ reports.+  -> [(FilePath, ByteString)]+  -- ^ The @.conf@ files of the global package db, with their names.+  -> String+fingerprintOf props confs =+  concat+    [ prop "Project version"+    , "-"+    , prop "Target platform"+    , "-"+    , take 8 (prop "Project Git commit id")+    , "-"+    , take 12 (showMD5 (md5 (BS8.pack (unlines (fields ++ abis)))))+    ]+  where+    prop k = Map.findWithDefault "" k props+    fields = [k ++ "=" ++ prop k | k <- hashedProps]+    abis = sort [name ++ " " ++ abi | (name, conf) <- confs, Just abi <- [abiOf conf]]++    hashedProps =+      [ "Project version"+      , "Project Git commit id"+      , "Build platform"+      , "Host platform"+      , "Target platform"+      , "GHC Dynamic"+      , "RTS ways"+      ]++    abiOf conf = case mapMaybe (stripKey . BS8.unpack) (BS8.lines conf) of+      (abi : _) -> Just abi+      [] -> Nothing+    stripKey line+      | "abi:" `isPrefixOf` line = Just (dropWhile isSpace (drop 4 line))+      | otherwise = Nothing++-- | A fingerprint of the C toolchain, for the same purpose as 'ghcFingerprint'.+-- It matters for more than the C and C++ code of a project: GHC runs the C+-- compiler to preprocess modules that use CPP and to link, and @hsc2hs@ runs+-- it too.+--+-- It is made from what the tools report about themselves, so it identifies+-- the versions in use and not the files: the C compiler @GHC@ is configured+-- with (@gcc@, normally) together with @cc@, @c++@, @g++@ and @ld@, the C+-- library, and the C++ standard library the compiler would link.+ccFingerprint :: Compiler -> IO String+ccFingerprint compiler = do+  let ghcCC = Map.findWithDefault "gcc" "C compiler command" (compilerProperties compiler)+      tools = ordNubOn id [ghcCC, "cc", "c++", "g++", "ld"]+  versions <- mapM (\t -> (,) t <$> firstLine ["--version"] t) tools+  target <- firstLine ["-dumpmachine"] "cc"+  libc <- firstLine ["--version"] "ldd"+  libcxx <- stdlibName+  return (ccFingerprintOf ([("target", target), ("libc", libc), ("libstdc++", libcxx)] ++ versions))+  where+    firstLine args cmd = do+      r <- try (readProcessWithExitCode cmd args "")+      return $ case r :: Either SomeException (ExitCode, String, String) of+        Right (ExitSuccess, out, _) | (l : _) <- lines out -> l+        _ -> "unavailable"+    -- The file that @libstdc++.so@ is, which has the library's version in its+    -- name.+    stdlibName = do+      r <- try (readProcessWithExitCode "c++" ["-print-file-name=libstdc++.so"] "")+      case r :: Either SomeException (ExitCode, String, String) of+        Right (ExitSuccess, out, _) | (l : _) <- lines out -> do+          real <- try (canonicalizePath l)+          return (either (const l) takeFileName (real :: Either SomeException FilePath))+        _ -> return "unavailable"+    ordNubOn f = go []+      where+        go _ [] = []+        go seen (x : xs)+          | f x `elem` seen = go seen xs+          | otherwise = x : go (f x : seen) xs++-- | The fingerprint, given what the tools reported, as @(name, report)@ pairs.+-- It starts with the target the C compiler reports, to be readable.+ccFingerprintOf :: [(String, String)] -> String+ccFingerprintOf reports =+  concat+    [ maybe "unknown" (map (\c -> if isSpace c then '_' else c)) (lookup "target" reports)+    , "-"+    , take 12 (showMD5 (md5 (BS8.pack (unlines [name ++ ": " ++ report | (name, report) <- sort reports]))))+    ]
+ src/Distribution/Client/Buck2/Flags.hs view
@@ -0,0 +1,57 @@+-- | The flags of @cabal buck2@ that @cabal build@ doesn't have.+module Distribution.Client.Buck2.Flags+  ( Buck2Flags (..)+  , defaultBuck2Flags+  , buck2FlagOptions+  , dependencyMode+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++import Distribution.ReadE (succeedReadE)+import Distribution.Simple.Command (OptionField, ShowOrParseArgs, option, reqArg)+import Distribution.Simple.Flag (Flag, flagToList, fromFlagOrDefault, toFlag)+import Distribution.Simple.Setup (trueArg)++import Distribution.Client.Buck2.LocalPackages (DependencyMode (..))++data Buck2Flags = Buck2Flags+  { buck2CacheAddress :: Flag String+  , buck2NoCache :: Flag Bool+  , buck2SourceDeps :: Flag Bool+  }++defaultBuck2Flags :: Buck2Flags+defaultBuck2Flags = Buck2Flags{buck2CacheAddress = mempty, buck2NoCache = mempty, buck2SourceDeps = mempty}++buck2FlagOptions :: ShowOrParseArgs -> [OptionField Buck2Flags]+buck2FlagOptions _ =+  [ option+      []+      ["cache"]+      "Use the remote action cache at ADDRESS (grpc://host:port), only to look up and store results: nothing is run remotely. Written to .buckconfig; later runs keep using it."+      buck2CacheAddress+      (\v f -> f{buck2CacheAddress = v})+      (reqArg "ADDRESS" (succeedReadE toFlag) flagToList)+  , option+      []+      ["no-cache"]+      "Stop using a remote action cache (removes what --cache added to .buckconfig)."+      buck2NoCache+      (\v f -> f{buck2NoCache = v})+      trueArg+  , option+      []+      ["source-deps"]+      "Build the dependencies with buck2, from their sources (unpacked under dist-newstyle), like the packages of the project, instead of having cabal build them into its store. Nothing is then taken from the store."+      buck2SourceDeps+      (\v f -> f{buck2SourceDeps = v})+      trueArg+  ]++-- | How the dependencies are to be built.+dependencyMode :: Buck2Flags -> DependencyMode+dependencyMode flags+  | fromFlagOrDefault False (buck2SourceDeps flags) = DependenciesFromSource+  | otherwise = DependenciesFromStore
src/Distribution/Client/Buck2/Generate.hs view
@@ -16,6 +16,7 @@ -- "Distribution.Client.Buck2.Write". module Distribution.Client.Buck2.Generate   ( LocalPackageIndex+  , LocalPackage (..)   , AutogenFile (..)   , PackageTargets (..)   , generatePackageTargets@@ -26,7 +27,7 @@ import Distribution.Client.Compat.Prelude import Prelude () -import System.FilePath ((<.>), (</>))+import System.FilePath (isRelative, makeRelative, normalise, (<.>), (</>))  import Data.Either (fromLeft) import qualified Data.Map as Map@@ -35,40 +36,60 @@ import qualified Distribution.Compat.NonEmptySet as NES import Distribution.Compiler (CompilerFlavor (GHC)) import qualified Distribution.ModuleName as ModuleName-import Distribution.Package (packageId, packageName)+import Distribution.Package (packageId, packageName, packageVersion) import Distribution.PackageDescription   ( Benchmark (benchmarkInterface, benchmarkName)   , BenchmarkInterface (..)   , BuildInfo   , Executable (exeName, modulePath)-  , Library (exposedModules, libBuildInfo, libName)+  , Library (exposedModules, libBuildInfo, libName, reexportedModules)   , LibraryName (..)+  , library+  , subLibraries   , PackageDescription   , TestSuite (testInterface, testName)   , TestSuiteInterface (..)   , buildToolDepends+  , asmOptions+  , asmSources   , cSources+  , cmmSources+  , jsSources   , cppOptions+  , ccOptions   , cxxOptions   , cxxSources-  , defaultExtensions+  , dataDir+  , dataFiles+  , usedExtensions   , defaultLanguage   , extraLibs   , hcOptions   , hsSourceDirs   , includeDirs   , otherModules+  , buildType+  , lookupComponent   , pkgBuildableComponents   , pkgconfigDepends   , targetBuildDepends   ) import Distribution.Simple.Compiler (compilerInfo)+import qualified Distribution.InstalledPackageInfo as IPI+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Types.ExposedModule (ExposedModule (..))+import Distribution.Backpack (OpenModule (..), OpenUnitId (..))+import Distribution.Types.UnitId (unDefUnitId)+import Data.Foldable (asum) import Distribution.Types.Component (Component (..), componentBuildInfo, componentName)-import Distribution.Types.ComponentLocalBuildInfo (ComponentLocalBuildInfo)+import Distribution.Types.ComponentLocalBuildInfo (ComponentLocalBuildInfo (componentPackageDeps)) import Distribution.Types.ComponentName (ComponentName) import Distribution.Types.Dependency (depLibraries, depPkgName) import Distribution.Types.ExeDependency (ExeDependency (..))-import Distribution.Types.LocalBuildInfo (LocalBuildInfo (compiler, hostPlatform, withPrograms), componentNameCLBIs, localUnitId)+import Distribution.Simple.LocalBuildInfo (buildDir)+import Distribution.Types.BuildType (BuildType (Custom, Configure))+import Distribution.Types.ModuleReexport (ModuleReexport (..))+import Distribution.Types.LocalBuildInfo (LocalBuildInfo (compiler, hostPlatform, installedPkgs, localPkgDescr, withPrograms), componentNameCLBIs, localUnitId) import Distribution.Types.PackageName (PackageName, unPackageName) import Distribution.Types.PkgconfigDependency (PkgconfigDependency (..)) import Distribution.Types.PkgconfigName (unPkgconfigName)@@ -76,6 +97,7 @@ import Distribution.Utils.Path (getSymbolicPath)  import Distribution.Simple.Build.Macros (generateCabalMacrosHeader)+import Distribution.Simple.PreProcess (platformDefines) import Distribution.Simple.Build.PathsModule (generatePathsModule) import Distribution.Simple.BuildPaths (autogenPathsModuleName) import Distribution.Simple.InstallDirs@@ -91,15 +113,22 @@ import Distribution.Simple.Program.Types (programOverrideArgs) import Distribution.Simple.Utils (ordNub) +import Language.Haskell.Extension (Language (Haskell98))++import Distribution.Client.Buck2.LocalPackages (nonLibraryTargetName) import Distribution.Client.Buck2.Spec  -- | Maps every local project package's name to the buck2 cell-relative -- directory its @BUCK@ file lives in (@.@ for one at the project root), so -- a dependency on another local package can be turned into a fully--- qualified target label - plus the set of other packages its main--- library's @reexported-modules@ re-export from (see 'classifyDeps').-type LocalPackageIndex = Map PackageName (FilePath, [PackageName])+-- qualified target label.+type LocalPackageIndex = Map PackageName LocalPackage +data LocalPackage = LocalPackage+  { lpDir :: FilePath+  , lpDescription :: PackageDescription+  }+ -- | A generated file that lives in the package's @cabal-buck2\/autogen@ -- directory (a component's @cabal_macros.h@, the package's own -- @Paths_\<pkg\>@ module, a @detailed-0.9@ test-suite's stub @Main@), and@@ -123,6 +152,8 @@   { ptSpec :: BuildSpec   , ptComponentCount :: Int   , ptAutogenFiles :: [AutogenFile]+  , ptNotes :: [String]+  -- ^ What was left out because the build plan doesn't include it.   }  -- | One component's contribution to a 'PackageTargets': its entry in the@@ -132,13 +163,16 @@   { ctSpec :: [SpecComponent]   , ctAutogen :: [AutogenFile]   , ctWarnings :: [String]+  -- ^ Problems: components that can't be built.+  , ctNotes :: [String]+  -- ^ Components left out because the build plan doesn't include them.   }  instance Semigroup ComponentTargets where-  ComponentTargets s1 a1 w1 <> ComponentTargets s2 a2 w2 = ComponentTargets (s1 ++ s2) (a1 ++ a2) (w1 ++ w2)+  ComponentTargets s1 a1 w1 n1 <> ComponentTargets s2 a2 w2 n2 = ComponentTargets (s1 ++ s2) (a1 ++ a2) (w1 ++ w2) (n1 ++ n2)  instance Monoid ComponentTargets where-  mempty = ComponentTargets [] [] []+  mempty = ComponentTargets [] [] [] []  componentTargets :: SpecComponent -> [AutogenFile] -> ComponentTargets componentTargets component files = mempty{ctSpec = [component], ctAutogen = files}@@ -151,6 +185,8 @@ generatePackageTargets   :: LocalPackageIndex   -> FilePath+  -- ^ The project root.+  -> FilePath   -- ^ The package's own buck2 cell-relative directory (@.@ at the project   -- root).   -> Map (PackageName, ComponentName) LocalBuildInfo@@ -162,36 +198,36 @@   -> Map (PackageName, ComponentName) [PathTemplate]   -- ^ The project's @test-options:@ for each test-suite (see 'testSuiteArgs').   -> Set FilePath+  -> Set (PackageName, LibraryName)+  -- ^ Libraries (of any package) that don't get a rule: a component that+  -- depends on one doesn't either.+  -> Bool+  -- ^ Whether this is a package of the project, as opposed to a dependency+  -- that is built like one. A dependency has components that nothing+  -- needs (its tests, say), which are skipped without a warning.   -> PackageDescription-  -> (Maybe PackageTargets, [String])-generatePackageTargets localIndex rootRelPkgDir componentLBIs externalBuildTools projectTestOptions sources pkgDesc =+  -> (PackageTargets, [String])+generatePackageTargets localIndex projectRoot rootRelPkgDir componentLBIs externalBuildTools projectTestOptions sources skippedLibs inProject pkgDesc =   (targets, concatMap ctWarnings results)   where-    generate = generateComponent localIndex componentLBIs externalBuildTools projectTestOptions sources pkgDesc-    comps = pkgBuildableComponents pkgDesc+    generate = generateComponent localIndex projectRoot componentLBIs externalBuildTools projectTestOptions sources skippedLibs inProject pkgDesc+    comps = map configured (pkgBuildableComponents pkgDesc) -    -- Worked out ahead of the other components, so that one that-    -- build-depends on a library of this package that won't get a rule-    -- (unresolvable modules) can skip itself too, instead of emitting a-    -- rule whose @deps@ references a target that was never generated --    -- buck2 fails that outright at analysis time ("Unknown target"), for-    -- the *entire* build, the same class of problem 'resolveModules'-    -- exists to avoid for a single component's own missing source file.-    -- Libraries themselves never depend on this set.-    skippedLibs =-      Set.fromList [libName lib | comp@(CLib lib) <- comps, null (ctSpec (generate Set.empty comp))]+    -- The component as configuring left it: with what a @configure@ script+    -- found (in a @.buildinfo@ file) added to it.+    configured comp = fromMaybe comp $ do+      (lbi, _) <- lbiClbiFor pkgDesc componentLBIs comp+      lookupComponent (localPkgDescr lbi) (componentName comp) -    results = map (generate skippedLibs) comps+    results = map generate comps     components = concatMap ctSpec results-    targets-      | null components = Nothing-      | otherwise =-          Just-            PackageTargets-              { ptSpec = packageSpec pkgDesc rootRelPkgDir (packageGhcOptions pkgDesc componentLBIs) components-              , ptComponentCount = length components-              , ptAutogenFiles = dedupAutogenFiles (concatMap ctAutogen results)-              }+    targets =+      PackageTargets+        { ptSpec = packageSpec pkgDesc rootRelPkgDir (packageGhcOptions pkgDesc componentLBIs) components+        , ptComponentCount = length components+        , ptAutogenFiles = dedupAutogenFiles (concatMap ctAutogen results)+        , ptNotes = concatMap ctNotes results+        }  -- | Look up a component's 'LocalBuildInfo' and -- 'ComponentLocalBuildInfo' -- 'Nothing' if either lookup fails@@ -217,57 +253,87 @@  generateComponent   :: LocalPackageIndex+  -> FilePath   -> Map (PackageName, ComponentName) LocalBuildInfo   -> Set String   -> Map (PackageName, ComponentName) [PathTemplate]   -> Set FilePath+  -> Set (PackageName, LibraryName)+  -> Bool   -> PackageDescription-  -> Set LibraryName   -> Component   -> ComponentTargets-generateComponent localIndex componentLBIs externalBuildTools projectTestOptions sources pkgDesc skippedLibs comp = case comp of-  CLib lib -> library (libTargetName (packageName pkgDesc) (libName lib)) lib-  CExe exe -> ifNotOnSkippedLib (componentBuildInfo comp) (unUnqualComponentName (exeName exe)) Executable $ executable exe-  CTest test -> ifNotOnSkippedLib (componentBuildInfo comp) (unUnqualComponentName (testName test)) TestSuite $ testSuite test-  CBench bench -> ifNotOnSkippedLib (componentBuildInfo comp) (unUnqualComponentName (benchmarkName bench)) Benchmark $ benchmark bench+generateComponent localIndex projectRoot componentLBIs externalBuildTools projectTestOptions sources skippedLibs inProject pkgDesc comp = case comp of+  CLib lib -> ifNotOnSkippedLib (libBuildInfo lib) (libTargetName (packageName pkgDesc) (libName lib)) Library $ library (libTargetName (packageName pkgDesc) (libName lib)) lib+  CExe exe -> withExeName (unUnqualComponentName (exeName exe)) $ ifNotOnSkippedLib (componentBuildInfo comp) (nonLibraryTargetName "-exe" pkgDesc (exeName exe)) Executable $ executable exe+  CTest test -> ifNotOnSkippedLib (componentBuildInfo comp) (nonLibraryTargetName "-test" pkgDesc (testName test)) TestSuite $ testSuite test+  CBench bench -> ifNotOnSkippedLib (componentBuildInfo comp) (nonLibraryTargetName "-bench" pkgDesc (benchmarkName bench)) Benchmark $ benchmark bench   CFLib _ -> skip "foreign library (not supported yet)"   where     skip = skipBecause [] +    -- Tools are found by the name of their file, which is that of the+    -- executable, not necessarily that of its target.+    withExeName exe ct = ct{ctSpec = [c{scExeName = if scName c == exe then Nothing else Just exe} | c <- ctSpec ct]}++    -- A component that wasn't configured, because the build plan doesn't+    -- include it. For the project's own packages that means a stanza that+    -- isn't enabled, which the user may want to know, but is not an error.+    notConfigured what+      | inProject = mempty{ctNotes = ["cabal buck2: no targets for " ++ what ++ " in package " ++ unPackageName (packageName pkgDesc) ++ " (not in the build plan: is its stanza enabled?)"]}+      | otherwise = mempty+     -- Skip a component, with the warnings for the problems that led to it     -- followed by the skip itself.     skipBecause problems why =       mempty{ctWarnings = problems ++ ["cabal buck2: skipping " ++ why ++ " in package " ++ unPackageName (packageName pkgDesc)]} -    -- A component that build-depends on one of *this same package's*-    -- own libraries, when that library was itself skipped (see-    -- 'skippedLibs'), can't be built either - it would emit a rule-    -- whose own @deps@ references a target that was never generated,-    -- which buck2 rejects outright ("Unknown target") at analysis time-    -- for the whole build, not just a warning. cabal-testsuite's own-    -- @test-runtime-deps@ executable (build-depends on cabal-testsuite's-    -- own library) is exactly this case.-    ifNotOnSkippedLib bi targetName kind act =-      case [ln | d <- targetBuildDepends bi, depPkgName d == packageName pkgDesc, ln <- NES.toList (depLibraries d), ln `Set.member` skippedLibs] of-        (ln : _) ->-          skip-            ( kindName kind-                ++ " "-                ++ targetName-                ++ " (depends on "-                ++ libTargetName (packageName pkgDesc) ln-                ++ ", itself skipped)"-            )-        [] -> act+    -- A component the build plan doesn't include is left out without+    -- further ado, whatever it needs. Otherwise, a component that+    -- build-depends on a library that was skipped (see+    -- 'skippedLibs') can't be built either - it would emit a rule whose+    -- own @deps@ references a target that was never generated, which buck2+    -- rejects outright ("Unknown target") at analysis time for the whole+    -- build, not just a warning.+    ifNotOnSkippedLib bi targetName kind act+      | isNothing (lbiClbiFor pkgDesc componentLBIs comp) = notConfigured (kindName kind ++ " " ++ targetName)+      | buildType pkgDesc == Custom =+          skip (kindName kind ++ " " ++ targetName ++ " (build-type: Custom needs its Setup.hs to be run)")+      | unsupported : _ <- unsupportedSources bi =+          skip (kindName kind ++ " " ++ targetName ++ " (" ++ unsupported ++ " aren't supported)")+      | otherwise =+          case [(dp, ln) | d <- targetBuildDepends bi, let dp = depPkgName d, ln <- NES.toList (depLibraries d), (dp, ln) `Set.member` skippedLibs] of+            ((dp, ln) : _) ->+              skip+                ( kindName kind+                    ++ " "+                    ++ targetName+                    ++ " (depends on "+                    ++ libTargetName dp ln+                    ++ ", itself skipped)"+                )+            [] -> act      library targetName lib = case lbiClbiFor pkgDesc componentLBIs comp of-      Nothing -> skip ("library " ++ targetName ++ " (no LocalBuildInfo found for it in the elaborated build plan)")+      Nothing -> notConfigured ("library " ++ targetName)       Just (lbi, clbi) -> case resolveModules sources pkgDesc (Just (lbi, clbi)) bi (exposedModules lib ++ otherModules bi) of         Left problems -> skipBecause problems ("library " ++ targetName ++ " (couldn't resolve all its modules)")         Right (srcs, srcAutogen) ->-          componentTargets-            (specComponent localIndex externalBuildTools Library targetName bi){scSrcs = srcs}-            (macrosHeader targetName pkgDesc lbi clbi : srcAutogen)+          let reexports = [SpecReexport (prettyShow (moduleReexportName r)) (prettyShow original) (specDep localIndex <$> from) | (r, Just (from, original)) <- reexportOrigins localIndex pkgDesc lbi clbi lib]+              -- A library with no modules (a compatibility package, say) has+              -- nothing to build, which a rule can't have.+              extra :: [(ModuleName.ModuleName, AutogenFile)]+              extra+                | null srcs = [(ModuleName.fromString "CabalBuck2Empty", emptyModule targetName)]+                | otherwise = []+           in componentTargets+                (specComponent localIndex externalBuildTools Library targetName bi)+                  { scSrcs = srcs ++ [(prettyShow m, SrcAutogen (autogenName f)) | (m, f) <- extra]+                  , scReexports = reexports+                  , scGeneratedIncludeDirs = generatedIncludeDirs projectRoot pkgDesc lbi bi+                  , scHscOptions = platformDefines lbi+                  }+                (macrosHeader targetName pkgDesc lbi clbi : srcAutogen ++ map snd extra)       where         bi = libBuildInfo lib @@ -276,13 +342,13 @@     -- arguments.     executableLike kind targetName lbi clbi bi mainSrc otherSrcs testArgs srcAutogen =       componentTargets-        (specComponent localIndex externalBuildTools kind targetName bi){scMainIs = Just mainSrc, scSrcs = otherSrcs, scTestArgs = testArgs}+        (specComponent localIndex externalBuildTools kind targetName bi){scMainIs = Just mainSrc, scSrcs = otherSrcs, scTestArgs = testArgs, scGeneratedIncludeDirs = generatedIncludeDirs projectRoot pkgDesc lbi bi, scHscOptions = platformDefines lbi}         (macrosHeader targetName pkgDesc lbi clbi : srcAutogen)      -- The shape shared by an executable, an @exitcode-stdio-1.0@     -- test-suite and benchmark: a @main-is@ file over the @other-modules@.     mainIsComponent kind targetName bi mainIs extra = case lbiClbiFor pkgDesc componentLBIs comp of-      Nothing -> skip (kindName kind ++ " " ++ targetName ++ " (no LocalBuildInfo found for it in the elaborated build plan)")+      Nothing -> notConfigured (kindName kind ++ " " ++ targetName)       Just (lbi, clbi) -> case (resolveMainIs sources bi mainIs, resolveModules sources pkgDesc (Just (lbi, clbi)) bi (otherModules bi)) of         (Right mainSrc, Right (otherSrcs, srcAutogen)) ->           executableLike kind targetName lbi clbi bi (SrcFile mainSrc) otherSrcs (extra lbi) srcAutogen@@ -292,7 +358,7 @@     executable exe = mainIsComponent Executable targetName bi (getSymbolicPath (modulePath exe)) (const [])       where         bi = componentBuildInfo (CExe exe)-        targetName = unUnqualComponentName (exeName exe)+        targetName = nonLibraryTargetName "-exe" pkgDesc (exeName exe)      -- A benchmark's own 'BenchmarkExeV10' is exactly 'TestSuiteExeV10's     -- shape (a version-tagged main-is path over the same 'BuildInfo') -@@ -310,7 +376,7 @@           )       where         bi = componentBuildInfo (CBench bench)-        targetName = unUnqualComponentName (benchmarkName bench)+        targetName = nonLibraryTargetName "-bench" pkgDesc (benchmarkName bench)      testSuite test = case testInterface test of       TestSuiteExeV10 _ver mainIs -> mainIsComponent TestSuite targetName bi (getSymbolicPath mainIs) testArgs@@ -341,7 +407,7 @@       -- even type-check (@Distribution.TestSuite@ lives in the @Cabal@       -- library itself).       TestSuiteLibV09 _ver testModule -> case lbiClbiFor pkgDesc componentLBIs comp of-        Nothing -> skip ("test-suite " ++ targetName ++ " (no LocalBuildInfo found for it in the elaborated build plan)")+        Nothing -> notConfigured ("test-suite " ++ targetName)         Just (lbi, clbi) -> case (resolveModules sources pkgDesc (Just (lbi, clbi)) bi [testModule], resolveModules sources pkgDesc (Just (lbi, clbi)) bi (otherModules bi)) of           (Right (testModSrc, testModAutogen), Right (otherSrcs, otherAutogen)) ->             let (stubSrc, stubFile) = detailedTestStub targetName testModule@@ -356,18 +422,55 @@           )       where         bi = componentBuildInfo (CTest test)-        targetName = unUnqualComponentName (testName test)+        targetName = nonLibraryTargetName "-test" pkgDesc (testName test)         testArgs lbi = testSuiteArgs pkgDesc lbi test (Map.findWithDefault [] (packageName pkgDesc, componentName comp) projectTestOptions)      problemsOf = fromLeft [] +-- | Kinds of source that a component has, that aren't built (yet).+unsupportedSources :: BuildInfo -> [String]+unsupportedSources bi =+  [ what+  | (what, files) <-+      [ ("js-sources", map getSymbolicPath (jsSources bi))+      ]+  , not (null files)+  ]++-- | A module with nothing in it, for a library to have one (a rule can't have+-- none). It imports nothing, not even the Prelude, as the library may not+-- depend on @base@.+emptyModule :: String -> AutogenFile+emptyModule targetName =+  AutogenFile+    { autogenName = targetName ++ "-empty"+    , autogenPath = "empty" </> targetName </> "CabalBuck2Empty.hs"+    , autogenContents = "{-# LANGUAGE NoImplicitPrelude #-}\n-- @generated by `cabal buck2` - do not edit by hand.\nmodule CabalBuck2Empty () where\n"+    }++-- | Where a @configure@ script (for a package with the @Configure@ build type)+-- put the headers it generated: in the build directory, in a directory like+-- each of the package's relative @include-dirs@.+generatedIncludeDirs :: FilePath -> PackageDescription -> LocalBuildInfo -> BuildInfo -> [FilePath]+generatedIncludeDirs projectRoot pkgDesc lbi bi+  | buildType pkgDesc == Configure =+      [ makeRelative projectRoot (getSymbolicPath (buildDir lbi)) </> dir+      | d <- includeDirs bi+      , let dir = getSymbolicPath d+      , isRelative dir+      ]+  | otherwise = []+ -- | A package's build spec. packageSpec :: PackageDescription -> FilePath -> [String] -> [SpecComponent] -> BuildSpec packageSpec pkgDesc rootRelPkgDir projectGhcOptions components =   BuildSpec     { specPackageName = unPackageName (packageName pkgDesc)+    , specPackageVersion = prettyShow (packageVersion pkgDesc)     , specPackageDir = rootRelPkgDir     , specGhcOptions = projectGhcOptions+    , specDataDir = getSymbolicPath (dataDir pkgDesc)+    , specDataFiles = map getSymbolicPath (dataFiles pkgDesc)     , specComponents = components     } @@ -378,36 +481,37 @@   SpecComponent     { scKind = kind     , scName = name+    , scExeName = Nothing     , scMainIs = Nothing     , scSrcs = []     , scTestArgs = []     , scGhcOptions = hcOptions GHC bi     , scCppOptions = cppOptions bi-    , scLanguage = prettyShow <$> defaultLanguage bi-    , scExtensions = map prettyShow (defaultExtensions bi)+    , -- As Cabal does, rather than GHC's own default (GHC2021).+      scLanguage = Just (prettyShow (fromMaybe Haskell98 (defaultLanguage bi)))+    , scExtensions = map prettyShow (usedExtensions bi)     , scExtraLibraries = extraLibs bi-    , scDeps = map depSpec (libraryDeps localIndex bi)+    , scDeps = map (specDep localIndex) (libraryDeps bi)+    , scReexports = []     , scBuildTools = mapMaybe buildToolSpec (ordNub [(pn, exe) | ExeDependency pn exe _ <- buildToolDepends bi])     , scCSources = map getSymbolicPath (cSources bi)     , scCxxSources = map getSymbolicPath (cxxSources bi)+    , scCmmSources = map getSymbolicPath (cmmSources bi)+    , scAsmSources = map getSymbolicPath (asmSources bi)+    , scAsmOptions = asmOptions bi+    , scCcOptions = ccOptions bi     , scCxxOptions = cxxOptions bi     , scIncludeDirs = map getSymbolicPath (includeDirs bi)+    , scHscOptions = []+    , scGeneratedIncludeDirs = []     , scPkgconfig = ordNub [unPkgconfigName n | PkgconfigDependency n _ <- pkgconfigDepends bi]     }   where-    depSpec (pn, ln) =-      SpecDep-        { depPackage = unPackageName pn-        , depLibrary = case ln of-            LSubLibName n -> Just (unUnqualComponentName n)-            LMainLibName -> Nothing-        , depDir = fst <$> Map.lookup pn localIndex-        }     -- A tool that's neither built by this project nor resolved to a real     -- external binary can't be put on PATH by buck2: dropped, silently -     -- most build-tool-depends are Setup.hs-time tools nothing needs on PATH.     buildToolSpec (pn, exe) = case Map.lookup pn localIndex of-      Just (dir, _) -> Just (LocalTool n dir)+      Just lp -> Just (LocalTool (nonLibraryTargetName "-exe" (lpDescription lp) exe) (lpDir lp))       Nothing         | n `Set.member` externalBuildTools -> Just (ExternalTool n)         | otherwise -> Nothing@@ -477,35 +581,98 @@ libTargetName pn LMainLibName = unPackageName pn libTargetName _ (LSubLibName n) = unUnqualComponentName n --- | Every library a component depends on: its @build-depends@ (each of which may name--- more than one library of a package via @pkg:sublib@ - see--- 'depLibraries'), closed over the reexports of local packages.-libraryDeps :: LocalPackageIndex -> BuildInfo -> [(PackageName, LibraryName)]-libraryDeps localIndex bi = closeOverReexports [] directDeps+-- | Every library a component depends on: its @build-depends@, each of which+-- may name more than one library of a package via @pkg:sublib@ - see+-- 'depLibraries'.+libraryDeps :: BuildInfo -> [(PackageName, LibraryName)]+libraryDeps bi =+  ordNub+    [ (depPkgName d, ln)+    | d <- targetBuildDepends bi+    , ln <- NES.toList (depLibraries d)+    ]++-- | The library, or the package's main one, that a dependency names.+specDep :: LocalPackageIndex -> (PackageName, LibraryName) -> SpecDep+specDep localIndex (pn, ln) =+  SpecDep+    { depPackage = unPackageName pn+    , depLibrary = case ln of+        LSubLibName n -> Just (unUnqualComponentName n)+        LMainLibName -> Nothing+    , depDir = lpDir <$> Map.lookup pn localIndex+    }++-- | Where a library's @reexported-modules@ come from, as Cabal resolves them: the+-- library that defines the module, which may be another library of its own+-- package, and the module's name there (a library can re-export what another+-- one re-exports, under another name, and what is recorded is where it is+-- defined). A module named with its package is looked for in that package's+-- libraries that it depends on, one named without in all of them. A module of+-- the library itself has no library. One that is not found is left out.+reexportOrigins :: LocalPackageIndex -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Library -> [(ModuleReexport, Maybe (Maybe (PackageName, LibraryName), ModuleName.ModuleName))]+reexportOrigins localIndex pkgDesc lbi clbi lib =+  [ (r, origin)+  | r <- reexportedModules lib+  , let name = moduleReexportOriginalName r+        fromDeps =+          asum+            [ definedIn 0 d name+            | d@(pn, _) <- libraryDeps (libBuildInfo lib)+            , maybe True (== pn) (moduleReexportOriginalPackage r)+            ]+        origin+          | name `elem` ownModules && maybe True (== packageName pkgDesc) (moduleReexportOriginalPackage r) = Just (Nothing, name)+          | otherwise = fromDeps >>= \(o, original) -> Just (if o == self then Nothing else Just o, original)+  ]   where-    directDeps =-      ordNub-        [ (depPkgName d, ln)-        | d <- targetBuildDepends bi-        , ln <- NES.toList (depLibraries d)+    self = (packageName pkgDesc, libName lib)+    ownModules = exposedModules lib+    libsOf desc = maybeToList (library desc) ++ subLibraries desc++    -- Where a module that a library exposes is defined: in the library itself,+    -- or where it re-exports it from (never more than a few steps).+    definedIn :: Int -> (PackageName, LibraryName) -> ModuleName.ModuleName -> Maybe ((PackageName, LibraryName), ModuleName.ModuleName)+    definedIn depth d m+      | depth > 20 = Nothing+      | otherwise = localDefinedIn depth d m <|> installedDefinedIn d m++    localDefinedIn depth d@(pn, ln) m = do+      lp <- Map.lookup pn localIndex+      l <- find ((== ln) . libName) (libsOf (lpDescription lp))+      if m `elem` exposedModules l+        then Just (d, m)+        else do+          r <- find ((== m) . moduleReexportName) (reexportedModules l)+          let original = moduleReexportOriginalName r+          if maybe False (== pn) (moduleReexportOriginalPackage r) && original `elem` exposedModules l+            then Just (d, original)+            else+              asum+                [ definedIn (depth + 1) d' original+                | d'@(pn', _) <- libraryDeps (libBuildInfo l)+                , maybe True (== pn') (moduleReexportOriginalPackage r)+                ]++    -- A package that is already built records where its re-exports are from.+    installedDefinedIn (pn, ln) m =+      listToMaybe+        [ result+        | ipi <- installedLibs pn ln+        , ExposedModule name origin <- IPI.exposedModules ipi+        , name == m+        , Just result <- [case origin of+            Nothing -> Just ((pn, ln), m)+            Just (OpenModule (DefiniteUnitId uid) original) -> do+              ipi' <- PackageIndex.lookupUnitId (installedPkgs lbi) (unDefUnitId uid)+              Just ((packageName ipi', IPI.sourceLibName ipi'), original)+            Just _ -> Nothing]         ]-    -- A local package's buck2 haskell_library() rule only ever declares-    -- its own real source modules - unlike a real GHC package db entry,-    -- it has no way to also claim modules reexported (`reexported--    -- modules:` in the .cabal file) from elsewhere. So a component that-    -- depends on a local package with reexports (e.g. `Cabal` re--    -- exporting a chunk of `Cabal-syntax`) needs the reexport's origin-    -- package added as an explicit direct dependency too, or - once-    -- compile.bzl's `-hide-all-packages` is in effect - GHC can't find-    -- the reexported module at all: "Could not load module ...". This-    -- closure adds those origins (transitively, in case a reexporting-    -- package itself depends on another reexporting package).-    closeOverReexports seen [] = seen-    closeOverReexports seen (p@(pn, _) : rest)-      | p `elem` seen = closeOverReexports seen rest-      | otherwise =-          let origins = maybe [] snd (Map.lookup pn localIndex)-           in closeOverReexports (p : seen) (rest ++ [(o, LMainLibName) | o <- origins])+    -- The libraries of the dependencies of the component come first.+    installedLibs pn ln =+      let matching = [ipi | ipi <- PackageIndex.allPackages (installedPkgs lbi), packageName ipi == pn, IPI.sourceLibName ipi == ln]+          direct = [ipi | (uid, _) <- componentPackageDeps clbi, ipi <- maybeToList (PackageIndex.lookupUnitId (installedPkgs lbi) uid), packageName ipi == pn, IPI.sourceLibName ipi == ln]+       in direct ++ matching  -- | Resolve each module in @hs-source-dirs@ to its real file, trying -- @.hs@\/@.lhs@\/@.hsc@ (and the other extensions buck2\/haskell.bzl knows@@ -613,10 +780,10 @@ -- own srcs-resolution (@_resolve_src@) knows to run through -- hsc2hs()\/alex()\/happy(). moduleCandidates :: BuildInfo -> ModuleName.ModuleName -> [FilePath]-moduleCandidates bi m = [dir </> ModuleName.toFilePath m <.> ext | dir <- sourceDirs bi, ext <- ["hs", "lhs", "hsc", "x", "y"]]+moduleCandidates bi m = [normalise (dir </> ModuleName.toFilePath m <.> ext) | dir <- sourceDirs bi, ext <- ["hs", "lhs", "hsc", "x", "y", "ly"]]  mainIsCandidates :: BuildInfo -> FilePath -> [FilePath]-mainIsCandidates bi mainIs = [dir </> mainIs | dir <- sourceDirs bi]+mainIsCandidates bi mainIs = [normalise (dir </> mainIs) | dir <- sourceDirs bi]  firstExisting :: Set FilePath -> [FilePath] -> Maybe FilePath firstExisting sources = find (`Set.member` sources)
src/Distribution/Client/Buck2/LocalPackages.hs view
@@ -2,10 +2,21 @@ -- (rather than leaving to cabal), and facts about them that come from the -- elaborated install plan rather than from their @.cabal@ files. module Distribution.Client.Buck2.LocalPackages-  ( isBuiltLocally+  ( DependencyMode (..)+  , isBuiltLocally+  , planElab+  , builtLocalElabs+  , setupDependencyUnits+  , prebuiltUnits   , packageSourceDir   , componentNamesFor+  , BuiltPackage (..)   , builtLocalPackages+  , rootRelativeDir+  , nonLibraryTargetName+  , ToolTarget (..)+  , localToolTargets+  , localBuildTools   , wantedBuildTools   , projectTestOptions   ) where@@ -14,8 +25,11 @@ import Prelude ()  import qualified Data.Map as Map+import qualified Data.Set as Set+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, removeDirectoryRecursive)+import System.FilePath (makeRelative, (</>)) -import Distribution.Client.DistDirLayout (DistDirLayout (distUnpackedSrcDirectory))+import Distribution.Client.DistDirLayout (DistDirLayout (distUnpackedSrcDirectory, distUnpackedSrcRootDirectory)) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectPlanning   ( ElaboratedConfiguredPackage (..)@@ -25,18 +39,24 @@   ( BuildStyle (BuildAndInstall)   , ElaboratedPackageOrComponent (ElabComponent, ElabPackage)   , elabComponentName+  , elabLibDependencies+  , elabOrderExeDependencies+  , elabSetupDependencies   )+import Distribution.Client.Types (confInstId) import Distribution.Client.Types.PackageLocation (PackageLocation (..))+import Distribution.Types.UnitId (UnitId, newSimpleUnitId) -import Distribution.Package (PackageName, packageId, packageName)+import Distribution.Package (HasUnitId (installedUnitId), PackageInstalled (installedDepends), PackageName, packageId, packageName, unPackageName) import Distribution.PackageDescription (PackageDescription) import qualified Distribution.PackageDescription as PD import Distribution.Simple.InstallDirs (PathTemplate)-import Distribution.Simple.Utils (die', ordNub)+import Distribution.Simple.Utils (die', info, ordNub) import Distribution.Types.Component (componentBuildInfo, componentName) import Distribution.Types.ComponentName (ComponentName (CTestName))+import Distribution.Types.Dependency (depPkgName) import Distribution.Types.ExeDependency (ExeDependency (..))-import Distribution.Types.UnqualComponentName (UnqualComponentName)+import Distribution.Types.UnqualComponentName (UnqualComponentName, unUnqualComponentName)   -- | Does buck2 (rather than cabal) build this package from source? True@@ -47,9 +67,87 @@ -- local dependency. A real-world example is hackage-security in the cabal -- project, which is not a local package but depends on the local -- Cabal-syntax.-isBuiltLocally :: ElaboratedConfiguredPackage -> Bool-isBuiltLocally elab = elabLocalToProject elab || elabBuildStyle elab /= BuildAndInstall+--+-- With 'DependenciesFromSource' that is every package that GHC doesn't come+-- with: the dependencies are unpacked from their tarballs and built like the+-- project's own packages, and nothing is left to the cabal store.+isBuiltLocally :: DependencyMode -> ElaboratedConfiguredPackage -> Bool+isBuiltLocally DependenciesFromSource _ = True+isBuiltLocally DependenciesFromStore elab = elabLocalToProject elab || elabBuildStyle elab /= BuildAndInstall +-- | The package of a plan node that is not a package of GHC's. One that is+-- already in the cabal store has been 'Installed', so is not 'Configured',+-- but its source is what buck2 builds with @--source-deps@.+planElab :: InstallPlan.GenericPlanPackage ipkg srcpkg -> Maybe srcpkg+planElab (InstallPlan.Configured spkg) = Just spkg+planElab (InstallPlan.Installed spkg) = Just spkg+planElab InstallPlan.PreExisting{} = Nothing++-- | The packages that buck2 builds from source: those 'isBuiltLocally' says+-- it does, that the project's packages need to be built or to be built+-- with. A package that is only a dependency of a package's @Setup.hs@+-- (@setup-depends@) is not needed, as nothing here runs a @Setup.hs@.+builtLocalElabs :: DependencyMode -> ElaboratedInstallPlan -> [ElaboratedConfiguredPackage]+builtLocalElabs mode plan =+  [ elab+  | Just elab <- map planElab (InstallPlan.toList plan)+  , isBuiltLocally mode elab+  , elabUnitId elab `Set.member` needed+  ]+  where+    needed = closure Set.empty [elabUnitId elab | Just elab <- map planElab (InstallPlan.toList plan), elabLocalToProject elab]+    closure seen [] = seen+    closure seen (uid : rest)+      | uid `Set.member` seen = closure seen rest+      | otherwise = case InstallPlan.lookup plan uid >>= planElab of+          Just elab ->+            closure (Set.insert uid seen) (libDependencies elab ++ elabOrderExeDependencies elab ++ rest)+          _ -> closure (Set.insert uid seen) rest+    -- Not 'elabOrderLibDependencies', which for a package that is elaborated+    -- as a whole (one with a @Custom@ build type) also has the dependencies+    -- of its @Setup.hs@.+    libDependencies elab = [newSimpleUnitId (confInstId dep) | (dep, _) <- elabLibDependencies elab]++-- | The packages (and what they need) that a @SetupHooks.hs@ of a package that+-- buck2 builds from source needs. They are not built by buck2: cabal builds+-- them, into its store, and the hooks are run from there.+setupDependencyUnits :: DependencyMode -> ElaboratedInstallPlan -> Set.Set UnitId+setupDependencyUnits mode plan =+  Set.fromList+    [ installedUnitId dep+    | elab <- builtLocalElabs mode plan+    , PD.buildType (elabPkgDescription elab) == PD.Hooks+    , dep <- InstallPlan.dependencyClosure plan [newSimpleUnitId (confInstId cid) | (cid, _) <- elabSetupDependencies elab]+    , -- GHC's own packages stay available.+      isJust (planElab dep)+    ]++-- | The packages that the packages buck2 builds from source need to be built+-- and linked, as the libraries and tools they depend on, and what those+-- need. The setup scripts that cabal runs to build other packages (and+-- what they need) are not among them, and having them would mean more than+-- one version of some packages.+prebuiltUnits :: DependencyMode -> ElaboratedInstallPlan -> Set.Set UnitId+prebuiltUnits mode plan = closure Set.empty (concatMap deps (builtLocalElabs mode plan))+  where+    deps elab = [newSimpleUnitId (confInstId dep) | (dep, _) <- elabLibDependencies elab] ++ elabOrderExeDependencies elab+    closure seen [] = seen+    closure seen (uid : rest)+      | uid `Set.member` seen = closure seen rest+      | otherwise = closure (Set.insert uid seen) (next uid ++ rest)+    next uid = case InstallPlan.lookup plan uid of+      Just (InstallPlan.PreExisting ipkg) -> installedDepends ipkg+      Just pkg | Just elab <- planElab pkg -> deps elab+      _ -> []++-- | How the dependencies of the project are built.+data DependencyMode+  = -- | By cabal, into its store, which the buck2 build then uses.+    DependenciesFromStore+  | -- | By buck2, like the project's own packages.+    DependenciesFromSource+  deriving (Eq)+ -- | Real on-disk source directory for any package buck2 builds from -- source - a genuinely local one (always 'LocalUnpackedPackage') or an -- inplace non-local one, resolved the same way@@ -89,41 +187,148 @@   ElabComponent _ -> maybeToList (elabComponentName elab)   ElabPackage _ -> [componentName comp | comp <- PD.pkgBuildableComponents pkgDesc] --- | The source directory and (whole-package) 'PackageDescription' of every--- package buck2 builds from source. Per-component elaboration gives each--- such package one 'ElaboratedConfiguredPackage' per component, all+-- | A package that buck2 builds from source.+data BuiltPackage = BuiltPackage+  { bpDir :: FilePath+  , bpDescription :: PackageDescription+  -- ^ Of the whole package.+  , bpInProject :: Bool+  -- ^ A package of the project, as opposed to a dependency that is built+  -- like one.+  }++-- | Every package buck2 builds from source. Per-component elaboration gives+-- each such package one 'ElaboratedConfiguredPackage' per component, all -- sharing the same directory and 'PackageDescription', so there is one -- entry per directory here.-builtLocalPackages :: Verbosity -> DistDirLayout -> ElaboratedInstallPlan -> IO [(FilePath, PackageDescription)]-builtLocalPackages verbosity distDirLayout plan =-  fmap (nubBy ((==) `on` fst)) . sequenceA $-    [ do-      dir <- packageSourceDir verbosity distDirLayout elab-      return (dir, elabPkgDescription elab)-    | InstallPlan.Configured elab <- InstallPlan.toList plan-    , isBuiltLocally elab+builtLocalPackages :: Verbosity -> DependencyMode -> DistDirLayout -> ElaboratedInstallPlan -> IO [BuiltPackage]+builtLocalPackages verbosity mode distDirLayout plan = do+  pkgs <-+    fmap (nubBy ((==) `on` bpDir)) . sequenceA $+      [ do+        dir <- packageSourceDir verbosity distDirLayout elab+        return BuiltPackage{bpDir = dir, bpDescription = elabPkgDescription elab, bpInProject = elabLocalToProject elab}+      | elab <- builtLocalElabs mode plan+      ]+  -- Everything that refers to a package does so by its name (a dependency in+  -- a .cabal file is one), so two versions of one package can't both be+  -- built: a component would be given the wrong one.+  let versionsOf = Map.fromListWith (++) [(PD.package (bpDescription pkg), [bpDir pkg]) | pkg <- pkgs]+      byName = Map.fromListWith (++) [(packageName pkgId, [pkgId]) | pkgId <- Map.keys versionsOf]+      duplicates = [map prettyShow ids | ids@(_ : _ : _) <- Map.elems byName]+  unless (null duplicates) $+    die' verbosity $+      unlines $+        "cabal buck2: the build plan needs more than one version of some packages, which --source-deps can't build:"+          : ["  " ++ intercalate ", " ids | ids <- duplicates]+  removeStaleSources verbosity distDirLayout (map bpDir pkgs)+  return pkgs++-- | Remove the unpacked sources of packages that an earlier run built with+-- buck2 but this one doesn't: their generated @BUCK@ files would otherwise+-- still be part of @//...@, referring to packages that are no longer there.+removeStaleSources :: Verbosity -> DistDirLayout -> [FilePath] -> IO ()+removeStaleSources verbosity distDirLayout current = do+  let root = distUnpackedSrcRootDirectory distDirLayout+  rootExists <- doesDirectoryExist root+  when rootExists $ do+    entries <- map (root </>) <$> listDirectory root+    for_ entries $ \dir -> do+      generated <- doesFileExist (dir </> "BUCK.cabal.bzl")+      when (generated && dir `notElem` current) $ do+        info verbosity $ "cabal buck2: removing " ++ dir ++ ", which is no longer in the build plan"+        removeDirectoryRecursive dir++-- | The target of an executable, test-suite or benchmark, given the suffix for+-- its kind. Cabal allows one to have the name of its package, which is also+-- the name of the target of the package's main library.+nonLibraryTargetName :: String -> PackageDescription -> UnqualComponentName -> String+nonLibraryTargetName suffix desc component+  | name == unPackageName (packageName desc) && isJust (PD.library desc) = name ++ suffix+  | otherwise = name+  where+    name = unUnqualComponentName component++-- | A directory relative to the project root, @.@ for the root itself.+rootRelativeDir :: FilePath -> FilePath -> FilePath+rootRelativeDir projectRoot dir = case makeRelative projectRoot dir of+  "" -> "."+  rel -> rel++-- | A preprocessor that buck2 builds, as the target that is the executable+-- and the one that holds the files it reads when it runs (its templates).+data ToolTarget = ToolTarget+  { toolLabel :: String+  , toolData :: Maybe (String, String)+  -- ^ The environment variable the tool finds its data directory by, and+  -- the target that is that directory.+  }++-- | The targets of @alex@ and @happy@, when they are among the packages built+-- from source: the rules that preprocess @.x@ and @.y@ files run those+-- instead of one in the cabal store.+localToolTargets :: FilePath -> [BuiltPackage] -> Map String ToolTarget+localToolTargets projectRoot pkgs =+  Map.fromList+    [ (tool, ToolTarget{toolLabel = label pkg (nonLibraryTargetName "-exe" desc (PD.exeName exe)), toolData = dataFor (packageName desc : map depPkgName (PD.targetBuildDepends (PD.buildInfo exe)))})+    | pkg <- pkgs+    , let desc = bpDescription pkg+    , tool <- ["alex", "happy"]+    , prettyShow (packageName desc) == tool+    , exe <- take 1 [e | e <- PD.executables desc, unUnqualComponentName (PD.exeName e) == tool]     ]+  where+    label pkg name = "//" ++ dirPart (rootRelativeDir projectRoot (bpDir pkg)) ++ ":" ++ name+    dirPart dir = if dir == "." then "" else dir+    -- The tool's templates are the data files of its own package or, as+    -- with happy, of the library it is the front end of.+    dataFor names =+      listToMaybe+        [ (map underscore name ++ "_datadir", label pkg (name ++ "-data"))+        | pkg <- pkgs+        , let desc = bpDescription pkg+              name = prettyShow (packageName desc)+        , not (null (PD.dataFiles desc))+        , packageName desc `elem` names+        ]+    underscore c = if c == '-' then '_' else c +-- | The executable of each package built from source that some component+-- needs as a @build-tool-depends:@, with its target. These are also given the+-- name that such a tool has when it is installed (see "Prebuilt"), which is+-- what a hand-written rule refers to.+localBuildTools :: FilePath -> [BuiltPackage] -> Map String String+localBuildTools projectRoot pkgs =+  Map.fromList+    [ (name, "root//" ++ dirPart (rootRelativeDir projectRoot (bpDir pkg)) ++ ":" ++ nonLibraryTargetName "-exe" desc (PD.exeName exe))+    | pkg <- pkgs+    , let desc = bpDescription pkg+    , exe <- PD.executables desc+    , let name = unUnqualComponentName (PD.exeName exe)+    , (packageName desc, PD.exeName exe) `elem` wantedBuildTools pkgs+    ]+  where+    dirPart dir = if dir == "." then "" else dir+ -- | Every @pkg:exe@ named in any component's @build-tool-depends:@ across -- the given packages.-wantedBuildTools :: [(FilePath, PackageDescription)] -> [(PackageName, UnqualComponentName)]+wantedBuildTools :: [BuiltPackage] -> [(PackageName, UnqualComponentName)] wantedBuildTools pkgs =   ordNub     [ (pn, exeName)-    | (_dir, pkgDesc) <- pkgs-    , comp <- PD.pkgBuildableComponents pkgDesc+    | pkg <- pkgs+    , comp <- PD.pkgBuildableComponents (bpDescription pkg)     , ExeDependency pn exeName _ <- PD.buildToolDepends (componentBuildInfo comp)     ]  -- | The project's @test-options:@ for each test-suite that has any - only -- the elaborated package knows them (they aren't part of the @.cabal@ file -- or the 'LocalBuildInfo').-projectTestOptions :: ElaboratedInstallPlan -> Map (PackageName, ComponentName) [PathTemplate]-projectTestOptions plan =+projectTestOptions :: DependencyMode -> ElaboratedInstallPlan -> Map (PackageName, ComponentName) [PathTemplate]+projectTestOptions mode plan =   Map.fromList     [ ((packageName elab, cname), elabTestTestOptions elab)-    | InstallPlan.Configured elab <- InstallPlan.toList plan-    , isBuiltLocally elab+    | elab <- builtLocalElabs mode plan     , not (null (elabTestTestOptions elab))     , cname@CTestName{} <- componentNamesFor elab (elabPkgDescription elab)     ]
src/Distribution/Client/Buck2/Prebuilt.hs view
@@ -30,6 +30,7 @@ import Data.Char (isHexDigit) import Data.List (stripPrefix) import qualified Data.Map as Map+import qualified Data.Set as Set  import System.Directory   ( createDirectoryIfMissing@@ -90,11 +91,13 @@       , sourceLibName       )   )-import Distribution.Types.PackageName (PackageName)+import Distribution.Types.LibraryName (LibraryName (LMainLibName, LSubLibName))+import Distribution.Types.PackageName (PackageName, unPackageName) import Distribution.Types.UnitId (UnitId, unUnitId) import Distribution.Types.UnqualComponentName (UnqualComponentName, unUnqualComponentName) -import Distribution.Client.Buck2.Generate (libTargetName)+import Distribution.Client.Buck2.Fingerprint (ccFingerprint, ghcFingerprint)+import Distribution.Client.Buck2.LocalPackages (ToolTarget (..), planElab) import Distribution.Client.Buck2.Starlark  -- | Generate\/refresh @third-party\/haskell@ from the dependency closure@@ -135,12 +138,18 @@   -- "Distribution.Client.Buck2.Generate" instead, and are excluded from   -- this plan before it's even built. So every unit id here is either a   -- GHC global\/boot package or one installed to the cabal store.+  -> Set UnitId+  -- ^ The packages that buck2 needs (see 'prebuiltUnits'), from those in the plan.+  -> Map String ToolTarget+  -- ^ The preprocessors (@alex@, @happy@) that buck2 builds itself.+  -> Map String String+  -- ^ The tools that buck2 builds itself (see 'localBuildTools').   -> [(PackageName, UnqualComponentName)]   -- ^ Every @pkg:exe@ named in any local component's own   -- @build-tool-depends:@, across the whole project - see this   -- function's own return-value haddock above.   -> IO (Set String, [InstalledPackageInfo])-generatePrebuilt verbosity projectRoot cabalDirLayout shared depsPlan wantedBuildTools = do+generatePrebuilt verbosity projectRoot cabalDirLayout shared depsPlan neededUnits toolTargets localTools wantedBuildTools = do   ghcProg <-     maybe (die' verbosity "cabal buck2: no 'ghc' program configured for this project - internal error.") return $       lookupProgram ghcProgram (pkgConfigCompilerProgs shared)@@ -156,7 +165,7 @@   globalDB <- getGlobalPackageDB verbosity ghcProg   let globalRootAbs = takeDirectory globalDB -      allUnitIds = ordNub [installedUnitId pkg | pkg <- InstallPlan.toList depsPlan]+      allUnitIds = ordNub [installedUnitId pkg | pkg <- InstallPlan.toList depsPlan, installedUnitId pkg `Set.member` neededUnits]       paths =         RepoPaths           { rpGhcVersion = ghcVersionStr@@ -203,9 +212,11 @@   removeStaleStoreDB (targetDir </> "store-db")    notice verbosity "cabal buck2: generating third-party/haskell/BUCK"-  writeBuckFile targetDir paths packages buildToolPaths+  writeBuckFile targetDir paths packages buildToolPaths localTools -  writeToolsFile targetDir ghcVersionStr ghcDynamic alexPath happyPath+  fingerprint <- ghcFingerprint compiler globalDB+  ccPrint <- ccFingerprint compiler+  writeToolsFile targetDir ghcVersionStr fingerprint ccPrint ghcDynamic toolTargets alexPath happyPath    return (Map.keysSet buildToolPaths, map rpInfo packages) @@ -378,8 +389,8 @@   exists <- doesPathExist dir   when exists $ removeDirectoryRecursive dir -writeBuckFile :: FilePath -> RepoPaths -> [ResolvedPackage] -> Map String FilePath -> IO ()-writeBuckFile targetDir paths packages buildToolPaths =+writeBuckFile :: FilePath -> RepoPaths -> [ResolvedPackage] -> Map String FilePath -> Map String String -> IO ()+writeBuckFile targetDir paths packages buildToolPaths localTools =   writeFile (targetDir </> "BUCK") (renderFile header [] calls)   where     header = "@generated by `cabal buck2` - do not edit by hand.\nRe-run `cabal buck2` to update."@@ -387,6 +398,9 @@     calls =       [prebuiltCall paths uidToTarget p | p <- packages]         ++ [buildToolExportCall name relPath | (name, relPath) <- Map.toList (Map.mapMaybe (toRepoRelative paths) buildToolPaths)]+        ++ [ call "alias" [("name", str (name ++ "-exe")), ("actual", str label), ("visibility", strList ["PUBLIC"])]+           | (name, label) <- Map.toList localTools+           ]  -- | One @export_file()@ per resolved @build-tool-depends@ executable - -- gives it a real buck2 target ('DefaultInfo' with a single default@@ -411,21 +425,17 @@     , ("visibility", strList ["PUBLIC"])     ] --- | Unlike a local package (one @haskell_library()@ per library, main or--- named sub-library alike - see 'libTargetName'), a *prebuilt* one used--- to get exactly one @haskell_prebuilt_library()@ per package name,--- regardless of how many of its libraries were actually in the--- dependency closure - a real bug, not just a theoretical gap: a package--- with an internal sub-library (e.g. @attoparsec@'s own--- @attoparsec-internal@) resolves to *two* units here, and buck2--- rejected the second @haskell_prebuilt_library()@ outright as a--- duplicate target the first time this was tried against a real,--- large project. 'sourceLibName' (parsed straight from the @.conf@,--- the exact same 'LibraryName' a local package's own 'libName' would--- give) is what 'libTargetName' needs to tell them apart, the same way--- it already does for local packages.+-- | The target of a prebuilt library: the package name for its main library,+-- and for a named one the package name too, as the name of a library is+-- only unique within its package (see 'sourceLibName', which is parsed+-- from the @.conf@ file). targetName :: ResolvedPackage -> String-targetName p = libTargetName (packageName (rpInfo p)) (sourceLibName (rpInfo p))+targetName p = case sourceLibName (rpInfo p) of+  LMainLibName -> unPackageName (packageName (rpInfo p))+  -- Named libraries of different packages share their names (@testlib@ is+  -- common), and all of these targets are in one place. A package name can't+  -- contain two hyphens in a row.+  LSubLibName n -> unPackageName (packageName (rpInfo p)) ++ "--" ++ unUnqualComponentName n  prebuiltCall :: RepoPaths -> Map UnitId String -> ResolvedPackage -> Call prebuiltCall paths uidToTarget p =@@ -483,7 +493,7 @@   listToMaybe     [ rel     | pkg <- InstallPlan.toList plan-    , Just elab <- [configuredOrInstalled pkg]+    , Just elab <- [planElab pkg]     , prettyShow (packageName elab) == toolName     , let absPath = InstallDirs.bindir (elabInstallDirs elab) </> toolName <.> exeExtension (pkgConfigPlatform shared)     , Just rel <- [toRepoRelative paths absPath]@@ -518,41 +528,39 @@     candidates =       [ elab       | pkg <- InstallPlan.toList plan-      , Just elab <- [configuredOrInstalled pkg]+      , Just elab <- [planElab pkg]       , packageName elab == pn       ]     binPathFor elab = InstallDirs.bindir (elabInstallDirs elab) </> unUnqualComponentName exeName <.> exeExtension (pkgConfigPlatform shared)     exact = [binPathFor elab | elab <- candidates, elabComponentName elab == Just (CExeName exeName)]     fallback = [binPathFor elab | elab <- candidates] --- | Same package, in either of the two states a *non-local* dependency--- that's actually going to be used can be in: 'Configured' (needs--- building this run) or 'Installed' (already built and installed from a--- previous run, nothing to do - which is what alex/happy settle into on--- any @cabal buck2@ after the first, once their build is cached). Unlike--- 'installedUnitId' (a 'HasUnitId' method, already defined uniformly--- across all three 'GenericPlanPackage' constructors), there's no--- existing helper for this, since most other call sites here only need--- the unit id, not the full 'ElaboratedConfiguredPackage'.-configuredOrInstalled :: InstallPlan.GenericPlanPackage ipkg srcpkg -> Maybe srcpkg-configuredOrInstalled (InstallPlan.Configured spkg) = Just spkg-configuredOrInstalled (InstallPlan.Installed spkg) = Just spkg-configuredOrInstalled InstallPlan.PreExisting{} = Nothing- inStore :: Maybe FilePath -> Bool inStore = maybe False ("cabal-store" `isPrefixOf`) -writeToolsFile :: FilePath -> String -> Bool -> Maybe FilePath -> Maybe FilePath -> IO ()-writeToolsFile targetDir ghcVersionStr ghcDynamic alexPath happyPath =+writeToolsFile :: FilePath -> String -> String -> String -> Bool -> Map String ToolTarget -> Maybe FilePath -> Maybe FilePath -> IO ()+writeToolsFile targetDir ghcVersionStr fingerprint ccPrint ghcDynamic toolTargets alexPath happyPath =   writeFile (targetDir </> "tools.bzl") $     unlines       [ "# @generated by `cabal buck2` - do not edit by hand."       , "# Re-run `cabal buck2` to update."       , ""       , "GHC_VERSION = " ++ show ghcVersionStr+      , "GHC_FINGERPRINT = " ++ show fingerprint+      , "CC_FINGERPRINT = " ++ show ccPrint       , "GHC_BIN_DIR = \"third-party/haskell/ghc-bin\""       , "GHC_DYNAMIC = " ++ (if ghcDynamic then "True" else "False")       , ""       , "ALEX = " ++ show ("third-party/haskell/" ++ fromMaybe "missing" alexPath)       , "HAPPY = " ++ show ("third-party/haskell/" ++ fromMaybe "missing" happyPath)+      , ""+      , "# If buck2 builds them, the targets of the tools and of their data files."+      , "ALEX_TARGET = " ++ starlarkMaybe (toolLabel <$> Map.lookup "alex" toolTargets)+      , "ALEX_DATA = " ++ starlarkMaybe (snd <$> (Map.lookup "alex" toolTargets >>= toolData))+      , "ALEX_DATA_ENV = " ++ starlarkMaybe (fst <$> (Map.lookup "alex" toolTargets >>= toolData))+      , "HAPPY_TARGET = " ++ starlarkMaybe (toolLabel <$> Map.lookup "happy" toolTargets)+      , "HAPPY_DATA = " ++ starlarkMaybe (snd <$> (Map.lookup "happy" toolTargets >>= toolData))+      , "HAPPY_DATA_ENV = " ++ starlarkMaybe (fst <$> (Map.lookup "happy" toolTargets >>= toolData))       ]+  where+    starlarkMaybe = maybe "None" show
src/Distribution/Client/Buck2/Setup.hs view
@@ -7,26 +7,61 @@ import Distribution.Client.Compat.Prelude import Prelude () +import Data.List (stripPrefix) import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath ((</>))  import Distribution.Simple.Utils (die', notice) +import Distribution.Client.Buck2.Version (cabalBuck2Version) --- | Check that the @buck2@ support code is at @buck2\/@++-- | Check that the @buck2@ support code is at @buck2\/@, and that it is for+-- this release of @cabal-buck2@: the files it generates are only understood by+-- the same release of it, which is a branch of that name. checkBuck2Prelude :: Verbosity -> FilePath -> IO () checkBuck2Prelude verbosity projectRoot = do-  exists <- doesDirectoryExist (projectRoot </> "buck2")+  exists <- doesDirectoryExist buck2Dir   unless exists $     die' verbosity $       unlines         [ "No 'buck2/' directory found in the project root."         , "Clone the buck2 prelude and support scripts with:"         , ""-        , "    git clone https://github.com/simonmar/haskell-buck2 buck2"+        , "    git clone --branch " ++ cabalBuck2Version ++ " https://github.com/simonmar/haskell-buck2 buck2"         , ""         , "then re-run 'cabal buck2'."         ]+  found <- readBuck2Version buck2Dir+  case found of+    Just v | v == cabalBuck2Version -> return ()+    _ ->+      die' verbosity $+        unlines+          [ "The 'buck2/' directory is not for this release of cabal-buck2."+          , ""+          , "This is cabal-buck2 " ++ cabalBuck2Version ++ ", and buck2/ is for " ++ maybe "no release (it is from an earlier one)" ("cabal-buck2 " ++) found ++ "."+          , ""+          , "cabal-buck2 " ++ cabalBuck2Version ++ " needs the " ++ cabalBuck2Version ++ " branch of https://github.com/simonmar/haskell-buck2. If buck2/ is a git checkout, switch it with:"+          , ""+          , "    git -C buck2 fetch && git -C buck2 checkout " ++ cabalBuck2Version+          , ""+          , "or use the cabal-buck2 release that matches the buck2/ you have."+          ]+  where+    buck2Dir = projectRoot </> "buck2"++-- | The release of @cabal-buck2@ that a checkout of @haskell-buck2@ is for,+-- from its @version.bzl@ (@CABAL_BUCK2_VERSION = "..."@).+readBuck2Version :: FilePath -> IO (Maybe String)+readBuck2Version buck2Dir = do+  let path = buck2Dir </> "version.bzl"+  exists <- doesFileExist path+  if not exists+    then return Nothing+    else do+      contents <- readFile path+      return $ listToMaybe [takeWhile (/= '"') rest | l <- lines contents, Just rest <- [stripPrefix "CABAL_BUCK2_VERSION = \"" l]]  -- | Copy @.buckconfig@ and @PACKAGE@ if they don't exist ensureBuckconfigAndPackage :: Verbosity -> FilePath -> IO ()
src/Distribution/Client/Buck2/Spec.hs view
@@ -3,32 +3,32 @@ -- "Distribution.Client.Buck2.Write" writes the spec into the -- @BUCK.cabal.bzl@ file. module Distribution.Client.Buck2.Spec-  ( specSchemaVersion-  , BuildSpec (..)+  ( BuildSpec (..)   , ComponentKind (..)   , kindName   , SpecComponent (..)   , Src (..)   , SpecDep (..)+  , SpecReexport (..)   , SpecBuildTool (..)   ) where  import Distribution.Client.Compat.Prelude import Prelude () --- | The version of the build spec format; must match @SCHEMA_VERSION@ in--- buck2\/cabal.bzl.-specSchemaVersion :: Int-specSchemaVersion = 1- -- | A package's build spec: everything the generated rules are built from -- that comes from Cabal rather than from buck2 conventions. data BuildSpec = BuildSpec   { specPackageName :: String+  , specPackageVersion :: String   , specPackageDir :: FilePath   -- ^ Relative to the buck2 cell root, @.@ at the root.   , specGhcOptions :: [String]   -- ^ Supplied by the project, not the @.cabal@ file.+  , specDataDir :: FilePath+  -- ^ The package's @data-dir@, relative to its directory.+  , specDataFiles :: [FilePath]+  -- ^ Its @data-files@, as patterns, relative to 'specDataDir'.   , specComponents :: [SpecComponent]   } @@ -48,6 +48,8 @@ data SpecComponent = SpecComponent   { scKind :: ComponentKind   , scName :: String+  , scExeName :: Maybe String+  -- ^ The name of an executable, when it isn't the name of its target.   -- ^ Also the name of the buck2 target.   , scMainIs :: Maybe Src   -- ^ The main module's source; not for a library.@@ -62,11 +64,25 @@   , scExtensions :: [String]   , scExtraLibraries :: [String]   , scDeps :: [SpecDep]+  , scReexports :: [SpecReexport]+  -- ^ Modules a library re-exports from the library of another package (or+  -- another library of its own).   , scBuildTools :: [SpecBuildTool]   , scCSources :: [FilePath]+  , scCcOptions :: [String]   , scCxxSources :: [FilePath]   , scCxxOptions :: [String]+  , scCmmSources :: [FilePath]+  , scAsmSources :: [FilePath]+  , scAsmOptions :: [String]   , scIncludeDirs :: [FilePath]+  , scHscOptions :: [String]+  -- ^ Defines for the C compiler of @hsc2hs@, which say what the code is+  -- compiled for (GHC does this itself for Haskell code).+  , scGeneratedIncludeDirs :: [FilePath]+  -- ^ Directories, relative to the project root, with headers that the+  -- package's @configure@ script generated (the build directory's version of+  -- each relative 'scIncludeDirs').   , scPkgconfig :: [String]   } @@ -84,6 +100,16 @@   , depDir :: Maybe FilePath   -- ^ The package's directory (relative to the cell root) if it's built by   -- this project.+  }++-- | A module that a library re-exports (@reexported-modules@) from a library+-- it depends on.+data SpecReexport = SpecReexport+  { reModule :: String+  , reOriginal :: String+  , reFrom :: Maybe SpecDep+  -- ^ The library of another package or of its own that has the module, or+  -- none if it is one of the library's own.   }  -- | An executable that a component's @build-tool-depends@ needs on @PATH@.
+ src/Distribution/Client/Buck2/Version.hs view
@@ -0,0 +1,15 @@+-- | The release of @cabal-buck2@, which the checkout of @haskell-buck2@ (in+-- @buck2\/@) has to be for: it has a branch for each release.+module Distribution.Client.Buck2.Version+  ( cabalBuck2Version+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++import Data.Version (showVersion)++import qualified Paths_cabal_buck2++cabalBuck2Version :: String+cabalBuck2Version = showVersion Paths_cabal_buck2.version
src/Distribution/Client/Buck2/Write.hs view
@@ -6,32 +6,31 @@ import Distribution.Client.Compat.Prelude import Prelude () +import Data.List (stripPrefix) import System.Directory (createDirectoryIfMissing, doesFileExist)-import System.FilePath (makeRelative, takeDirectory, takeFileName, (</>))+import System.FilePath (takeDirectory, takeFileName, (</>))  import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Distribution.ModuleName as ModuleName import Distribution.Package (packageName) import Distribution.PackageDescription-  ( Library (exposedModules, reexportedModules)-  , PackageDescription-  , library+  ( libName+  , pkgBuildableComponents   ) import Distribution.Simple.InstallDirs (PathTemplate)+import Distribution.Types.Component (Component (CLib)) import Distribution.Types.ComponentName (ComponentName) import Distribution.Types.LocalBuildInfo (LocalBuildInfo)-import Distribution.Types.ModuleReexport-  ( ModuleReexport (moduleReexportOriginalName, moduleReexportOriginalPackage)-  ) import Distribution.Types.PackageName (PackageName) -import Distribution.Simple.Utils (notice, ordNub, warn)+import Distribution.Simple.Utils (die', notice, warn)  import Distribution.Client.Buck2.Generate+import Distribution.Client.Buck2.LocalPackages (BuiltPackage (..), rootRelativeDir) import Distribution.Client.Buck2.Spec import Distribution.Client.Buck2.Starlark+import Distribution.Client.Buck2.Version (cabalBuck2Version)  -- | Writes the following files for each package: --@@ -50,71 +49,71 @@ --   * @cabal-buck2\/autogen\/BUCK@ (see 'writeAutogenBuck') has --     @export_file()@ rules for the autogen files, so they can be --     easily referenced from anywhere else.-writeAllPackages :: Verbosity -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> [(FilePath, PackageDescription)] -> IO ()-writeAllPackages verbosity projectRoot componentLBIs externalBuildTools projectTestOptions pkgs = do-  traverse_ (writeOnePackage verbosity localIndex projectRoot componentLBIs externalBuildTools projectTestOptions) pkgs+writeAllPackages :: Verbosity -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> [BuiltPackage] -> Bool -> IO ()+writeAllPackages verbosity projectRoot componentLBIs externalBuildTools projectTestOptions pkgs keepGoing = do+  sources <- traverse (\pkg -> Set.fromList <$> filterM (doesFileExist . (bpDir pkg </>)) (sourceCandidates (bpDescription pkg))) pkgs+  let generateAll skipped = [generate skipped pkg srcs | (pkg, srcs) <- zip pkgs sources]+      -- A library without a rule makes the components that depend on it+      -- skipped, and a library among those makes more of them skipped, so+      -- this goes on until nothing changes.+      fixpoint skipped =+        let results = generateAll skipped+            skipped' = skipped <> Set.fromList (concat [librariesWithoutRule pkg r | (pkg, r) <- zip pkgs results])+         in if skipped' == skipped then results else fixpoint skipped'+  let results = zip pkgs (fixpoint Set.empty)+      problems = concat [warnings | (_, (_, warnings)) <- results]+  unless (null problems) $+    if keepGoing+      then traverse_ (warn verbosity) problems+      else+        die' verbosity $+          unlines $+            ["cabal buck2: some components can't be built with buck2:"]+              ++ map (("  " ++) . withoutPrefix) problems+              ++ ["Use --keep-going to generate everything else anyway."]+  traverse_ (writeOnePackage verbosity projectRoot) results   where+    generate skipped pkg srcs =+      generatePackageTargets localIndex projectRoot (rootRelativeDir projectRoot (bpDir pkg)) componentLBIs externalBuildTools projectTestOptions srcs skipped (bpInProject pkg) (bpDescription pkg)++    librariesWithoutRule pkg (targets, _) =+      [ (packageName desc, libName lib)+      | CLib lib <- pkgBuildableComponents desc+      , not (any (\c -> scKind c == Library && scName c == libTargetName (packageName desc) (libName lib)) (specComponents (ptSpec targets)))+      ]+      where+        desc = bpDescription pkg+     localIndex :: LocalPackageIndex     localIndex =       Map.fromList-        [ (packageName pkgDesc, (rootRelativeDir projectRoot pkgDir, reexportOrigins pkgDesc))-        | (pkgDir, pkgDesc) <- pkgs-        ]-    -- Every module exposed by any local package's main library, to-    -- resolve a `reexported-modules:` entry that names only the bare-    -- module, not an explicit `origin-package:Module` - Cabal itself-    -- resolves that form by searching the reexporting package's own-    -- build-depends for whichever one actually defines it, which for a-    -- \*local* origin this index can do too (an external origin doesn't-    -- need this: its real .conf file already declares the reexport-    -- directly to ghc-pkg).-    moduleOwners :: Map.Map ModuleName.ModuleName PackageName-    moduleOwners =-      Map.fromList-        [ (m, packageName pkgDesc)-        | (_, pkgDesc) <- pkgs-        , Just lib <- [library pkgDesc]-        , m <- exposedModules lib-        ]-    reexportOrigins pkgDesc =-      ordNub-        [ pn-        | Just lib <- [library pkgDesc]-        , reexport <- reexportedModules lib-        , Just pn <- [originPackage reexport]-        , pn /= packageName pkgDesc+        [ (packageName pkgDesc, LocalPackage{lpDir = rootRelativeDir projectRoot (bpDir pkg), lpDescription = pkgDesc})+        | pkg <- pkgs+        , let pkgDesc = bpDescription pkg         ]-    originPackage reexport = case moduleReexportOriginalPackage reexport of-      Just pn -> Just pn-      Nothing -> Map.lookup (moduleReexportOriginalName reexport) moduleOwners -rootRelativeDir :: FilePath -> FilePath -> FilePath-rootRelativeDir projectRoot pkgDir = case makeRelative projectRoot pkgDir of-  "" -> "."-  rel -> rel+withoutPrefix :: String -> String+withoutPrefix = fromMaybe <*> stripPrefix "cabal buck2: " -writeOnePackage :: Verbosity -> LocalPackageIndex -> FilePath -> Map (PackageName, ComponentName) LocalBuildInfo -> Set String -> Map (PackageName, ComponentName) [PathTemplate] -> (FilePath, PackageDescription) -> IO ()-writeOnePackage verbosity localIndex projectRoot componentLBIs externalBuildTools projectTestOptions (pkgDir, pkgDesc) = do-  sources <- Set.fromList <$> filterM (doesFileExist . (pkgDir </>)) (sourceCandidates pkgDesc)-  let (mtargets, warnings) = generatePackageTargets localIndex (rootRelativeDir projectRoot pkgDir) componentLBIs externalBuildTools projectTestOptions sources pkgDesc-      pkgName = packageName pkgDesc-  traverse_ (warn verbosity) warnings-  case mtargets of-    Nothing -> warn verbosity $ "cabal buck2: no buck2 targets generated for package " ++ show pkgName-    Just targets -> do-      let bzlPath = pkgDir </> "BUCK.cabal.bzl"-          buckPath = pkgDir </> "BUCK"-      writeFile bzlPath (renderGeneratedBzl pkgName (ptSpec targets))-      buckExists <- doesFileExist buckPath-      unless buckExists $ writeFile buckPath renderBuckWrapper-      writeAutogenBuck pkgDir pkgName targets-      notice verbosity $-        "cabal buck2: generated "-          ++ (rootRelativeDir projectRoot pkgDir </> "BUCK.cabal.bzl")-          ++ " ("-          ++ show (ptComponentCount targets)-          ++ " component(s))"-          ++ (if buckExists then "" else ", created " ++ (rootRelativeDir projectRoot pkgDir </> "BUCK"))+writeOnePackage :: Verbosity -> FilePath -> (BuiltPackage, (PackageTargets, [String])) -> IO ()+writeOnePackage verbosity projectRoot (BuiltPackage{bpDir = pkgDir, bpDescription = pkgDesc}, (targets, _)) = do+  let pkgName = packageName pkgDesc+      bzlPath = pkgDir </> "BUCK.cabal.bzl"+      buckPath = pkgDir </> "BUCK"+  traverse_ (notice verbosity) (ptNotes targets)+  when (ptComponentCount targets == 0) $+    warn verbosity $ "cabal buck2: no buck2 targets generated for package " ++ prettyShow pkgName+  writeFile bzlPath (renderGeneratedBzl pkgName (ptSpec targets))+  buckExists <- doesFileExist buckPath+  unless buckExists $ writeFile buckPath renderBuckWrapper+  writeAutogenBuck pkgDir pkgName targets+  notice verbosity $+    "cabal buck2: generated "+      ++ (rootRelativeDir projectRoot pkgDir </> "BUCK.cabal.bzl")+      ++ " ("+      ++ show (ptComponentCount targets)+      ++ " component(s))"+      ++ (if buckExists then "" else ", created " ++ (rootRelativeDir projectRoot pkgDir </> "BUCK"))  -- | Generate an @export_file()@ rule for each autogen file, so that -- the files can be easily referenced from somewhere else, including@@ -169,16 +168,20 @@ specValue :: BuildSpec -> Value specValue spec =   VDict $-    [ ("schema", VInt specSchemaVersion)-    , ("package", VDict [("name", str (specPackageName spec)), ("dir", str (specPackageDir spec))])+    [ ("cabal_buck2", str cabalBuck2Version)+    , ("package", VDict [("name", str (specPackageName spec)), ("version", str (specPackageVersion spec)), ("dir", str (specPackageDir spec))])     ]       ++ listField "ghc_options" (specGhcOptions spec)+      ++ [ ("data", VDict [("dir", str (specDataDir spec)), ("files", strList (specDataFiles spec))])+         | not (null (specDataFiles spec))+         ]       ++ [("components", VList (map componentValue (specComponents spec)))]  componentValue :: SpecComponent -> Value componentValue c =   VDict $     [("kind", str (kindName (scKind c))), ("name", str (scName c))]+      ++ [("exe_name", str exe) | Just exe <- [scExeName c]]       ++ [("main_is", srcValue src) | Just src <- [scMainIs c]]       ++ [("srcs", VDict [(m, srcValue src) | (m, src) <- scSrcs c]) | not (null (scSrcs c))]       ++ listField "test_args" (scTestArgs c)@@ -188,11 +191,18 @@       ++ listField "extensions" (scExtensions c)       ++ listField "extra_libraries" (scExtraLibraries c)       ++ valuesField "deps" (map depValue (scDeps c))+      ++ valuesField "reexports" (map reexportValue (scReexports c))       ++ valuesField "build_tools" (map buildToolValue (scBuildTools c))       ++ listField "c_sources" (scCSources c)+      ++ listField "cc_options" (scCcOptions c)       ++ listField "cxx_sources" (scCxxSources c)       ++ listField "cxx_options" (scCxxOptions c)+      ++ listField "cmm_sources" (scCmmSources c)+      ++ listField "asm_sources" (scAsmSources c)+      ++ listField "asm_options" (scAsmOptions c)       ++ listField "include_dirs" (scIncludeDirs c)+      ++ listField "hsc_options" (scHscOptions c)+      ++ listField "generated_include_dirs" (scGeneratedIncludeDirs c)       ++ listField "pkgconfig" (scPkgconfig c)  srcValue :: Src -> Value@@ -205,6 +215,9 @@     [("package", str (depPackage d))]       ++ [("library", str lib) | Just lib <- [depLibrary d]]       ++ [("dir", str dir) | Just dir <- [depDir d]]++reexportValue :: SpecReexport -> Value+reexportValue r = VDict ([("module", str (reModule r)), ("original", str (reOriginal r))] ++ [("from", depValue d) | Just d <- [reFrom r]])  buildToolValue :: SpecBuildTool -> Value buildToolValue (LocalTool exe dir) = VDict [("exe", str exe), ("dir", str dir)]
src/Distribution/Client/CmdBuck2.hs view
@@ -43,7 +43,13 @@   , defaultNixStyleFlags   , nixStyleOptions   )+import Distribution.Client.ProjectConfig (ProjectConfig (..), ProjectConfigShared (..)) import Distribution.Client.ProjectOrchestration+import Distribution.Client.Targets (UserConstraint (..), UserConstraintScope (..))+import Distribution.Solver.Types.ConstraintSource (ConstraintSource (ConstraintSourceUnknown))+import Distribution.Solver.Types.PackageConstraint (PackageProperty (PackagePropertyVersion))+import Distribution.Types.PackageName (mkPackageName)+import Distribution.Version (alterVersion, earlierVersion, intersectVersionRanges, orLaterVersion) import Distribution.Client.ScriptUtils   ( AcceptNoTargets (..)   , TargetContext (..)@@ -52,19 +58,24 @@   ) import Distribution.Client.Setup   ( GlobalFlags-  , InstallFlags (installOnlyDeps)+  , InstallFlags (installKeepGoing, installOnlyDeps)   )  import Distribution.Simple.Command (CommandUI (..), usageAlternatives)-import Distribution.Simple.Flag (toFlag)+import Distribution.Simple.Flag (fromFlagOrDefault, toFlag) import qualified Distribution.Simple.PackageIndex as PackageIndex-import Distribution.Simple.Utils (die', notice)+import Distribution.Simple.Utils (cabalVersion, die', notice) import Distribution.Verbosity (normal)  import Distribution.Client.Buck2.BuildDependencies (buildDependencies)+import Distribution.Client.Buck2.Cache (cacheSetting, configureCache) import Distribution.Client.Buck2.Configure (configureComponents)+import Distribution.Client.Buck2.Flags (Buck2Flags, buck2FlagOptions, defaultBuck2Flags, dependencyMode) import Distribution.Client.Buck2.LocalPackages   ( builtLocalPackages+  , localBuildTools+  , prebuiltUnits+  , localToolTargets   , projectTestOptions   , wantedBuildTools   )@@ -76,7 +87,7 @@ import Distribution.Client.Buck2.Write (writeAllPackages)  -- | The @cabal buck2@ CLI command-buck2Command :: CommandUI (NixStyleFlags ())+buck2Command :: CommandUI (NixStyleFlags Buck2Flags) buck2Command =   CommandUI     { commandName = "buck2"@@ -92,21 +103,40 @@           ++ "buck2/README.md for details.\n\n"           ++ "Flags that would normally be passed to `cabal build`/`cabal "           ++ "configure` (-f, --enable-profiling, --enable-tests, etc.) are "-          ++ "honoured here too, and apply to the dependency build."+          ++ "honoured here too, and apply to the dependency build.\n\n"+          ++ "A component that can't be built with buck2 is an error, unless "+          ++ "--keep-going is given: then it is skipped with a warning."     , commandNotes = Nothing-    , commandDefaultFlags = defaultNixStyleFlags ()-    , commandOptions = nixStyleOptions (const [])+    , commandDefaultFlags = defaultNixStyleFlags defaultBuck2Flags+    , commandOptions = nixStyleOptions buck2FlagOptions     } +-- | The hooks of a package with a @Hooks@ build type are run by this program,+-- through a hooks executable that has to be built with the same release of+-- Cabal. So that a package can allow older releases (to be usable with older+-- versions of cabal) it is solved for with this one.+withHooksConstraint :: ProjectBaseContext -> ProjectBaseContext+withHooksConstraint ctx =+  ctx{projectConfig = projectConfig ctx <> mempty{projectConfigShared = mempty{projectConfigConstraints = [constraint]}}}+  where+    constraint =+      ( UserConstraint+          (UserAnySetupQualifier (mkPackageName "Cabal-hooks"))+          (PackagePropertyVersion (intersectVersionRanges (orLaterVersion release) (earlierVersion (alterVersion (\v -> take 1 v ++ [v !! 1 + 1]) release))))+      , ConstraintSourceUnknown+      )+    release = alterVersion (take 2) cabalVersion+ -- | Implement @cabal buck2@-buck2Action :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()+buck2Action :: NixStyleFlags Buck2Flags -> [String] -> GlobalFlags -> IO () buck2Action flags extraArgs globalFlags = do   unless (null extraArgs) $     die' verbosity ("'cabal buck2' doesn't take any extra arguments: " ++ unwords extraArgs)+  cache <- either (die' verbosity) return (cacheSetting (extraFlags flags))    withContextAndSelectors verbosity RejectNoTargets Nothing depsFlags ["all"] globalFlags BuildCommand $     \targetCtx ctx targetSelectors -> do-      baseCtx <- case targetCtx of+      baseCtx <- withHooksConstraint <$> case targetCtx of         ProjectContext -> return ctx         GlobalContext -> return ctx         ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta@@ -114,11 +144,12 @@       let projectRoot = distProjectRootDirectory (distDirLayout baseCtx)       checkBuck2Prelude verbosity projectRoot -      buildCtx <- buildDependencies verbosity baseCtx targetSelectors+      buildCtx <- buildDependencies verbosity mode baseCtx targetSelectors        ensureBuckconfigAndPackage verbosity projectRoot+      configureCache verbosity projectRoot cache -      localPkgs <- builtLocalPackages verbosity (distDirLayout baseCtx) (elaboratedPlanOriginal buildCtx)+      localPkgs <- builtLocalPackages verbosity mode (distDirLayout baseCtx) (elaboratedPlanOriginal buildCtx)        (externalBuildTools, resolvedDeps) <-         generatePrebuilt@@ -127,19 +158,23 @@           (cabalDirLayout baseCtx)           (elaboratedShared buildCtx)           (elaboratedPlanToExecute buildCtx)+          (prebuiltUnits mode (elaboratedPlanOriginal buildCtx))+          (localToolTargets projectRoot localPkgs)+          (localBuildTools projectRoot localPkgs)           (wantedBuildTools localPkgs)        -- 'generatePrebuilt' already found and parsed every real @.conf@       -- file of the resolved dependency closure.-      componentLBIs <- configureComponents verbosity baseCtx buildCtx (PackageIndex.fromList resolvedDeps)+      componentLBIs <- configureComponents verbosity mode baseCtx buildCtx (PackageIndex.fromList resolvedDeps)        writeAllPackages         verbosity         projectRoot         componentLBIs         externalBuildTools-        (projectTestOptions (elaboratedPlanOriginal buildCtx))+        (projectTestOptions mode (elaboratedPlanOriginal buildCtx))         localPkgs+        (fromFlagOrDefault False (installKeepGoing (installFlags flags)))        notice verbosity $         unlines@@ -150,4 +185,5 @@           ]   where     verbosity = cfgVerbosity normal flags+    mode = dependencyMode (extraFlags flags)     depsFlags = flags{installFlags = (installFlags flags){installOnlyDeps = toFlag True}}
test/Main.hs view
@@ -6,10 +6,14 @@ import Control.Exception (SomeException, bracket, displayException, try) import Control.Monad (forM_, unless, when) import Data.List (isInfixOf)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Map as Map import System.Directory   ( copyFile   , createDirectoryIfMissing   , doesDirectoryExist+  , doesFileExist+  , removeFile   , findExecutable   , getTemporaryDirectory   , listDirectory@@ -19,22 +23,46 @@ import System.Exit (ExitCode (..), exitFailure) import System.FilePath ((</>)) import System.IO (hPutStrLn, stderr)-import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode, getCurrentPid)+import System.Process (CreateProcess (..), callProcess, getCurrentPid, proc, readCreateProcessWithExitCode) +import Distribution.Client.Buck2.Cache (cacheBlock, spliceBlock)+import Distribution.Client.Buck2.Fingerprint (ccFingerprintOf, fingerprintOf)+import Distribution.Client.Buck2.Version (cabalBuck2Version)+ main :: IO () main = do   exe <- maybe (fail "cabal-buck2 not found on PATH") return =<< findExecutable "cabal-buck2"   results <- mapM (runTest exe) tests-  let failures = [name | (name, False) <- zip (map fst tests) results]+  unitResults <- mapM runUnitTest unitTests+  let failures =+        [name | (name, False) <- zip (map fst tests) results]+          ++ [name | (name, False) <- zip (map fst unitTests) unitResults]   unless (null failures) $ do     hPutStrLn stderr $ "FAILED: " ++ unwords failures     exitFailure +unitTests :: [(String, IO ())]+unitTests = [("fingerprint", fingerprint), ("cc-fingerprint", ccFingerprint), ("splice-block", spliceBlockTest)]++runUnitTest :: (String, IO ()) -> IO Bool+runUnitTest (name, test) = do+  r <- try test+  case r of+    Right () -> putStrLn ("PASS " ++ name) >> return True+    Left e -> do+      hPutStrLn stderr ("FAIL " ++ name ++ ": " ++ displayException (e :: SomeException))+      return False+ tests :: [(String, Project -> IO ())] tests =   [ ("basic", basic)   , ("disabled-stanzas", disabledStanzas)   , ("missing-module", missingModule)+  , ("cache-config", cacheConfig)+  , ("source-deps", sourceDeps)+  , ("custom-setup", customSetup)+  , ("reexports", reexports)+  , ("buck2-version", buck2Version)   ]  -- | A copy of a fixture project, and how to run @cabal-buck2@ in it.@@ -60,10 +88,14 @@     -- The fixture is named after the test, except for tests that reuse one.     fixture = case name of       "disabled-stanzas" -> "basic"+      "cache-config" -> "basic"+      "buck2-version" -> "basic"       _ -> name     setup dir = do       cleanup dir       copyTree ("test" </> "fixtures" </> fixture) (dir </> "project")+      -- What a checkout of the right branch of haskell-buck2 has.+      writeBuck2Version (dir </> "project") cabalBuck2Version       env <- getEnvironment       -- The compiler to use: $HC if it's set (as haskell-ci does), otherwise       -- whatever `ghc` is on the PATH.@@ -88,6 +120,10 @@       exists <- doesDirectoryExist dir       when exists $ removeDirectoryRecursive dir +writeBuck2Version :: FilePath -> String -> IO ()+writeBuck2Version projectDir' version =+  writeFile (projectDir' </> "buck2" </> "version.bzl") ("CABAL_BUCK2_VERSION = \"" ++ version ++ "\"\n")+ copyTree :: FilePath -> FilePath -> IO () copyTree from to = do   createDirectoryIfMissing True to@@ -125,6 +161,77 @@  -- * Tests +-- | The fingerprint of the GHC installation, which keeps the buck2 action+-- cache from serving the output of a different GHC.+fingerprint :: IO ()+fingerprint = do+  let props = Map.fromList [("Project version", "9.6.7"), ("Target platform", "x86_64-unknown-linux"), ("Project Git commit id", "2b22b6ae69c94e721fde8af0108eb0feed97cc82"), ("RTS ways", "debug thr")]+      conf abi = BS8.pack ("name: base\nversion: 4.18\nabi: " ++ abi ++ "\nid: base-4.18\n")+      confs = [("base-4.18.conf", conf "aaaa"), ("ghc-prim-0.10.conf", conf "bbbb")]+      fp = fingerprintOf props confs+  -- Readable: version, platform and source commit come first.+  assertContains "fingerprint" "9.6.7-x86_64-unknown-linux-2b22b6ae-" fp+  -- It doesn't depend on the order of the files.+  assertEqual "fingerprint of reordered confs" fp (fingerprintOf props (reverse confs))+  -- It changes with the interface hash of any package, with the GHC commit,+  -- and with the build properties.+  assertDiffers "changed abi" fp (fingerprintOf props [("base-4.18.conf", conf "aaaa"), ("ghc-prim-0.10.conf", conf "cccc")])+  assertDiffers "changed commit" fp (fingerprintOf (Map.insert "Project Git commit id" "3b22b6ae69c9" props) confs)+  assertDiffers "changed RTS ways" fp (fingerprintOf (Map.insert "RTS ways" "debug thr dyn" props) confs)+  -- Properties it doesn't use don't matter.+  assertEqual "unused property" fp (fingerprintOf (Map.insert "C compiler command" "gcc" props) confs)++-- | The fingerprint of the C toolchain: GHC uses it to preprocess and link, and+-- buck2 to compile and link C and C++.+ccFingerprint :: IO ()+ccFingerprint = do+  let reports =+        [ ("target", "x86_64-pc-linux-gnu")+        , ("libc", "ldd (GNU libc) 2.39")+        , ("libstdc++", "libstdc++.so.6.0.33")+        , ("gcc", "gcc (GCC) 13.2.0")+        , ("ld", "GNU ld 2.42")+        ]+      fp = ccFingerprintOf reports+  assertContains "cc fingerprint" "x86_64-pc-linux-gnu-" fp+  assertEqual "reordered" fp (ccFingerprintOf (reverse reports))+  let changed name new = [(n, if n == name then new else v) | (n, v) <- reports]+  assertDiffers "libc" fp (ccFingerprintOf (changed "libc" "ldd (GNU libc) 2.40"))+  assertDiffers "libstdc++" fp (ccFingerprintOf (changed "libstdc++" "libstdc++.so.6.0.34"))+  assertDiffers "compiler" fp (ccFingerprintOf (changed "gcc" "gcc (GCC) 14.1.0"))+  assertDiffers "linker" fp (ccFingerprintOf (changed "ld" "GNU ld 2.43"))+  assertDiffers "target" fp (ccFingerprintOf (changed "target" "aarch64-linux-gnu"))++-- | Adding, changing and removing the block that @--cache@ puts in a config+-- file, without touching anything else in it.+spliceBlockTest :: IO ()+spliceBlockTest = do+  let user = "[cells]\n  root = .\n\n[build]\n  threads = 4\n"+      add address = spliceBlock (Just (cacheBlock address))+      once = add "grpc://a:1" user+  -- The user's part is kept, and the block comes after it.+  assertContains "added block" "[cells]\n  root = .\n\n[build]\n  threads = 4\n\n# >>> cabal buck2: cache" once+  assertContains "added block" "action_cache_address = grpc://a:1" once+  -- Doing it again changes nothing; a new address replaces the old one.+  assertEqual "idempotent" once (add "grpc://a:1" once)+  let changed = add "grpc://b:2" once+  assertContains "changed address" "action_cache_address = grpc://b:2" changed+  assertNotContains "changed address" "grpc://a:1" changed+  -- Removing it gives back the original, and removing again is a no-op.+  let removed = spliceBlock Nothing changed+  assertEqual "removed" user removed+  assertEqual "removed twice" user (spliceBlock Nothing removed)+  -- A file without a trailing newline or blocks is left alone when there is nothing to remove.+  assertEqual "nothing to remove" "[a]" (spliceBlock Nothing "[a]")+  -- Text after the block is kept too.+  assertContains "text after the block" "[later]" (add "grpc://c:3" (once ++ "[later]\n"))++assertEqual :: String -> String -> String -> IO ()+assertEqual what a b = unless (a == b) $ failure (what ++ ": " ++ show a ++ " /= " ++ show b)++assertDiffers :: String -> String -> String -> IO ()+assertDiffers what a b = when (a == b) $ failure (what ++ ": expected a different fingerprint, got " ++ show a)+ -- | The main mapping rules, end to end: a plain library (lib-pkg), a second -- package (exe-pkg) whose library depends on it, an executable with -- @c-sources@, an exitcode-stdio-1.0 test-suite and a benchmark (both only@@ -135,6 +242,15 @@ basic project = do   _ <- buck2 project ["--enable-tests", "--enable-benchmarks", "-f+loud"] +  -- The GHC fingerprint is generated into tools.bzl, and is stable.+  let toolsPath = "third-party" </> "haskell" </> "tools.bzl"+  tools <- readIn project toolsPath+  assertContains toolsPath "GHC_FINGERPRINT = \"" tools+  assertContains toolsPath "CC_FINGERPRINT = \"" tools+  _ <- buck2 project ["--enable-tests", "--enable-benchmarks", "-f+loud"]+  tools' <- readIn project toolsPath+  assertEqual "tools.bzl after a second run" tools tools'+   -- The generated file is a build spec - a plain dict describing each   -- component as Cabal sees it - interpreted by buck2/cabal.bzl, which   -- decides which rules, labels and flags that becomes.@@ -226,6 +342,166 @@   ab "out = 'cabal_macros.h'" autogenBuck   ab "out = 'Main.hs'" autogenBuck +-- | Make a repository of the packages in the project's @dep@ directory, which is+-- the only one used, and a @cabal.project@ for the project's @app@ package.+localRepository :: Project -> [String] -> IO ()+localRepository project names = do+  let dir = projectDir project+  createDirectoryIfMissing True (dir </> "repo")+  forM_ names $ \name ->+    callProcess "tar" ["-C", dir </> "dep", "-czf", dir </> "repo" </> (name ++ ".tar.gz"), name]+  writeFile (dir </> "cabal.project") $+    unlines ["packages: app", "repository localrepo", "  url: file+noindex://" ++ dir </> "repo", "active-repositories: localrepo"]++-- | @--source-deps@ unpacks the dependencies (here one package from a local+-- repository) under @dist-newstyle/src@ and generates their targets like+-- those of the project's own packages; without it they are left to the cabal+-- store, and what an earlier run generated for them is removed.+sourceDeps :: Project -> IO ()+sourceDeps project = do+  let dir = projectDir project+  localRepository project ["dep-1.0"]++  -- With the dependency already in the store, from a run without the flag.+  _ <- buck2 project []+  _ <- buck2 project ["--source-deps"]+  let depBzlPath = "dist-newstyle" </> "src" </> "dep-1.0" </> "BUCK.cabal.bzl"+  depBzl <- readIn project depBzlPath+  assertContains depBzlPath "'name': 'dep'" depBzl+  assertContains depBzlPath "'version': '1.0'" depBzl+  assertContains depBzlPath "'dir': 'dist-newstyle/src/dep-1.0'" depBzl+  -- Its data files are recorded, for the tools that read them.+  assertContains depBzlPath "'data/*.txt'" depBzl+  -- hsc2hs is told what it is compiling for.+  assertContains depBzlPath "'-D__GLASGOW_HASKELL__=" depBzl+  assertContains depBzlPath "'asm_sources'" depBzl+  assertContains depBzlPath "'asm_options'" depBzl+  assertContains depBzlPath "'cmm_sources'" depBzl+  assertContains depBzlPath "'cmm/Dep.cmm'" depBzl+  appBzl <- readIn project ("app" </> "BUCK.cabal.bzl")+  -- A literate happy grammar is a module source.+  assertContains "app/BUCK.cabal.bzl" "'Parser': 'Parser.ly'" appBzl+  assertContains "app/BUCK.cabal.bzl" "'dir': 'dist-newstyle/src/dep-1.0'" appBzl++  -- Without the flag the dependency is the store's again.+  _ <- buck2 project []+  removed <- not <$> doesDirectoryExist (dir </> "dist-newstyle" </> "src" </> "dep-1.0")+  unless removed $ failure "dist-newstyle/src/dep-1.0 should have been removed"+  appBzl' <- readIn project ("app" </> "BUCK.cabal.bzl")+  assertNotContains "app/BUCK.cabal.bzl" "dist-newstyle/src/dep-1.0" appBzl'++-- | @reexported-modules@: a module re-exported from another package (by name+-- or found in a dependency, renamed or not) or from another library of the+-- package is resolved as Cabal does, and recorded in the spec with where it comes from, which is how the+-- library claims it - so that a package that depends on the library, and not+-- on where the module is from, can import it. A module of the library itself is recorded without a library.+reexports :: Project -> IO ()+reexports project = do+  _ <- buck2 project []+  reBzl <- readIn project ("re-lib" </> "BUCK.cabal.bzl")+  let re = assertContains "re-lib/BUCK.cabal.bzl"+  re "'reexports'" reBzl+  re "'module': 'Orig.A',\n                    'original': 'Orig.A',\n                    'from': {\n                        'package': 'base-lib',\n                        'dir': 'base-lib'," reBzl+  re "'module': 'New.B',\n                    'original': 'Orig.B'," reBzl+  re "'module': 'Sub.M',\n                    'original': 'Sub.M',\n                    'from': {\n                        'package': 're-lib',\n                        'library': 'sub'," reBzl+  -- One of its own modules has no library it comes from, and no module of its own.+  re "'module': 'New.X',\n                    'original': 'Own.X',\n                }," reBzl+  assertNotContains "re-lib/BUCK.cabal.bzl" "'New.X': {" reBzl++  -- What a library re-exports from another that re-exports it is recorded as+  -- where it is defined, and by that name, as Cabal does.+  re2Bzl <- readIn project ("re2" </> "BUCK.cabal.bzl")+  assertContains "re2/BUCK.cabal.bzl" "'module': 'Newer.B',\n                    'original': 'Orig.B',\n                    'from': {\n                        'package': 'base-lib'," re2Bzl+  assertContains "re2/BUCK.cabal.bzl" "'module': 'Orig.A',\n                    'original': 'Orig.A',\n                    'from': {\n                        'package': 'base-lib'," re2Bzl++  -- A library with no modules has one that doesn't need base.+  emptyBzl <- readIn project ("empty" </> "BUCK.cabal.bzl")+  assertContains "empty/BUCK.cabal.bzl" "'CabalBuck2Empty'" emptyBzl+  stub <- readIn project ("empty" </> "cabal-buck2" </> "autogen" </> "empty" </> "empty" </> "CabalBuck2Empty.hs")+  assertContains "the empty module" "NoImplicitPrelude" stub++  -- What depends on the library doesn't need to depend on where they are from.+  userBzl <- readIn project ("user" </> "BUCK.cabal.bzl")+  assertContains "user/BUCK.cabal.bzl" "'package': 're-lib'" userBzl+  assertNotContains "user/BUCK.cabal.bzl" "base-lib" userBzl++-- | The checkout of haskell-buck2 has to be for this release of cabal-buck2:+-- if it is not, or doesn't say, the error says which branch is needed.+buck2Version :: Project -> IO ()+buck2Version project = do+  let wrong (code', msg) = when (code' == ExitSuccess) $ failure ("accepted: " ++ msg)+  -- An earlier release didn't have a version.bzl.+  removeFile (projectDir project </> "buck2" </> "version.bzl")+  (code, out) <- runBuck2 project []+  wrong (code, "buck2/ with no version")+  assertContains "no version" ("needs the " ++ cabalBuck2Version ++ " branch") out+  assertContains "no version" "buck2/ is for no release" out+  assertContains "no version" "git -C buck2 checkout " out++  writeBuck2Version (projectDir project) "0.0.0.1"+  (code', out') <- runBuck2 project []+  wrong (code', "buck2/ for another release")+  assertContains "other version" ("This is cabal-buck2 " ++ cabalBuck2Version ++ ", and buck2/ is for cabal-buck2 0.0.0.1.") out'++  writeBuck2Version (projectDir project) cabalBuck2Version+  _ <- buck2 project []+  return ()++-- | A package with a @Custom@ build type needs its @Setup.hs@ to be run, which+-- is not done: it, and what depends on it, can't be built.+customSetup :: Project -> IO ()+customSetup project = do+  localRepository project ["custom-dep-0.1"]+  (code, failed) <- runBuck2 project ["--source-deps"]+  when (code == ExitSuccess) $ failure "a package with build-type: Custom was accepted"+  assertContains "error" "custom-dep" failed+  assertContains "error" "build-type: Custom" failed+  assertContains "error" "--keep-going" failed++  out <- buck2 project ["--source-deps", "--keep-going"]+  assertContains "warning" "build-type: Custom" out+  assertContains "warning" "skipping executable app" out+  depBzl <- readIn project ("dist-newstyle" </> "src" </> "custom-dep-0.1" </> "BUCK.cabal.bzl")+  assertNotContains "custom-dep BUCK.cabal.bzl" "'kind': 'library'" depBzl++-- | @--cache=ADDRESS@ adds the cache's settings to @.buckconfig@, which are+-- kept by later runs without the flag, and @--no-cache@ removes.+cacheConfig :: Project -> IO ()+cacheConfig project = do+  let buckconfig = ".buckconfig"+      block = "# >>> cabal buck2: cache"+  before <- readIn project buckconfig+  assertNotContains buckconfig block before++  out <- buck2 project ["--cache=grpc://127.0.0.1:9092"]+  -- A running buck2 daemon would keep the old settings.+  assertContains "notice" "buck2 kill" out+  withCache <- readIn project buckconfig+  assertContains buckconfig "[cabal_buck2]\n  cache = true" withCache+  assertContains buckconfig "default_allow_cache_upload = true" withCache+  assertContains buckconfig "action_cache_address = grpc://127.0.0.1:9092" withCache+  assertContains buckconfig "tls = false" withCache+  -- What was there is kept.+  assertContains buckconfig (take 40 before) withCache++  -- Later runs leave it alone.+  _ <- buck2 project []+  again <- readIn project buckconfig+  assertEqual "after a run without --cache" withCache again++  -- Removing it restores the original file.+  _ <- buck2 project ["--no-cache"]+  without <- readIn project buckconfig+  assertEqual "after --no-cache" before without++  -- Mistakes are reported.+  (badCode, badOut) <- runBuck2 project ["--cache=http://example.org"]+  when (badCode == ExitSuccess) $ failure "--cache=http://... was accepted"+  assertContains "bad address" "grpc://" badOut+  (code', out') <- runBuck2 project ["--cache=grpc://a:1", "--no-cache"]+  when (code' == ExitSuccess) $ failure "--cache with --no-cache was accepted"+  assertContains "both flags" "can't be used together" out'+ -- | A plain run, without @--enable-tests@ or @--enable-benchmarks@, must -- succeed even though the package has test-suites and a benchmark. The -- benchmark depends on @stm@, which nothing else in the fixture uses: since@@ -247,10 +523,19 @@ -- | A component whose sources can't all be found is skipped with a warning -- saying why (a rule that names a missing file would take down the whole -- buck2 build), and so is every component of the same package that depends--- on it. Everything else is still generated.+-- on it. By default that is an error and nothing is generated; with+-- @--keep-going@ everything else is generated. missingModule :: Project -> IO () missingModule project = do-  out <- buck2 project []+  (code, failed) <- runBuck2 project []+  when (code == ExitSuccess) $ failure "a component that can't be built was accepted"+  assertContains "error" "for module Absent" failed+  assertContains "error" "skipping library broken-pkg" failed+  assertContains "error" "--keep-going" failed+  generated <- doesFileExist (projectDir project </> "broken-pkg" </> "BUCK.cabal.bzl")+  when generated $ failure "files were generated despite the error"++  out <- buck2 project ["--keep-going"]   assertContains "output" "for module Absent" out   assertContains "output" "skipping library broken-pkg" out   assertContains "output" "skipping executable uses-lib" out
+ test/fixtures/custom-setup/.buckconfig view
@@ -0,0 +1,4 @@+# Placeholder: this test only checks `cabal buck2`'s generated files, it+# never actually invokes a real buck2 binary, so this doesn't need to be+# a functional buck2 config - it only needs to exist so that+# `ensureBuckconfigAndPackage` sees it's already there and leaves it alone.
+ test/fixtures/custom-setup/PACKAGE view
@@ -0,0 +1,1 @@+# Placeholder - see .buckconfig.
+ test/fixtures/custom-setup/app/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Custom.Dep (libdir)++main :: IO ()+main = putStrLn libdir
+ test/fixtures/custom-setup/app/app.cabal view
@@ -0,0 +1,9 @@+cabal-version:    2.2+name:             app+version:          0.1+build-type:       Simple++executable app+  main-is:          Main.hs+  build-depends:    base, custom-dep+  default-language: Haskell2010
+ test/fixtures/custom-setup/buck2/.gitkeep view
+ test/fixtures/custom-setup/dep/custom-dep-0.1/Custom/Dep.hs view
@@ -0,0 +1,4 @@+module Custom.Dep (libdir) where++libdir :: FilePath+libdir = ""
+ test/fixtures/custom-setup/dep/custom-dep-0.1/Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain
+ test/fixtures/custom-setup/dep/custom-dep-0.1/custom-dep.cabal view
@@ -0,0 +1,12 @@+cabal-version: 2.2+name:          custom-dep+version:       0.1+build-type:    Custom++custom-setup+  setup-depends: base, Cabal++library+  exposed-modules:  Custom.Dep+  build-depends:    base+  default-language: Haskell2010
+ test/fixtures/reexports/.buckconfig view
@@ -0,0 +1,4 @@+# Placeholder: this test only checks `cabal buck2`'s generated files, it+# never actually invokes a real buck2 binary, so this doesn't need to be+# a functional buck2 config - it only needs to exist so that+# `ensureBuckconfigAndPackage` sees it's already there and leaves it alone.
+ test/fixtures/reexports/PACKAGE view
@@ -0,0 +1,1 @@+# Placeholder - see .buckconfig.
+ test/fixtures/reexports/base-lib/base-lib.cabal view
@@ -0,0 +1,10 @@+cabal-version:    3.0+name:             base-lib+version:          0.1+build-type:       Simple++library+  exposed-modules:  Orig.A, Orig.B, Orig.C+  hs-source-dirs:   src+  build-depends:    base+  default-language: Haskell2010
+ test/fixtures/reexports/base-lib/src/Orig/A.hs view
@@ -0,0 +1,4 @@+module Orig.A where++valueA :: Int+valueA = 1
+ test/fixtures/reexports/base-lib/src/Orig/B.hs view
@@ -0,0 +1,4 @@+module Orig.B where++valueB :: Int+valueB = 1
+ test/fixtures/reexports/base-lib/src/Orig/C.hs view
@@ -0,0 +1,4 @@+module Orig.C where++valueC :: Int+valueC = 1
+ test/fixtures/reexports/buck2/.gitkeep view
+ test/fixtures/reexports/cabal.project view
@@ -0,0 +1,3 @@+packages: base-lib re-lib user empty re2 chain++active-repositories: :none
+ test/fixtures/reexports/chain/app/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Newer.B (valueB)+import Orig.A (valueA)++main :: IO ()+main = print (valueA + valueB)
+ test/fixtures/reexports/chain/chain.cabal view
@@ -0,0 +1,10 @@+cabal-version:    3.0+name:             chain+version:          0.1+build-type:       Simple++executable chain+  main-is:          Main.hs+  hs-source-dirs:   app+  build-depends:    base, re2+  default-language: Haskell2010
+ test/fixtures/reexports/empty/empty.cabal view
@@ -0,0 +1,8 @@+cabal-version:    3.0+name:             empty+version:          0.1+build-type:       Simple++-- Nothing in it, and it doesn't depend on base.+library+  default-language: Haskell2010
+ test/fixtures/reexports/re-lib/re-lib.cabal view
@@ -0,0 +1,26 @@+cabal-version:    3.0+name:             re-lib+version:          0.1+build-type:       Simple++library sub+  visibility:       private+  exposed-modules:  Sub.M+  hs-source-dirs:   sub+  build-depends:    base+  default-language: Haskell2010++library+  exposed-modules:   Own.X+  reexported-modules:+    -- named by its package+    base-lib:Orig.A,+    -- renamed, and found in a dependency+    Orig.B as New.B,+    -- of another library of the package+    Sub.M,+    -- renamed, of the library itself+    Own.X as New.X+  hs-source-dirs:    src+  build-depends:     base, base-lib, re-lib:sub+  default-language:  Haskell2010
+ test/fixtures/reexports/re-lib/src/Own/X.hs view
@@ -0,0 +1,4 @@+module Own.X where++x :: Int+x = 2
+ test/fixtures/reexports/re-lib/sub/Sub/M.hs view
@@ -0,0 +1,4 @@+module Sub.M where++m :: Int+m = 3
+ test/fixtures/reexports/re2/re2.cabal view
@@ -0,0 +1,10 @@+cabal-version:    3.0+name:             re2+version:          0.1+build-type:       Simple++library+  reexported-modules: Orig.A, New.B as Newer.B+  hs-source-dirs:    src+  build-depends:     base, re-lib+  default-language:  Haskell2010
+ test/fixtures/reexports/user/app/Main.hs view
@@ -0,0 +1,9 @@+module Main (main) where++import New.B (valueB)+import New.X (x)+import Orig.A (valueA)+import Sub.M (m)++main :: IO ()+main = print (valueA + valueB + m + x)
+ test/fixtures/reexports/user/user.cabal view
@@ -0,0 +1,10 @@+cabal-version:    3.0+name:             user+version:          0.1+build-type:       Simple++executable user+  main-is:          Main.hs+  hs-source-dirs:   app+  build-depends:    base, re-lib+  default-language: Haskell2010
+ test/fixtures/source-deps/.buckconfig view
@@ -0,0 +1,4 @@+# Placeholder: this test only checks `cabal buck2`'s generated files, it+# never actually invokes a real buck2 binary, so this doesn't need to be+# a functional buck2 config - it only needs to exist so that+# `ensureBuckconfigAndPackage` sees it's already there and leaves it alone.
+ test/fixtures/source-deps/PACKAGE view
@@ -0,0 +1,1 @@+# Placeholder - see .buckconfig.
+ test/fixtures/source-deps/app/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Dep (message)++main :: IO ()+main = putStrLn message
+ test/fixtures/source-deps/app/Parser.ly view
@@ -0,0 +1,11 @@+{+module Parser (parse) where+}++%name parse+%tokentype { Char }+%token c { _ }++%%++E : c { () }
+ test/fixtures/source-deps/app/app.cabal view
@@ -0,0 +1,10 @@+cabal-version: 2.2+name:          app+version:       0.1+build-type:    Simple++executable app+  main-is:          Main.hs+  other-modules:    Parser+  build-depends:    base, dep+  default-language: Haskell2010
+ test/fixtures/source-deps/buck2/.gitkeep view
+ test/fixtures/source-deps/dep/dep-1.0/asm/Dep.S view
+ test/fixtures/source-deps/dep/dep-1.0/bench/Bench.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = return ()
+ test/fixtures/source-deps/dep/dep-1.0/cmm/Dep.cmm view
@@ -0,0 +1,6 @@+#include "Cmm.h"++stg_depzh (W_ x)+{+  return (x);+}
+ test/fixtures/source-deps/dep/dep-1.0/data/greeting.txt view
@@ -0,0 +1,1 @@+hello
+ test/fixtures/source-deps/dep/dep-1.0/dep.cabal view
@@ -0,0 +1,31 @@+cabal-version: 3.0+name:          dep+version:       1.0+build-type:    Simple+data-files:    data/*.txt++library+  exposed-modules:  Dep+  other-modules:    Paths_dep+  hs-source-dirs:   src+  build-depends:    base+  cmm-sources:      cmm/Dep.cmm+  asm-sources:      asm/Dep.S+  asm-options:      -DASM+  default-language: Haskell2010++-- Neither of these is in the build plan, as benchmarks are not enabled.+library bench-lib+  visibility:       private+  exposed-modules:  Dep+  hs-source-dirs:   src+  build-depends:    base+  js-sources:       js/x.js+  default-language: Haskell2010++benchmark bench+  type:             exitcode-stdio-1.0+  main-is:          Bench.hs+  hs-source-dirs:   bench+  build-depends:    base, dep:bench-lib+  default-language: Haskell2010
+ test/fixtures/source-deps/dep/dep-1.0/js/x.js view
+ test/fixtures/source-deps/dep/dep-1.0/src/Dep.hs view
@@ -0,0 +1,6 @@+module Dep (message) where++import Paths_dep (version)++message :: String+message = "dep " ++ show version