在构建组件之前运行自定义的每个组件`IO()`，与实际构建交错

编程问答 2022-05-23

问题描述

我想在构建给定组件之前运行每个组件的自定义操作：

justBeforeBuilding :: LocalBuildInfo -> BuildFlags -> Component -> IO BuildInfo

因为该操作可能需要已经构建依赖项，例如，如果给定的 Cabal 包同时具有库和使用该库的可执行文件，那么每个组件的 justBeforeBuilding 仅在实际组件之前运行很重要已构建，但在构建了所有依赖项之后。

所以这就是我尝试过的：不是调用一次默认的构建钩子，而是按照依赖顺序一个一个地检查所有启用的组件，调用我的 justBeforeBuilding 函数，然后偷偷地更改 buildArgs这样默认的构建钩子只会构建单个当前组件：

restrictBuildFlags :: PackageDescription -> Component -> BuildFlags -> BuildFlags
restrictBuildFlags pkg c buildFlags = buildFlags
    { buildArgs = selectedArgs
    }
  where
    selectedArgs = [showBuildTarget (packageId pkg) $ BuildTargetComponent $ componentName c]

type BuildHook = PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()

myBuildHook :: BuildHook -> BuildHook
myBuildHook nextBuildHook pkg lbi userHooks flags = do
    let reqSpec = componentEnabledSpec lbi
    withAllComponentsInBuildOrder pkg lbi $ \c clbi -> do
        flags <- return $ restrictBuildFlags pkg c flags
        when (componentEnabled reqSpec c && not (null $ buildArgs flags)) $ do
            justBeforeBuilding lbi flags c
            nextBuildHook pkg lbi userHooks flags

main :: IO ()
main = defaultMainWithHooks simpleUserHooks
    { buildHook = myBuildHook $ buildHook simpleUserHooks
    }

问题在于，当 justBeforeBuilding 运行时，它无法访问库依赖项即使它们已经在那时构建了。为了演示，这里有一个函数可以打印 Cabal 提供的包 DBs 的内容：

justBeforeBuilding :: LocalBuildInfo -> BuildFlags -> Component -> IO ()
justBeforeBuilding lbi flags c = do
    pkgdbs <- absolutePackageDBPaths $ withPackageDB lbi
    let dbpaths = nub . sort $ [ path | SpecificPackageDB path <- pkgdbs ]
        dbflags = concat [ ["-package-db",path] | path <- dbpaths ]

    putStrLn $ "!!! Processing component " <> show (componentName c)
    putStrLn "!!! At this point,the package DB paths are:"
    forM_ dbpaths $ \dir -> do
        putStrLn dir
        files <- listDirectory dir
        mapM_ (printf "    %s\n") files

为了测试，我使用了一个带有一个库和一个 exe 的 Cabal 包； HPack 格式：

name: cabal-component-hook
version: 0.1.0

custom-setup:
  dependencies:
    - base
    - Cabal
    - directory

dependencies:
  - base >= 4.7 && < 5

library:
  source-dirs: lib
  exposed-modules:
    - Foo
    
executables:
  bar:
    source-dirs: app
    main: bar.hs
    dependencies:
      - cabal-component-hook

如果我然后执行 stack build，首先，构建了库，并且包 DB 当然还不包含该库：

!!! Processing component CLibName LMainLibName
!!! At this point,the package DB paths are:
/home/cactus/prog/clash/bugs/cabal-component-hook/.stack-work/install/x86_64-linux-tinfo6/82781a0829e0e0da301c1db4825858dea8980a6a982b679eb178870c6c0ec1ee/8.10.4/pkgdb
    package.cache.lock
    package.cache
/home/cactus/sdk/stack/snapshots/x86_64-linux-tinfo6/82781a0829e0e0da301c1db4825858dea8980a6a982b679eb178870c6c0ec1ee/8.10.4/pkgdb
    package.cache.lock
    StateVar-1.2.1-7vo3tV8mPssJqOV48TU4OF.conf
    call-stack-0.2.0-4YzMVPI02PxAK0TxyBY7Iv.conf
    cabal-doctest-1.0.8-I4vvWDvrsGA6v5uZj1lZJi.conf
    base-orphans-0.8.4-JVJ8ttw51H7Dc3tJYgx6uK.conf
    parallel-3.2.2.0-HTf2o2horULDwL7cXUB9uv.conf
    hashable-1.3.0.0-K3FFBNAmsvaIvBv4Qg15rQ.conf
    semigroups-0.19.1-CdJZL8lQRXTEuOuxFhFNIa.conf
    contravariant-1.5.3-A4NbUFeaP6W4UzkL1eJoxa.conf
    indexed-traversable-0.1.1-Dw8MIJyvCj8IZQDXOa8TBp.conf
    tagged-0.8.6.1-A3E8I7zg2qBFE9O5vQsg6C.conf
    void-0.7.3-FJLCa6y31Qt20kSi8TCcBC.conf
    transformers-compat-0.6.6-CZr4aajtyBTi4Enjszw8H.conf
    reflection-2.1.6-CzOlI803nFuvt8AikdOut.conf
    distributive-0.6.2.1-Lhog8B4NdHk7JJdshqpkhJ.conf
    transformers-base-0.4.5.2-2JwY8UMK4YFHH9faaNEDAI.conf
    th-abstraction-0.4.2.0-CPMLTlyMgmr6dbHxHL95CG.conf
    comonad-5.0.8-EA0Scey7jOW6LX5RvNTIb8.conf
    primitive-0.7.1.0-Jxsyd70oUttYiCXCa0HqV.conf
    unordered-containers-0.2.13.0-3awuPgUx2yvAACRZkw6am3.conf
    bifunctors-5.5.10-1Xyw3zBBKdPGoolSEEYrSo.conf
    profunctors-5.5.2-Jd7sxJvE4zaBkftBvoi6oJ.conf
    semigroupoids-5.3.5-A5MCqcbuwFnHzZu6aqZxm4.conf
    invariant-0.5.4-Ca6182XTMBJ4627vLKNFdU.conf
    free-5.1.5-JCTHYv08sV0j7gsEXshfc.conf
    adjunctions-4.4-4Q0IXuLBVoCBKmI2ZpS7bE.conf
    kan-extensions-5.2.2-Z55rpCSAQY7rC9ino1jlr.conf
    vector-0.12.1.2-6jlbObSa8iuJfxUVGBQC5r.conf
    lens-4.19.2-86eTsWPqcVQ3qs5KiS7cYu.conf
    package.cache
Preprocessing library for cabal-component-hook-0.1.0..
Building library for cabal-component-hook-0.1.0..
[1 of 2] Compiling Foo
[2 of 2] Compiling Paths_cabal_component_hook

然而，然后可执行文件被构建，并且包 DB 仍然不包含刚刚构建的库：

!!! Processing component CExeName (UnqualComponentName "bar")
!!! At this point,the package DB paths are:
/home/cactus/prog/clash/bugs/cabal-component-hook/.stack-work/install/x86_64-linux-tinfo6/82781a0829e0e0da301c1db4825858dea8980a6a982b679eb178870c6c0ec1ee/8.10.4/pkgdb
    package.cache.lock
    package.cache
/home/cactus/sdk/stack/snapshots/x86_64-linux-tinfo6/82781a0829e0e0da301c1db4825858dea8980a6a982b679eb178870c6c0ec1ee/8.10.4/pkgdb
    package.cache.lock
    StateVar-1.2.1-7vo3tV8mPssJqOV48TU4OF.conf
    call-stack-0.2.0-4YzMVPI02PxAK0TxyBY7Iv.conf
    cabal-doctest-1.0.8-I4vvWDvrsGA6v5uZj1lZJi.conf
    base-orphans-0.8.4-JVJ8ttw51H7Dc3tJYgx6uK.conf
    parallel-3.2.2.0-HTf2o2horULDwL7cXUB9uv.conf
    hashable-1.3.0.0-K3FFBNAmsvaIvBv4Qg15rQ.conf
    semigroups-0.19.1-CdJZL8lQRXTEuOuxFhFNIa.conf
    contravariant-1.5.3-A4NbUFeaP6W4UzkL1eJoxa.conf
    indexed-traversable-0.1.1-Dw8MIJyvCj8IZQDXOa8TBp.conf
    tagged-0.8.6.1-A3E8I7zg2qBFE9O5vQsg6C.conf
    void-0.7.3-FJLCa6y31Qt20kSi8TCcBC.conf
    transformers-compat-0.6.6-CZr4aajtyBTi4Enjszw8H.conf
    reflection-2.1.6-CzOlI803nFuvt8AikdOut.conf
    distributive-0.6.2.1-Lhog8B4NdHk7JJdshqpkhJ.conf
    transformers-base-0.4.5.2-2JwY8UMK4YFHH9faaNEDAI.conf
    th-abstraction-0.4.2.0-CPMLTlyMgmr6dbHxHL95CG.conf
    comonad-5.0.8-EA0Scey7jOW6LX5RvNTIb8.conf
    primitive-0.7.1.0-Jxsyd70oUttYiCXCa0HqV.conf
    unordered-containers-0.2.13.0-3awuPgUx2yvAACRZkw6am3.conf
    bifunctors-5.5.10-1Xyw3zBBKdPGoolSEEYrSo.conf
    profunctors-5.5.2-Jd7sxJvE4zaBkftBvoi6oJ.conf
    semigroupoids-5.3.5-A5MCqcbuwFnHzZu6aqZxm4.conf
    invariant-0.5.4-Ca6182XTMBJ4627vLKNFdU.conf
    free-5.1.5-JCTHYv08sV0j7gsEXshfc.conf
    adjunctions-4.4-4Q0IXuLBVoCBKmI2ZpS7bE.conf
    kan-extensions-5.2.2-Z55rpCSAQY7rC9ino1jlr.conf
    vector-0.12.1.2-6jlbObSa8iuJfxUVGBQC5r.conf
    lens-4.19.2-86eTsWPqcVQ3qs5KiS7cYu.conf
    package.cache
Preprocessing library for cabal-component-hook-0.1.0..
Building library for cabal-component-hook-0.1.0..
Preprocessing executable 'bar' for cabal-component-hook-0.1.0..
Building executable 'bar' for cabal-component-hook-0.1.0..
[1 of 2] Compiling Main
[2 of 2] Compiling Paths_cabal_component_hook
Linking .stack-work/dist/x86_64-linux-tinfo6/Cabal-3.2.1.0/build/bar/bar ...

在整个过程结束时，虽然正确填充了包 DB 目录：

/home/cactus/prog/clash/bugs/cabal-component-hook/.stack-work/install/x86_64-linux-tinfo6/82781a0829e0e0da301c1db4825858dea8980a6a982b679eb178870c6c0ec1ee/8.10.4/pkgdb
├── cabal-component-hook-0.1.0-8kPvy0LMfqKAbvXmH5zWaP.conf
├── package.cache
└── package.cache.lock

所以我的问题是，我如何安排 justBeforeBuilding 在构建每个单独的组件之前运行，当它的依赖项已经完全处理，即库依赖项被复制到构建内部包 DB？

解决方法

事实证明我是在正确的轨道上，除了我还需要在包 DB 列表中包含所谓的内部包 DB。 Distribution.Simple.Build 导出一个名为 createInternalPackageDB 的函数，不幸的是，我们不能使用批发（因为它删除并重新初始化内部包 DB，实际上删除了以前组件的构建输出）；但我们可以复制它的行为：

justBeforeBuilding :: LocalBuildInfo -> BuildFlags -> Component -> IO ()
justBeforeBuilding lbi flags c = do
    pkgdb0 <- do
        let dbPath = internalPackageDBPath lbi distPref
        existsAlready <- doesPackageDBExist dbPath
        unless existsAlready $ do
            createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
        return $ SpecificPackageDB dbPath
    pkgdbs <- absolutePackageDBPaths $ withPackageDB lbi

    let dbpaths = nub . sort $ [ path | SpecificPackageDB path <- pkgdb0:pkgdbs ]
    ... -- Here we can proceed as before and things work out
  where
    verbosity = fromFlagOrDefault normal (buildVerbosity flags)
    distPref  = fromFlag (buildDistPref flags)
buildbuildbuildcabalhaskellhaskellhookhook