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 -- This is an almighty hack. We need to register
56 -- base:GHC.Prim, but it doesn't exist, get built, get
57 -- haddocked, get copied, etc.
58 pd_reg = if pkgName (package pd) == "base"
59 then case library pd of
61 let ems = "GHC.Prim" : exposedModules lib
62 lib' = lib { exposedModules = ems }
63 in pd { library = Just lib' }
65 error "Expected a library, but none found"
67 -- When coying, we need to actually give a concrete
68 -- directory to copy to rather than "$topdir"
69 toPathTemplate' = toPathTemplate . replaceTopdir topdir
70 i_copy = i { prefixDirTemplate = toPathTemplate' iprefix,
71 binDirTemplate = toPathTemplate' ibindir,
72 libDirTemplate = toPathTemplate' ilibdir,
73 libexecDirTemplate = toPathTemplate' ilibexecdir,
74 dataDirTemplate = toPathTemplate' idatadir,
75 docDirTemplate = toPathTemplate' idocdir,
76 htmlDirTemplate = toPathTemplate' ihtmldir,
77 interfaceDirTemplate = toPathTemplate' iinterfacedir
79 lbi_copy = lbi { installDirTemplates = i_copy }
80 -- When we run GHC we give it a $topdir that includes the
81 -- $compiler/lib/ part of libsubdir, so we only want the
82 -- $pkgid part in the package.conf file. This is a bit of
84 progs = withPrograms lbi
85 prog = ConfiguredProgram {
86 programId = programName ghcPkgProgram,
87 programVersion = Nothing,
88 programArgs = ["--force", "--global-conf", ghcpkgconf],
89 programLocation = UserSpecified ghcpkg
91 progs' = updateProgram prog progs
92 i_reg = i { prefixDirTemplate = toPathTemplate iprefix,
93 binDirTemplate = toPathTemplate ibindir,
94 libDirTemplate = toPathTemplate ilibdir,
95 libexecDirTemplate = toPathTemplate ilibexecdir,
96 dataDirTemplate = toPathTemplate idatadir,
97 docDirTemplate = toPathTemplate idocdir,
98 htmlDirTemplate = toPathTemplate ihtmldir,
99 interfaceDirTemplate = toPathTemplate iinterfacedir
101 lbi_reg = lbi { installDirTemplates = i_reg,
102 withPrograms = progs' }
103 (copyHook simpleUserHooks) pd lbi_copy userHooks copyFlags
104 (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags
107 replaceTopdir :: FilePath -> FilePath -> FilePath
108 replaceTopdir topdir ('$':'t':'o':'p':'d':'i':'r':p) = topdir ++ p
109 replaceTopdir topdir ('$':'h':'t':'t':'p':'t':'o':'p':'d':'i':'r':p)
111 replaceTopdir _ p = p
113 -- Get the build info, merging the setup-config and buildinfo files.
114 getConfig :: Verbosity -> IO LocalBuildInfo
115 getConfig verbosity = do
116 lbi <- getPersistBuildConfig
117 maybe_infoFile <- defaultHookedPackageDesc
118 case maybe_infoFile of
119 Nothing -> return lbi
121 hbi <- readHookedBuildInfo verbosity infoFile
122 return lbi { localPkgDescr = updatePackageDescription hbi (localPkgDescr lbi)}