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.Utils.Path ( interpretSymbolicPathCWD )

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 = interpretSymbolicPathCWD (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