1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
module Main
( main
) where
import Data.List ( nub, sortOn )
import Distribution.InstalledPackageInfo
( installedUnitId, sourcePackageId )
import Distribution.Package ( UnitId, packageName, packageVersion )
import Distribution.PackageDescription
( Executable (..), PackageDescription )
import Distribution.Pretty ( prettyShow )
import Distribution.Simple
( UserHooks(..), defaultMainWithHooks, simpleUserHooks )
import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
import Distribution.Simple.LocalBuildInfo
( ComponentLocalBuildInfo (..), LocalBuildInfo, installedPkgs
, withExeLBI, withLibLBI
)
import Distribution.Simple.PackageIndex
( allPackages, dependencyClosure )
import Distribution.Simple.Setup
( BuildFlags (..), ReplFlags (..), fromFlag )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, rewriteFileEx )
import Distribution.Types.PackageName ( unPackageName )
import Distribution.Types.UnqualComponentName
( unUnqualComponentName )
import Distribution.Verbosity ( Verbosity, normal )
import System.FilePath ( (</>) )
main :: IO ()
main = defaultMainWithHooks simpleUserHooks
{ buildHook = \pkg lbi hooks flags -> do
generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
buildHook simpleUserHooks pkg lbi hooks flags
-- The 'cabal repl' hook corresponds to the 'cabal build' hook and is added
-- because, with a Cabal-based cradle, Haskell Language Server makes use of
-- 'cabal repl'.
, replHook = \pkg lbi hooks flags args -> do
generateBuildModule (fromFlag (replVerbosity flags)) pkg lbi
replHook simpleUserHooks pkg lbi hooks flags args
}
generateBuildModule ::
Verbosity
-> PackageDescription
-> LocalBuildInfo
-> IO ()
generateBuildModule verbosity pkg lbi = do
let dir = autogenPackageModulesDir lbi
createDirectoryIfMissingVerbose verbosity True dir
withLibLBI pkg lbi $ \_ libcfg -> do
withExeLBI pkg lbi $ \exe clbi -> do
let name = exeName' exe
rewriteFileEx normal (dir </> "Build_" ++ name ++ ".hs") $ unlines
[ "{-|"
, "Module : Build_" ++ name
, "License : BSD-3-Clause"
, "-}"
, ""
, "module Build_" ++ name
, " ( deps"
, " ) where"
, ""
, "-- | The dependencies against which \\'" ++ name ++ "\\' is built."
, "deps :: [String]"
, "deps = " ++ show (formatdeps (transDeps libcfg clbi))
]
where
exeName' = unUnqualComponentName . exeName
formatdeps = map formatone . sortOn unPackageName'
formatone p = unPackageName' p ++ "-" ++ prettyShow (packageVersion p)
unPackageName' = unPackageName . packageName
transDeps xs ys = either
(map sourcePackageId . allPackages)
handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds
where
allInstPkgsIdx = installedPkgs lbi
allInstPkgIds = map installedUnitId $ allPackages allInstPkgsIdx
-- instPkgIds includes `stack-X.X.X`, which is not a dependency hence is
-- missing from allInstPkgsIdx. Filter that out.
availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys
handleDepClosureFailure unsatisfied =
error $
"Computation of transitive dependencies failed."
++ if null unsatisfied
then ""
else " Unresolved dependencies: " ++ show unsatisfied
testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [UnitId]
testDeps xs ys =
map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys
|
