diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 cabal buck2 --enable-tests ``` +Where `` 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`** diff --git a/cabal-buck2.cabal b/cabal-buck2.cabal --- a/cabal-buck2.cabal +++ b/cabal-buck2.cabal @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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` diff --git a/src/Distribution/Client/Buck2/BuildDependencies.hs b/src/Distribution/Client/Buck2/BuildDependencies.hs --- a/src/Distribution/Client/Buck2/BuildDependencies.hs +++ b/src/Distribution/Client/Buck2/BuildDependencies.hs @@ -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 diff --git a/src/Distribution/Client/Buck2/Cache.hs b/src/Distribution/Client/Buck2/Cache.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Client/Buck2/Cache.hs @@ -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 diff --git a/src/Distribution/Client/Buck2/Configure.hs b/src/Distribution/Client/Buck2/Configure.hs --- a/src/Distribution/Client/Buck2/Configure.hs +++ b/src/Distribution/Client/Buck2/Configure.hs @@ -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 @.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) diff --git a/src/Distribution/Client/Buck2/Fingerprint.hs b/src/Distribution/Client/Buck2/Fingerprint.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Client/Buck2/Fingerprint.hs @@ -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])))) + ] diff --git a/src/Distribution/Client/Buck2/Flags.hs b/src/Distribution/Client/Buck2/Flags.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Client/Buck2/Flags.hs @@ -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 diff --git a/src/Distribution/Client/Buck2/Generate.hs b/src/Distribution/Client/Buck2/Generate.hs --- a/src/Distribution/Client/Buck2/Generate.hs +++ b/src/Distribution/Client/Buck2/Generate.hs @@ -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_\@ 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) diff --git a/src/Distribution/Client/Buck2/LocalPackages.hs b/src/Distribution/Client/Buck2/LocalPackages.hs --- a/src/Distribution/Client/Buck2/LocalPackages.hs +++ b/src/Distribution/Client/Buck2/LocalPackages.hs @@ -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) ] diff --git a/src/Distribution/Client/Buck2/Prebuilt.hs b/src/Distribution/Client/Buck2/Prebuilt.hs --- a/src/Distribution/Client/Buck2/Prebuilt.hs +++ b/src/Distribution/Client/Buck2/Prebuilt.hs @@ -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 diff --git a/src/Distribution/Client/Buck2/Setup.hs b/src/Distribution/Client/Buck2/Setup.hs --- a/src/Distribution/Client/Buck2/Setup.hs +++ b/src/Distribution/Client/Buck2/Setup.hs @@ -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 () diff --git a/src/Distribution/Client/Buck2/Spec.hs b/src/Distribution/Client/Buck2/Spec.hs --- a/src/Distribution/Client/Buck2/Spec.hs +++ b/src/Distribution/Client/Buck2/Spec.hs @@ -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@. diff --git a/src/Distribution/Client/Buck2/Version.hs b/src/Distribution/Client/Buck2/Version.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Client/Buck2/Version.hs @@ -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 diff --git a/src/Distribution/Client/Buck2/Write.hs b/src/Distribution/Client/Buck2/Write.hs --- a/src/Distribution/Client/Buck2/Write.hs +++ b/src/Distribution/Client/Buck2/Write.hs @@ -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)] diff --git a/src/Distribution/Client/CmdBuck2.hs b/src/Distribution/Client/CmdBuck2.hs --- a/src/Distribution/Client/CmdBuck2.hs +++ b/src/Distribution/Client/CmdBuck2.hs @@ -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}} diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 diff --git a/test/fixtures/custom-setup/.buckconfig b/test/fixtures/custom-setup/.buckconfig new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/.buckconfig @@ -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. diff --git a/test/fixtures/custom-setup/PACKAGE b/test/fixtures/custom-setup/PACKAGE new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/PACKAGE @@ -0,0 +1,1 @@ +# Placeholder - see .buckconfig. diff --git a/test/fixtures/custom-setup/app/Main.hs b/test/fixtures/custom-setup/app/Main.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Custom.Dep (libdir) + +main :: IO () +main = putStrLn libdir diff --git a/test/fixtures/custom-setup/app/app.cabal b/test/fixtures/custom-setup/app/app.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/app/app.cabal @@ -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 diff --git a/test/fixtures/custom-setup/buck2/.gitkeep b/test/fixtures/custom-setup/buck2/.gitkeep new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/buck2/.gitkeep diff --git a/test/fixtures/custom-setup/dep/custom-dep-0.1/Custom/Dep.hs b/test/fixtures/custom-setup/dep/custom-dep-0.1/Custom/Dep.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/dep/custom-dep-0.1/Custom/Dep.hs @@ -0,0 +1,4 @@ +module Custom.Dep (libdir) where + +libdir :: FilePath +libdir = "" diff --git a/test/fixtures/custom-setup/dep/custom-dep-0.1/Setup.hs b/test/fixtures/custom-setup/dep/custom-dep-0.1/Setup.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/dep/custom-dep-0.1/Setup.hs @@ -0,0 +1,4 @@ +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/test/fixtures/custom-setup/dep/custom-dep-0.1/custom-dep.cabal b/test/fixtures/custom-setup/dep/custom-dep-0.1/custom-dep.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/custom-setup/dep/custom-dep-0.1/custom-dep.cabal @@ -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 diff --git a/test/fixtures/reexports/.buckconfig b/test/fixtures/reexports/.buckconfig new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/.buckconfig @@ -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. diff --git a/test/fixtures/reexports/PACKAGE b/test/fixtures/reexports/PACKAGE new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/PACKAGE @@ -0,0 +1,1 @@ +# Placeholder - see .buckconfig. diff --git a/test/fixtures/reexports/base-lib/base-lib.cabal b/test/fixtures/reexports/base-lib/base-lib.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/base-lib/base-lib.cabal @@ -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 diff --git a/test/fixtures/reexports/base-lib/src/Orig/A.hs b/test/fixtures/reexports/base-lib/src/Orig/A.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/base-lib/src/Orig/A.hs @@ -0,0 +1,4 @@ +module Orig.A where + +valueA :: Int +valueA = 1 diff --git a/test/fixtures/reexports/base-lib/src/Orig/B.hs b/test/fixtures/reexports/base-lib/src/Orig/B.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/base-lib/src/Orig/B.hs @@ -0,0 +1,4 @@ +module Orig.B where + +valueB :: Int +valueB = 1 diff --git a/test/fixtures/reexports/base-lib/src/Orig/C.hs b/test/fixtures/reexports/base-lib/src/Orig/C.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/base-lib/src/Orig/C.hs @@ -0,0 +1,4 @@ +module Orig.C where + +valueC :: Int +valueC = 1 diff --git a/test/fixtures/reexports/buck2/.gitkeep b/test/fixtures/reexports/buck2/.gitkeep new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/buck2/.gitkeep diff --git a/test/fixtures/reexports/cabal.project b/test/fixtures/reexports/cabal.project new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/cabal.project @@ -0,0 +1,3 @@ +packages: base-lib re-lib user empty re2 chain + +active-repositories: :none diff --git a/test/fixtures/reexports/chain/app/Main.hs b/test/fixtures/reexports/chain/app/Main.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/chain/app/Main.hs @@ -0,0 +1,7 @@ +module Main (main) where + +import Newer.B (valueB) +import Orig.A (valueA) + +main :: IO () +main = print (valueA + valueB) diff --git a/test/fixtures/reexports/chain/chain.cabal b/test/fixtures/reexports/chain/chain.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/chain/chain.cabal @@ -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 diff --git a/test/fixtures/reexports/empty/empty.cabal b/test/fixtures/reexports/empty/empty.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/empty/empty.cabal @@ -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 diff --git a/test/fixtures/reexports/re-lib/re-lib.cabal b/test/fixtures/reexports/re-lib/re-lib.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/re-lib/re-lib.cabal @@ -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 diff --git a/test/fixtures/reexports/re-lib/src/Own/X.hs b/test/fixtures/reexports/re-lib/src/Own/X.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/re-lib/src/Own/X.hs @@ -0,0 +1,4 @@ +module Own.X where + +x :: Int +x = 2 diff --git a/test/fixtures/reexports/re-lib/sub/Sub/M.hs b/test/fixtures/reexports/re-lib/sub/Sub/M.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/re-lib/sub/Sub/M.hs @@ -0,0 +1,4 @@ +module Sub.M where + +m :: Int +m = 3 diff --git a/test/fixtures/reexports/re2/re2.cabal b/test/fixtures/reexports/re2/re2.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/re2/re2.cabal @@ -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 diff --git a/test/fixtures/reexports/user/app/Main.hs b/test/fixtures/reexports/user/app/Main.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/user/app/Main.hs @@ -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) diff --git a/test/fixtures/reexports/user/user.cabal b/test/fixtures/reexports/user/user.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/reexports/user/user.cabal @@ -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 diff --git a/test/fixtures/source-deps/.buckconfig b/test/fixtures/source-deps/.buckconfig new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/.buckconfig @@ -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. diff --git a/test/fixtures/source-deps/PACKAGE b/test/fixtures/source-deps/PACKAGE new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/PACKAGE @@ -0,0 +1,1 @@ +# Placeholder - see .buckconfig. diff --git a/test/fixtures/source-deps/app/Main.hs b/test/fixtures/source-deps/app/Main.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Dep (message) + +main :: IO () +main = putStrLn message diff --git a/test/fixtures/source-deps/app/Parser.ly b/test/fixtures/source-deps/app/Parser.ly new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/app/Parser.ly @@ -0,0 +1,11 @@ +{ +module Parser (parse) where +} + +%name parse +%tokentype { Char } +%token c { _ } + +%% + +E : c { () } diff --git a/test/fixtures/source-deps/app/app.cabal b/test/fixtures/source-deps/app/app.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/app/app.cabal @@ -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 diff --git a/test/fixtures/source-deps/buck2/.gitkeep b/test/fixtures/source-deps/buck2/.gitkeep new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/buck2/.gitkeep diff --git a/test/fixtures/source-deps/dep/dep-1.0/asm/Dep.S b/test/fixtures/source-deps/dep/dep-1.0/asm/Dep.S new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/asm/Dep.S diff --git a/test/fixtures/source-deps/dep/dep-1.0/bench/Bench.hs b/test/fixtures/source-deps/dep/dep-1.0/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/bench/Bench.hs @@ -0,0 +1,2 @@ +main :: IO () +main = return () diff --git a/test/fixtures/source-deps/dep/dep-1.0/cmm/Dep.cmm b/test/fixtures/source-deps/dep/dep-1.0/cmm/Dep.cmm new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/cmm/Dep.cmm @@ -0,0 +1,6 @@ +#include "Cmm.h" + +stg_depzh (W_ x) +{ + return (x); +} diff --git a/test/fixtures/source-deps/dep/dep-1.0/data/greeting.txt b/test/fixtures/source-deps/dep/dep-1.0/data/greeting.txt new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/data/greeting.txt @@ -0,0 +1,1 @@ +hello diff --git a/test/fixtures/source-deps/dep/dep-1.0/dep.cabal b/test/fixtures/source-deps/dep/dep-1.0/dep.cabal new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/dep.cabal @@ -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 diff --git a/test/fixtures/source-deps/dep/dep-1.0/js/x.js b/test/fixtures/source-deps/dep/dep-1.0/js/x.js new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/js/x.js diff --git a/test/fixtures/source-deps/dep/dep-1.0/src/Dep.hs b/test/fixtures/source-deps/dep/dep-1.0/src/Dep.hs new file mode 100644 --- /dev/null +++ b/test/fixtures/source-deps/dep/dep-1.0/src/Dep.hs @@ -0,0 +1,6 @@ +module Dep (message) where + +import Paths_dep (version) + +message :: String +message = "dep " ++ show version