Avoid the need to rerun configure when we install

This also means we don't need to carry around 10s of megs of Setup
executables in bindists.

1 files changed, 60 insertions, 0 deletions

diff --git a/libraries/installPackage.hs b/libraries/installPackage.hs
new file mode 100644
index 0000000000..dcba287ddf
--- /dev/null
+++ b/libraries/installPackage.hs
@@ -0,0 +1,60 @@
+
+import Distribution.PackageDescription
+import Distribution.Setup
+import Distribution.Simple
+import Distribution.Simple.Configure
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Utils
+import Distribution.Verbosity
+import System.Environment
+
+main :: IO ()
+main = do args <- getArgs
+          let verbosity = case args of
+                              [] -> normal
+                              ['-':'v':v] ->
+                                  let m = case v of
+                                              "" -> Nothing
+                                              _ -> Just v
+                                  in flagToVerbosity m
+                              _ -> error ("Bad arguments: " ++ show args)
+              userHooks = simpleUserHooks
+              installFlags = InstallFlags {
+                                 installUserFlags = MaybeUserGlobal,
+                                 installVerbose = verbosity
+                             }
+          pdFile <- defaultPackageDesc verbosity
+          pd <- readPackageDescription verbosity pdFile
+          lbi <- getPersistBuildConfig
+          let -- XXX This is an almighty hack, shadowing the base Setup.hs hack
+              lib' = case library pd of
+                         Just lib ->
+                             lib {
+                                 exposedModules = filter (("GHC.Prim" /=))
+                                                $ exposedModules lib
+                                 }
+                         Nothing ->
+                             error "Expected a library, but none found"
+              pd' = pd { library = Just lib' }
+              -- When installing we need to use the non-inplace ghc-pkg.
+              -- We also set the compiler to be non-inplace, but that
+              -- probably doesn't matter.
+              c = compiler lbi
+              c' = c { compilerPath = dropInPlace (compilerPath c),
+                       compilerPkgTool = dropInPlace (compilerPkgTool c)
+                     }
+              lbi' = lbi { compiler = c' }
+          (instHook simpleUserHooks) pd' lbi' userHooks installFlags
+
+dropInPlace :: FilePath -> FilePath
+dropInPlace "" = ""
+dropInPlace xs@(x:xs') = case dropPrefix "-inplace" xs of
+                             Nothing -> x : dropInPlace xs'
+                             Just xs'' -> dropInPlace xs''
+
+dropPrefix :: Eq a => [a] -> [a] -> Maybe [a]
+dropPrefix [] ys = Just ys
+dropPrefix (x:xs) (y:ys)
+ | x == y = dropPrefix xs ys
+dropPrefix _ _ = Nothing
+