Move installPackage out into its own cabal package under utils/

4 files changed, 200 insertions, 1 deletions

diff --git a/utils/Makefile b/utils/Makefile
index 30cf832053..72bb31a33a 100644
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -9,7 +9,7 @@ ifeq "$(BootingFromHc)" "YES"
 SUBDIRS = mkdependC mkdirhier runstdtest genapply genprimopcode ghc-pkg unlit
 else
 SUBDIRS = mkdependC mkdirhier runstdtest ghc-pkg hasktags hp2ps hsc2hs \
-	  parallel unlit genprimopcode genapply runghc hpc pwd
+	  installPackage parallel unlit genprimopcode genapply runghc hpc pwd
 endif
 ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
 # lndir doesn't build on Windows
diff --git a/utils/installPackage/Makefile b/utils/installPackage/Makefile
new file mode 100644
index 0000000000..0397035d64
--- /dev/null
+++ b/utils/installPackage/Makefile
@@ -0,0 +1,37 @@
+
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/cabal-flags.mk
+
+boot:
+	$(CABAL) configure --distpref dist-inplace \
+	                   $(INPLACE_DIRS_CONFIGURE_FLAGS) \
+	                   $(USE_BOOT_CONFIGURE_FLAGS) \
+	                   $(COMMON_CONFIGURE_FLAGS)
+	$(CABAL) build     --distpref dist-inplace $(BUILD_FLAGS)
+	$(CABAL) install   --distpref dist-inplace
+
+# XXX
+#all:
+#	$(CABAL) configure --distpref dist-install \
+#	                   $(INPLACE_DIRS_CONFIGURE_FLAGS) \
+#	                   $(USE_STAGE1_CONFIGURE_FLAGS) \
+#	                   $(COMMON_CONFIGURE_FLAGS)
+#	$(CABAL) build     --distpref dist-install $(BUILD_FLAGS)
+
+all:
+
+clean: distclean
+
+distclean:
+	-$(CABAL) clean --distpref dist-inplace
+	-$(CABAL) clean --distpref dist-install
+
+# XXX fix:
+#binary-dist:
+#	$(INSTALL_DIR)                      $(BIN_DIST_DIR)/utils/hsc2hs
+#	$(INSTALL_DATA)    Makefile         $(BIN_DIST_DIR)/utils/hsc2hs/
+#	$(INSTALL_DATA)    hsc2hs.sh        $(BIN_DIST_DIR)/utils/hsc2hs/
+#	$(INSTALL_DATA)    $(INSTALL_DATAS) $(BIN_DIST_DIR)/utils/hsc2hs/
+#	$(INSTALL_PROGRAM) $(HS_PROG)       $(BIN_DIST_DIR)/utils/hsc2hs/
+
diff --git a/utils/installPackage/installPackage.cabal b/utils/installPackage/installPackage.cabal
new file mode 100644
index 0000000000..ab078200d5
--- /dev/null
+++ b/utils/installPackage/installPackage.cabal
@@ -0,0 +1,28 @@
+Name: installPackage
+-- XXX
+Version: 1.0
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: XXX
+Description:
+	XXX
+Category: XXX
+build-type: Simple
+cabal-version: >=1.2
+
+--Flag base3
+--  Description: Choose the new smaller, split-up base package.
+
+Executable installPackage
+    Main-Is: installPackage.hs
+    Build-Depends: base, Cabal
+--  if flag(base3)
+--      Build-Depends: base       >= 3   && < 4,
+--                     directory  >= 1   && < 1.1,
+--                     process    >= 1   && < 1.1
+--  else
+--      Build-Depends: base < 3
+
diff --git a/utils/installPackage/installPackage.hs b/utils/installPackage/installPackage.hs
new file mode 100644
index 0000000000..65eab5664b
--- /dev/null
+++ b/utils/installPackage/installPackage.hs
@@ -0,0 +1,134 @@
+
+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
+
+-- XXX This will need to be changed
+distPref :: FilePath
+distPref = defaultDistPref
+
+main :: IO ()
+main
+  = do args <- getArgs
+       case args of
+           "install" : ghcpkg : ghcpkgconf : destdir : topdir :
+                    iprefix : ibindir : ilibdir : ilibexecdir : idynlibdir :
+                    idatadir : idocdir : ihtmldir : ihaddockdir :
+                    args' ->
+               let verbosity = mkVerbosity args'
+               in doInstall verbosity ghcpkg ghcpkgconf destdir topdir
+                            iprefix ibindir ilibdir ilibexecdir idynlibdir idatadir
+                            idocdir ihtmldir ihaddockdir
+           _ ->
+               error ("Bad arguments: " ++ show args)
+
+mkVerbosity :: [String] -> Verbosity
+mkVerbosity [] = normal
+mkVerbosity ['-':'v':v] = readEOrFail flagToVerbosity v
+mkVerbosity args = error ("Bad arguments: " ++ show args)
+
+doInstall :: Verbosity -> FilePath -> FilePath -> FilePath -> FilePath
+          -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
+          -> FilePath -> FilePath -> FilePath -> FilePath
+          -> IO ()
+doInstall verbosity 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 {
+                              copyDest = toFlag copyto,
+                              copyVerbosity = toFlag verbosity
+                          }
+              registerFlags = defaultRegisterFlags {
+                                  regPackageDB = toFlag GlobalPackageDB,
+                                  regVerbosity = toFlag verbosity,
+                                  regGenScript = toFlag $ False,
+                                  regInPlace = toFlag $ False
+                              }
+          lbi <- getConfig verbosity
+          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 }
+              -- 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
+          (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 -> IO LocalBuildInfo
+getConfig verbosity = 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)}
+
+