1{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
2module Main (main) where
3
4import Data.List ( nub, sortBy )
5import Data.Ord ( comparing )
6import Distribution.Package ( PackageId, UnitId, packageVersion, packageName )
7import Distribution.PackageDescription ( PackageDescription(), Executable(..) )
8import Distribution.InstalledPackageInfo (sourcePackageId, installedUnitId)
9import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
10import Distribution.Simple.Utils ( rewriteFileEx, createDirectoryIfMissingVerbose )
11import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
12import Distribution.Simple.PackageIndex (allPackages, dependencyClosure)
13import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )
14import Distribution.Simple.LocalBuildInfo ( installedPkgs, withLibLBI, withExeLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
15import Distribution.Types.PackageName (PackageName, unPackageName)
16import Distribution.Types.UnqualComponentName (unUnqualComponentName)
17import Distribution.Verbosity ( Verbosity, normal )
18import Distribution.Pretty ( prettyShow )
19import System.FilePath ( (</>) )
20
21main :: IO ()
22main = defaultMainWithHooks simpleUserHooks
23  { buildHook = \pkg lbi hooks flags -> do
24     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
25     buildHook simpleUserHooks pkg lbi hooks flags
26  }
27
28generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
29generateBuildModule verbosity pkg lbi = do
30  let dir = autogenPackageModulesDir lbi
31  createDirectoryIfMissingVerbose verbosity True dir
32  withLibLBI pkg lbi $ \_ libcfg -> do
33    withExeLBI pkg lbi $ \exe clbi ->
34      rewriteFileEx normal (dir </> "Build_" ++ exeName' exe ++ ".hs") $ unlines
35        [ "module Build_" ++ exeName' exe ++ " where"
36        , ""
37        , "deps :: [String]"
38        , "deps = " ++ (show $ formatdeps (transDeps libcfg clbi))
39        ]
40  where
41    exeName' = unUnqualComponentName . exeName
42    formatdeps = map formatone . sortBy (comparing unPackageName')
43    formatone p = unPackageName' p ++ "-" ++ prettyShow (packageVersion p)
44    unPackageName' = unPackageName . packageName
45    transDeps xs ys =
46      either (map sourcePackageId . allPackages) handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds
47      where
48        allInstPkgsIdx = installedPkgs lbi
49        allInstPkgIds = map installedUnitId $ allPackages allInstPkgsIdx
50        -- instPkgIds includes `stack-X.X.X`, which is not a dependency hence is missing from allInstPkgsIdx. Filter that out.
51        availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys
52        handleDepClosureFailure unsatisfied =
53          error $
54            "Computation of transitive dependencies failed." ++
55            if null unsatisfied then "" else " Unresolved dependencies: " ++ show unsatisfied
56
57testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [UnitId]
58testDeps xs ys = map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys
59