Commit 0f7a7ca5 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Make cabal-install use setupWrapper (the library version of cabal-setup).

parent 193c8bad
......@@ -25,8 +25,9 @@ import Distribution.PackageDescription
PackageDescription(..) )
import System.Console.GetOpt
import System.Directory
import Control.Exception ( finally )
import Control.Monad ( when, unless )
import System.Directory ( doesFileExist )
import System.Directory ( doesFileExist, getCurrentDirectory, setCurrentDirectory )
-- read the .cabal file
-- - attempt to find the version of Cabal required
......@@ -44,8 +45,11 @@ import System.Directory ( doesFileExist )
-- - add support for multiple packages, by figuring out
-- dependencies here and building/installing the sub packages
-- in the right order.
setupWrapper :: [String] -> IO ()
setupWrapper args = do
setupWrapper ::
[String] -- ^ Command-line arguments.
-> Maybe FilePath -- ^ Directory to run in. If 'Nothing', the current directory is used.
-> IO ()
setupWrapper args mdir = inDir mdir $ do
pkg_descr_file <- defaultPackageDesc
pkg_descr <- readPackageDescription pkg_descr_file
......@@ -87,6 +91,13 @@ setupWrapper args = do
"import Distribution.Simple; main=defaultMain"
trySetupScript ".Setup.hs" $ error "panic! shouldn't happen"
inDir :: Maybe FilePath -> IO () -> IO ()
inDir Nothing m = m
inDir (Just d) m = do
old <- getCurrentDirectory
setCurrentDirectory d
m `finally` setCurrentDirectory old
data Flags
= Flags {
withCompiler :: Maybe FilePath,
......
......@@ -62,6 +62,7 @@ defaultOutputGen verbose
, showOtherPackageInfo = showOtherPkg
, cmdStdout = outch
, cmdStderr = errch
, message = \v s -> when (verbose >= v) (putStrLn s)
}
where showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
......
......@@ -25,13 +25,16 @@ import Network.Hackage.CabalInstall.Types (ConfigFlags(..), UnresolvedDependency
,OutputGen(..))
import Network.Hackage.CabalInstall.TarUtils
import Distribution.SetupWrapper (setupWrapper)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Package (showPackageId, PackageIdentifier)
import Distribution.Compat.FilePath (joinFileName, splitFileName)
import Text.Printf (printf)
import Data.Maybe (fromMaybe, maybeToList)
import Text.Printf (printf, PrintfType)
import System.Directory (getTemporaryDirectory, createDirectoryIfMissing
,removeDirectoryRecursive, copyFile)
import System.IO (hPutStrLn, stderr)
import System.Process (runProcess, waitForProcess, terminateProcess)
import System.Exit (ExitCode(..))
import System.Posix.Signals
......@@ -59,16 +62,14 @@ downloadPkg cfg pkg location
-- Attach the correct prefix flag to configure commands,
-- correct --user flag to install commands and no options to other commands.
mkPkgOps :: ConfigFlags -> String -> [String] -> [String]
mkPkgOps cfg "configure" ops
= let ops' = if configUserIns cfg then "--user":ops else ops
in case configPrefix cfg of
Nothing -> ops'
Just pref -> ("--prefix=" ++ pref):ops'
mkPkgOps cfg "install" _ops
| configUserIns cfg = return "--user"
mkPkgOps _cfg _ _ops
= []
mkPkgOps cfg cmd ops = verbosity ++
case cmd of
"configure" -> user ++ prefix ++ ops
"install" -> user
_ -> []
where verbosity = ["--verbose=" ++ show (configVerbose cfg)]
user = if configUserIns cfg then ["--user"] else []
prefix = maybeToList (fmap ("--prefix=" ++) (configPrefix cfg))
{-|
Download, build and install a given package with some given flags.
......@@ -79,15 +80,13 @@ mkPkgOps _cfg _ _ops
* The fetched tarball is then moved to a temporary directory (\/tmp on linux) and unpacked.
* The lowest directory with a .cabal file is located and searched for a \'Setup.lhs\' or
\'Setup.hs\' file.
* \'runhaskell [Setup script] configure\' is called with the user specified options, \'--user\'
* setupWrapper (equivalent to cabal-setup) is called with the options
\'configure\' and the user specified options, \'--user\'
if the 'configUser' flag is @True@ and \'--prefix=[PREFIX]\' if 'configPrefix' is not @Nothing@.
* \'runhaskell [Setup script] build\' is called with no options.
* setupWrapper \'build\' is called with no options.
* \'runhaskell [Setup script] install\' is called with the \'--user\' flag if 'configUserIns' is @True@.
* setupWrapper \'install\' is called with the \'--user\' flag if 'configUserIns' is @True@.
* The installation finishes by deleting the unpacked tarball.
-}
......@@ -100,22 +99,15 @@ installPkg cfg globalArgs (pkg,ops,location)
tmp <- getTemporaryDirectory
let tmpDirPath = tmp `joinFileName` printf "TMP%sTMP" (showPackageId pkg)
tmpPkgPath = tmpDirPath `joinFileName` printf "TAR%s.tgz" (showPackageId pkg)
setup setupScript cmd
= let (path,script) = splitFileName setupScript
cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
in do executingCmd output runHc (script:cmd:cmdOps)
h <- runProcess runHc (script:cmd:cmdOps)
(Just (tmpDirPath `joinFileName` path))
Nothing Nothing (cmdStdout output) (cmdStderr output)
oldHandler <- installHandler keyboardSignal (Catch (terminateProcess h)) Nothing
e <- waitForProcess h
installHandler keyboardSignal oldHandler Nothing
case e of
ExitFailure err -> cmdFailed output cmd (script:cmd:cmdOps) err
_ -> return ()
setup cmd
= let cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
path = tmpDirPath `joinFileName` showPackageId pkg
in do message output 3 $ unwords ["setupWrapper", show (cmd:cmdOps), show path]
setupWrapper (cmd:cmdOps) (Just path)
bracket_ (createDirectoryIfMissing True tmpDirPath)
(removeDirectoryRecursive tmpDirPath)
(do copyFile pkgPath tmpPkgPath
message output 3 (printf "Extracting %s..." tmpPkgPath)
extractTarFile tarProg tmpPkgPath
installUnpackedPkg cfg pkg tmpPkgPath setup
return ())
......@@ -124,26 +116,21 @@ installPkg cfg globalArgs (pkg,ops,location)
output = configOutputGen cfg
installUnpackedPkg :: ConfigFlags -> PackageIdentifier -> FilePath
-> (String -> String -> IO ()) -> IO ()
-> (String -> IO ()) -> IO ()
installUnpackedPkg cfg pkgId tarFile setup
= do tarFiles <- tarballGetFiles tarProg tarFile
let cabalFile = locateFileExt tarFiles "cabal"
case cabalFile of
Just f -> let (path,_) = splitFileName f
mbScript = locateFile tarFiles path ["Setup.lhs", "Setup.hs"]
in case mbScript of
Just script
-> do buildingPkg output pkgId
stepConfigPkg output pkgId
setup script "configure"
stepBuildPkg output pkgId
setup script "build"
stepInstallPkg output pkgId
setup script "install"
stepFinishedPkg output pkgId
return ()
Nothing
-> noSetupScript output pkgId
in do buildingPkg output pkgId
stepConfigPkg output pkgId
setup "configure"
stepBuildPkg output pkgId
setup "build"
stepInstallPkg output pkgId
setup "install"
stepFinishedPkg output pkgId
return ()
Nothing -> noCabalFile output pkgId
where output = configOutputGen cfg
tarProg = configTarPath cfg
......@@ -102,6 +102,9 @@ data OutputGen
-> IO () -- Show package which isn't available from any server.
, cmdStdout :: Maybe Handle
, cmdStderr :: Maybe Handle
, -- | Output a message.
message :: Int -- ^ minimum verbosity needed to output this message
-> String -> IO ()
}
......
......@@ -17,4 +17,4 @@ import System.Environment
main = do
args <- getArgs
setupWrapper args
setupWrapper args Nothing
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment