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
|
module Main
( main
) where
import Data.List ( nub, sortOn )
import Distribution.InstalledPackageInfo
( sourcePackageId, installedUnitId )
import Distribution.Package ( UnitId, packageVersion, packageName )
import Distribution.PackageDescription
( PackageDescription (), Executable (..) )
import Distribution.Pretty ( prettyShow )
import Distribution.Simple
( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
import Distribution.Simple.LocalBuildInfo
( installedPkgs, withLibLBI, withExeLBI, LocalBuildInfo ()
, ComponentLocalBuildInfo (componentPackageDeps)
)
import Distribution.Simple.PackageIndex
( allPackages, dependencyClosure )
import Distribution.Simple.Setup
( BuildFlags (..), ReplFlags (..), fromFlag )
import Distribution.Simple.Utils
( rewriteFileEx, createDirectoryIfMissingVerbose )
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 ->
rewriteFileEx normal (dir </> "Build_" ++ exeName' exe ++ ".hs") $ unlines
[ "module Build_" ++ exeName' exe
, " ( deps"
, " ) where"
, ""
, "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
|
