Permalink
Browse files

Merge pull request #1011 from 23Skidoo/cabal-sandbox

  • Loading branch information...
2 parents bdc9997 + d8fcb94 commit b5845e0abb2e32ae243866beaa4c4c0e523ef34f @tibbe tibbe committed Aug 24, 2012
@@ -65,6 +65,7 @@ module Distribution.Simple.GHC (
buildLib, buildExe,
installLib, installExe,
libAbiHash,
+ initPackageDB,
registerPackage,
componentGhcOptions,
ghcLibDir,
@@ -1104,10 +1105,15 @@ updateLibArchive verbosity lbi path
rawSystemProgram verbosity ranlib [path]
| otherwise = return ()
-
-- -----------------------------------------------------------------------------
-- Registering
+-- | Create an empty package DB at the specified location.
+initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO ()
+initPackageDB verbosity conf dbPath = HcPkg.init verbosity ghcPkgProg dbPath
+ where
+ Just ghcPkgProg = lookupProgram ghcPkgProgram conf
+
registerPackage
:: Verbosity
-> InstalledPackageInfo
@@ -10,6 +10,7 @@
-- Currently only GHC and LHC have hc-pkg programs.
module Distribution.Simple.Program.HcPkg (
+ init,
register,
reregister,
unregister,
@@ -18,6 +19,7 @@ module Distribution.Simple.Program.HcPkg (
dump,
-- * Program invocations
+ initInvocation,
registerInvocation,
reregisterInvocation,
unregisterInvocation,
@@ -26,6 +28,7 @@ module Distribution.Simple.Program.HcPkg (
dumpInvocation,
) where
+import Prelude hiding (init)
import Distribution.Package
( PackageId, InstalledPackageId(..) )
import Distribution.InstalledPackageInfo
@@ -62,6 +65,15 @@ import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
+-- | Call @hc-pkg@ to initialise a package database at the location {path}.
+--
+-- > hc-pkg init {path}
+--
+init :: Verbosity -> ConfiguredProgram -> FilePath -> IO ()
+init verbosity hcPkg path =
+ runProgramInvocation verbosity
+ (initInvocation hcPkg verbosity path)
+
-- | Call @hc-pkg@ to register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
@@ -228,6 +240,14 @@ setInstalledPackageId pkginfo = pkginfo
-- The program invocations
--
+initInvocation :: ConfiguredProgram
+ -> Verbosity -> FilePath -> ProgramInvocation
+initInvocation hcPkg verbosity path =
+ programInvocation hcPkg args
+ where
+ args = ["init", path]
+ ++ verbosityOpts hcPkg verbosity
+
registerInvocation, reregisterInvocation
:: ConfiguredProgram -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
@@ -57,6 +57,7 @@ module Distribution.Simple.Register (
register,
unregister,
+ initPackageDB,
registerPackage,
generateRegistrationInfo,
inplaceInstalledPackageInfo,
@@ -73,11 +74,12 @@ import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import Distribution.Simple.Compiler
- ( compilerVersion, CompilerFlavor(..), compilerFlavor
+ ( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor
, PackageDBStack, registrationPackageDB )
import Distribution.Simple.Program
- ( ConfiguredProgram, runProgramInvocation
- , requireProgram, lookupProgram, ghcPkgProgram, lhcPkgProgram )
+ ( ProgramConfiguration, ConfiguredProgram
+ , runProgramInvocation, requireProgram, lookupProgram
+ , ghcPkgProgram, lhcPkgProgram )
import Distribution.Simple.Program.Script
( invocationAsSystemScript )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
@@ -204,6 +206,14 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do
return installedPkgInfo{ IPI.installedPackageId = ipid }
+-- | Create an empty package DB at the specified location.
+initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath
+ -> IO ()
+initPackageDB verbosity comp conf dbPath =
+ case (compilerFlavor comp) of
+ GHC -> GHC.initPackageDB verbosity conf dbPath
+ _ -> die "initPackageDB is not implemented for this compiler"
+
registerPackage :: Verbosity
-> InstalledPackageInfo
-> PackageDescription
@@ -75,7 +75,7 @@ module Distribution.Simple.Setup (
BenchmarkFlags(..), emptyBenchmarkFlags, defaultBenchmarkFlags, benchmarkCommand,
CopyDest(..),
configureArgs, configureOptions, configureCCompiler, configureLinker,
- installDirsOptions,
+ buildOptions, installDirsOptions,
defaultDistPref,
@@ -1225,22 +1225,26 @@ defaultBuildFlags = BuildFlags {
}
buildCommand :: ProgramConfiguration -> CommandUI BuildFlags
-buildCommand progConf = makeCommand name shortDesc longDesc defaultBuildFlags options
+buildCommand progConf = makeCommand name shortDesc longDesc
+ defaultBuildFlags (buildOptions progConf)
where
name = "build"
shortDesc = "Make this package ready for installation."
longDesc = Nothing
- options showOrParseArgs =
- optionVerbosity buildVerbosity (\v flags -> flags { buildVerbosity = v })
- : optionDistPref
- buildDistPref (\d flags -> flags { buildDistPref = d })
- showOrParseArgs
- : programConfigurationPaths progConf showOrParseArgs
- buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
+buildOptions :: ProgramConfiguration -> ShowOrParseArgs
+ -> [OptionField BuildFlags]
+buildOptions progConf showOrParseArgs =
+ optionVerbosity buildVerbosity (\v flags -> flags { buildVerbosity = v })
+ : optionDistPref
+ buildDistPref (\d flags -> flags { buildDistPref = d })
+ showOrParseArgs
+
+ : programConfigurationPaths progConf showOrParseArgs
+ buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
- ++ programConfigurationOptions progConf showOrParseArgs
- buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
+ ++ programConfigurationOptions progConf showOrParseArgs
+ buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
emptyBuildFlags :: BuildFlags
emptyBuildFlags = mempty
@@ -5,7 +5,7 @@ module Distribution.Client.Dependency.Modular.PSQ where
-- I am not yet sure what exactly is needed. But we need a datastructure with
-- key-based lookup that can be sorted. We're using a sequence right now with
-- (inefficiently implemented) lookup, because I think that queue-based
--- opertions and sorting turn out to be more efficiency-critical in practice.
+-- operations and sorting turn out to be more efficiency-critical in practice.
import Control.Applicative
import Data.Foldable
@@ -29,7 +29,7 @@ import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
, makeAbsoluteToCwd )
import Distribution.Simple.Setup ( fromFlagOrDefault )
-import Distribution.Simple.Utils ( die, debug, notice, warn, findPackageDesc )
+import Distribution.Simple.Utils ( die, debug, notice, findPackageDesc )
import Distribution.Verbosity ( Verbosity )
import qualified Data.ByteString.Lazy as BS
@@ -144,7 +144,7 @@ createEmpty :: Verbosity -> FilePath -> IO ()
createEmpty verbosity path = do
indexExists <- doesFileExist path
if indexExists
- then warn verbosity $ "package index already exists: '" ++ path ++ "'"
+ then debug verbosity $ "Package index already exists: " ++ path
else do
debug verbosity $ "Creating the index file '" ++ path ++ "'"
createDirectoryIfMissing True (takeDirectory path)
Oops, something went wrong.

0 comments on commit b5845e0

Please sign in to comment.