diff options
Diffstat (limited to 'utils/installPackage/installPackage.hs')
| -rw-r--r-- | utils/installPackage/installPackage.hs | 154 |
1 files changed, 0 insertions, 154 deletions
diff --git a/utils/installPackage/installPackage.hs b/utils/installPackage/installPackage.hs deleted file mode 100644 index 9ec7282592..0000000000 --- a/utils/installPackage/installPackage.hs +++ /dev/null @@ -1,154 +0,0 @@ - -import Control.Monad -import Data.Maybe -import Distribution.PackageDescription -import Distribution.PackageDescription.Parse -import Distribution.ReadE -import Distribution.Simple -import Distribution.Simple.Configure -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Program -import Distribution.Simple.Setup -import Distribution.Simple.Utils -import Distribution.Text -import Distribution.Verbosity -import System.Environment - -main :: IO () -main - = do args <- getArgs - case args of - "install" : ghcpkg : ghcpkgconf : destdir : topdir : - iprefix : ibindir : ilibdir : ilibexecdir : idynlibdir : - idatadir : idocdir : ihtmldir : ihaddockdir : - args' -> - case parseArgs args' of - (verbosity, distPref, enableShellWrappers, strip) -> - doInstall verbosity distPref enableShellWrappers strip - ghcpkg ghcpkgconf destdir topdir - iprefix ibindir ilibdir ilibexecdir - idynlibdir idatadir idocdir ihtmldir - ihaddockdir - _ -> - error ("Bad arguments: " ++ show args) - --- XXX We should really make Cabal do the hardwork here -parseArgs :: [String] - -> (Verbosity, -- verbosity - FilePath, -- dist prefix - Bool, -- enable shell wrappers? - Bool) -- strip exe? -parseArgs = f normal defaultDistPref False True - where f _ dp esw strip (('-':'v':val):args) - = f (readEOrFail flagToVerbosity val) dp esw strip args - f v _ esw strip ("--distpref":dp:args) = f v dp esw strip args - f v dp _ strip ("--enable-shell-wrappers":args) = f v dp True strip args - f v dp esw _ ("--disable-executable-stripping":args) = f v dp esw False args - f v dp esw strip [] = (v, dp, esw, strip) - f _ _ _ _ args = error ("Bad arguments: " ++ show args) - -doInstall :: Verbosity -> FilePath -> Bool -> Bool - -> FilePath -> FilePath -> FilePath -> FilePath - -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath - -> FilePath -> FilePath -> FilePath -> FilePath - -> IO () -doInstall verbosity distPref enableShellWrappers strip - ghcpkg ghcpkgconf destdir topdir - iprefix ibindir ilibdir ilibexecdir idynlibdir idatadir - idocdir ihtmldir ihaddockdir = - do let userHooks = simpleUserHooks - copyto = if null destdir then NoCopyDest else CopyTo destdir - copyFlags = defaultCopyFlags { - copyDistPref = toFlag distPref, - copyUseWrapper = toFlag enableShellWrappers, - copyDest = toFlag copyto, - copyVerbosity = toFlag verbosity - } - registerFlags = defaultRegisterFlags { - regDistPref = toFlag distPref, - regPackageDB = toFlag GlobalPackageDB, - regVerbosity = toFlag verbosity, - regGenScript = toFlag $ False, - regInPlace = toFlag $ False - } - lbi <- getConfig verbosity distPref - let pd = localPkgDescr lbi - i = installDirTemplates lbi - -- This is an almighty hack. We need to register - -- ghc-prim:GHC.Prim, but it doesn't exist, get built, get - -- haddocked, get copied, etc. - pd_reg = if packageName pd == PackageName "ghc-prim" - then case library pd of - Just lib -> - let ems = fromJust (simpleParse "GHC.Prim") - : exposedModules lib - lib' = lib { exposedModules = ems } - in pd { library = Just lib' } - Nothing -> - error "Expected a library, but none found" - else pd - -- When coying, we need to actually give a concrete - -- directory to copy to rather than "$topdir" - toPathTemplate' = toPathTemplate . replaceTopdir topdir - i_copy = i { prefix = toPathTemplate' iprefix, - bindir = toPathTemplate' ibindir, - libdir = toPathTemplate' ilibdir, - dynlibdir = toPathTemplate' idynlibdir, - libexecdir = toPathTemplate' ilibexecdir, - datadir = toPathTemplate' idatadir, - docdir = toPathTemplate' idocdir, - htmldir = toPathTemplate' ihtmldir, - haddockdir = toPathTemplate' ihaddockdir - } - lbi_copy = lbi { installDirTemplates = i_copy, - stripExes = strip } - -- When we run GHC we give it a $topdir that includes the - -- $compiler/lib/ part of libsubdir, so we only want the - -- $pkgid part in the package.conf file. This is a bit of - -- a hack, really. - progs = withPrograms lbi - prog = ConfiguredProgram { - programId = programName ghcPkgProgram, - programVersion = Nothing, - programArgs = ["--force", "--global-conf", ghcpkgconf], - programLocation = UserSpecified ghcpkg - } - progs' = updateProgram prog progs - i_reg = i { prefix = toPathTemplate iprefix, - bindir = toPathTemplate ibindir, - libdir = toPathTemplate ilibdir, - dynlibdir = toPathTemplate idynlibdir, - libexecdir = toPathTemplate ilibexecdir, - datadir = toPathTemplate idatadir, - docdir = toPathTemplate idocdir, - htmldir = toPathTemplate ihtmldir, - haddockdir = toPathTemplate ihaddockdir - } - lbi_reg = lbi { installDirTemplates = i_reg, - withPrograms = progs' } - (copyHook simpleUserHooks) pd lbi_copy userHooks copyFlags - -- Cabal prints a scary "Package contains no library to register" - -- message if we call register but this is an executable package. - -- We therefore don't call it if we don't have a library for it. - when (isJust (library pd_reg)) $ - (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags - return () - -replaceTopdir :: FilePath -> FilePath -> FilePath -replaceTopdir topdir ('$':'t':'o':'p':'d':'i':'r':p) = topdir ++ p -replaceTopdir topdir ('$':'h':'t':'t':'p':'t':'o':'p':'d':'i':'r':p) - = topdir ++ p -replaceTopdir _ p = p - --- Get the build info, merging the setup-config and buildinfo files. -getConfig :: Verbosity -> FilePath -> IO LocalBuildInfo -getConfig verbosity distPref = do - lbi <- getPersistBuildConfig distPref - maybe_infoFile <- defaultHookedPackageDesc - case maybe_infoFile of - Nothing -> return lbi - Just infoFile -> do - hbi <- readHookedBuildInfo verbosity infoFile - return lbi { localPkgDescr = updatePackageDescription hbi (localPkgDescr lbi)} - - |