3 import Distribution.PackageDescription
4 import Distribution.PackageDescription.Parse
5 import Distribution.ReadE
6 import Distribution.Simple
7 import Distribution.Simple.Configure
8 import Distribution.Simple.LocalBuildInfo
9 import Distribution.Simple.Program
10 import Distribution.Simple.Setup
11 import Distribution.Simple.Utils
12 import Distribution.Text
13 import Distribution.Verbosity
14 import System.Environment
20 "install" : ghcpkg : ghcpkgconf : destdir : topdir :
21 iprefix : ibindir : ilibdir : ilibexecdir : idynlibdir :
22 idatadir : idocdir : ihtmldir : ihaddockdir :
24 case parseArgs args' of
25 (verbosity, distPref, enableShellWrappers, strip) ->
26 doInstall verbosity distPref enableShellWrappers strip
27 ghcpkg ghcpkgconf destdir topdir
28 iprefix ibindir ilibdir ilibexecdir
29 idynlibdir idatadir idocdir ihtmldir
32 error ("Bad arguments: " ++ show args)
34 -- XXX We should really make Cabal do the hardwork here
36 -> (Verbosity, -- verbosity
37 FilePath, -- dist prefix
38 Bool, -- enable shell wrappers?
40 parseArgs = f normal defaultDistPref False True
41 where f v dp esw strip (('-':'v':val):args)
42 = f (readEOrFail flagToVerbosity val) dp esw strip args
43 f v _ esw strip ("--distpref":dp:args) = f v dp esw strip args
44 f v dp _ strip ("--enable-shell-wrappers":args) = f v dp True strip args
45 f v dp esw strip ("--disable-executable-stripping":args) = f v dp esw False args
46 f v dp esw strip [] = (v, dp, esw, strip)
47 f _ _ _ _ args = error ("Bad arguments: " ++ show args)
49 doInstall :: Verbosity -> FilePath -> Bool -> Bool
50 -> FilePath -> FilePath -> FilePath -> FilePath
51 -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
52 -> FilePath -> FilePath -> FilePath -> FilePath
54 doInstall verbosity distPref enableShellWrappers strip
55 ghcpkg ghcpkgconf destdir topdir
56 iprefix ibindir ilibdir ilibexecdir idynlibdir idatadir
57 idocdir ihtmldir ihaddockdir =
58 do let userHooks = simpleUserHooks
59 copyto = if null destdir then NoCopyDest else CopyTo destdir
60 copyFlags = defaultCopyFlags {
61 copyUseWrapper = toFlag enableShellWrappers,
62 copyDest = toFlag copyto,
63 copyVerbosity = toFlag verbosity
65 registerFlags = defaultRegisterFlags {
66 regPackageDB = toFlag GlobalPackageDB,
67 regVerbosity = toFlag verbosity,
68 regGenScript = toFlag $ False,
69 regInPlace = toFlag $ False
71 lbi <- getConfig verbosity distPref
72 let pd = localPkgDescr lbi
73 i = installDirTemplates lbi
74 -- This is an almighty hack. We need to register
75 -- ghc-prim:GHC.Prim, but it doesn't exist, get built, get
76 -- haddocked, get copied, etc.
77 pd_reg = if packageName pd == PackageName "ghc-prim"
78 then case library pd of
80 let ems = fromJust (simpleParse "GHC.Prim")
82 lib' = lib { exposedModules = ems }
83 in pd { library = Just lib' }
85 error "Expected a library, but none found"
87 -- When coying, we need to actually give a concrete
88 -- directory to copy to rather than "$topdir"
89 toPathTemplate' = toPathTemplate . replaceTopdir topdir
90 i_copy = i { prefix = toPathTemplate' iprefix,
91 bindir = toPathTemplate' ibindir,
92 libdir = toPathTemplate' ilibdir,
93 dynlibdir = toPathTemplate' idynlibdir,
94 libexecdir = toPathTemplate' ilibexecdir,
95 datadir = toPathTemplate' idatadir,
96 docdir = toPathTemplate' idocdir,
97 htmldir = toPathTemplate' ihtmldir,
98 haddockdir = toPathTemplate' ihaddockdir
100 lbi_copy = lbi { installDirTemplates = i_copy,
102 -- When we run GHC we give it a $topdir that includes the
103 -- $compiler/lib/ part of libsubdir, so we only want the
104 -- $pkgid part in the package.conf file. This is a bit of
106 progs = withPrograms lbi
107 prog = ConfiguredProgram {
108 programId = programName ghcPkgProgram,
109 programVersion = Nothing,
110 programArgs = ["--force", "--global-conf", ghcpkgconf],
111 programLocation = UserSpecified ghcpkg
113 progs' = updateProgram prog progs
114 i_reg = i { prefix = toPathTemplate iprefix,
115 bindir = toPathTemplate ibindir,
116 libdir = toPathTemplate ilibdir,
117 dynlibdir = toPathTemplate idynlibdir,
118 libexecdir = toPathTemplate ilibexecdir,
119 datadir = toPathTemplate idatadir,
120 docdir = toPathTemplate idocdir,
121 htmldir = toPathTemplate ihtmldir,
122 haddockdir = toPathTemplate ihaddockdir
124 lbi_reg = lbi { installDirTemplates = i_reg,
125 withPrograms = progs' }
126 (copyHook simpleUserHooks) pd lbi_copy userHooks copyFlags
127 (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags
130 replaceTopdir :: FilePath -> FilePath -> FilePath
131 replaceTopdir topdir ('$':'t':'o':'p':'d':'i':'r':p) = topdir ++ p
132 replaceTopdir topdir ('$':'h':'t':'t':'p':'t':'o':'p':'d':'i':'r':p)
134 replaceTopdir _ p = p
136 -- Get the build info, merging the setup-config and buildinfo files.
137 getConfig :: Verbosity -> FilePath -> IO LocalBuildInfo
138 getConfig verbosity distPref = do
139 lbi <- getPersistBuildConfig distPref
140 maybe_infoFile <- defaultHookedPackageDesc
141 case maybe_infoFile of
142 Nothing -> return lbi
144 hbi <- readHookedBuildInfo verbosity infoFile
145 return lbi { localPkgDescr = updatePackageDescription hbi (localPkgDescr lbi)}