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