2 import Distribution.PackageDescription
3 import Distribution.Simple
4 import Distribution.Simple.Configure
5 import Distribution.Simple.LocalBuildInfo
6 import Distribution.Simple.Program
7 import Distribution.Simple.Setup
8 import Distribution.Simple.Utils
9 import Distribution.Verbosity
10 import System.Environment
16 ghcpkg : ghcpkgconf : destdir : topdir :
17 iprefix : ibindir : ilibdir : ilibexecdir :
18 idatadir : idocdir : ihtmldir : iinterfacedir :
20 let verbosity = case args' of
27 _ -> error ("Bad arguments: " ++ show args)
28 in doit verbosity ghcpkg ghcpkgconf destdir topdir
29 iprefix ibindir ilibdir ilibexecdir idatadir
30 idocdir ihtmldir iinterfacedir
32 error "Missing arguments"
34 doit :: Verbosity -> FilePath -> FilePath -> FilePath -> FilePath
35 -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
36 -> FilePath -> FilePath -> FilePath
38 doit verbosity ghcpkg ghcpkgconf destdir topdir
39 iprefix ibindir ilibdir ilibexecdir idatadir
40 idocdir ihtmldir iinterfacedir =
41 do let userHooks = simpleUserHooks
42 copyto = if null destdir then NoCopyDest else CopyTo destdir
43 copyFlags = (emptyCopyFlags copyto) {
44 copyVerbose = verbosity
46 registerFlags = emptyRegisterFlags {
47 regPackageDB = Just GlobalPackageDB,
48 regVerbose = verbosity,
52 lbi <- getConfig verbosity
53 let pd = localPkgDescr lbi
54 i = installDirTemplates lbi
55 -- XXX This is an almighty hack, shadowing the base
57 mkLib filt = case library pd of
59 let ems = filter filt $ exposedModules lib
64 error "Expected a library, but none found"
65 -- There's no files for GHC.Prim, so we will fail if we
67 pd_copy = pd { library = Just (mkLib ("GHC.Prim" /=)) }
68 pd_reg = pd { library = Just (mkLib (const True)) }
69 -- When coying, we need to actually give a concrete
70 -- directory to copy to rather than "$topdir"
71 toPathTemplate' = toPathTemplate . replaceTopdir topdir
72 i_copy = i { prefixDirTemplate = toPathTemplate' iprefix,
73 binDirTemplate = toPathTemplate' ibindir,
74 libDirTemplate = toPathTemplate' ilibdir,
75 libexecDirTemplate = toPathTemplate' ilibexecdir,
76 dataDirTemplate = toPathTemplate' idatadir,
77 docDirTemplate = toPathTemplate' idocdir,
78 htmlDirTemplate = toPathTemplate' ihtmldir,
79 interfaceDirTemplate = toPathTemplate' iinterfacedir
81 lbi_copy = lbi { installDirTemplates = i_copy }
82 -- When we run GHC we give it a $topdir that includes the
83 -- $compiler/lib/ part of libsubdir, so we only want the
84 -- $pkgid part in the package.conf file. This is a bit of
86 progs = withPrograms lbi
87 prog = ConfiguredProgram {
88 programId = programName ghcPkgProgram,
89 programVersion = Nothing,
90 programArgs = ["--force", "--global-conf", ghcpkgconf],
91 programLocation = UserSpecified ghcpkg
93 progs' = updateProgram prog progs
94 i_reg = i { prefixDirTemplate = toPathTemplate iprefix,
95 binDirTemplate = toPathTemplate ibindir,
96 libDirTemplate = toPathTemplate ilibdir,
97 libexecDirTemplate = toPathTemplate ilibexecdir,
98 dataDirTemplate = toPathTemplate idatadir,
99 docDirTemplate = toPathTemplate idocdir,
100 htmlDirTemplate = toPathTemplate ihtmldir,
101 interfaceDirTemplate = toPathTemplate iinterfacedir
103 lbi_reg = lbi { installDirTemplates = i_reg,
104 withPrograms = progs' }
105 (copyHook simpleUserHooks) pd_copy lbi_copy userHooks copyFlags
106 (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags
109 replaceTopdir :: FilePath -> FilePath -> FilePath
110 replaceTopdir topdir ('$':'t':'o':'p':'d':'i':'r':p) = topdir ++ p
111 replaceTopdir topdir ('$':'h':'t':'t':'p':'t':'o':'p':'d':'i':'r':p)
113 replaceTopdir _ p = p
115 -- Get the build info, merging the setup-config and buildinfo files.
116 getConfig :: Verbosity -> IO LocalBuildInfo
117 getConfig verbosity = do
118 lbi <- getPersistBuildConfig
119 maybe_infoFile <- defaultHookedPackageDesc
120 case maybe_infoFile of
121 Nothing -> return lbi
123 hbi <- readHookedBuildInfo verbosity infoFile
124 return lbi { localPkgDescr = updatePackageDescription hbi (localPkgDescr lbi)}