diff --git a/Distribution/Client/BuildReports/Anonymous.hs b/Distribution/Client/BuildReports/Anonymous.hs --- a/Distribution/Client/BuildReports/Anonymous.hs +++ b/Distribution/Client/BuildReports/Anonymous.hs @@ -27,7 +27,7 @@ ) where import Distribution.Client.Types - ( ConfiguredPackage(..), BuildResult ) + ( ConfiguredPackage(..) ) import qualified Distribution.Client.Types as BR ( BuildResult, BuildFailure(..), BuildSuccess(..) , DocsResult(..), TestsResult(..) ) diff --git a/Distribution/Client/BuildReports/Storage.hs b/Distribution/Client/BuildReports/Storage.hs --- a/Distribution/Client/BuildReports/Storage.hs +++ b/Distribution/Client/BuildReports/Storage.hs @@ -30,7 +30,7 @@ , AvailablePackageSource(..), Repo(..), RemoteRepo(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan - ( InstallPlan, PlanPackage ) + ( InstallPlan ) import Distribution.Simple.InstallDirs ( PathTemplate, fromPathTemplate diff --git a/Distribution/Client/BuildReports/Types.hs b/Distribution/Client/BuildReports/Types.hs --- a/Distribution/Client/BuildReports/Types.hs +++ b/Distribution/Client/BuildReports/Types.hs @@ -15,7 +15,7 @@ ) where import qualified Distribution.Text as Text - ( Text(disp, parse) ) + ( Text(..) ) import qualified Distribution.Compat.ReadP as Parse ( pfail, munch1 ) diff --git a/Distribution/Client/Config.hs b/Distribution/Client/Config.hs --- a/Distribution/Client/Config.hs +++ b/Distribution/Client/Config.hs @@ -62,8 +62,6 @@ ( notice, warn, lowercase ) import Distribution.Compiler ( CompilerFlavor(..), defaultCompilerFlavor ) -import Distribution.System - ( OS(Windows), buildOS ) import Distribution.Verbosity ( Verbosity, normal ) @@ -212,11 +210,9 @@ defaultCompiler = fromMaybe GHC defaultCompilerFlavor defaultUserInstall :: Bool -defaultUserInstall = case buildOS of - -- We do global installs by default on Windows - Windows -> False - -- and per-user installs by default everywhere else - _ -> True +defaultUserInstall = True +-- We do per-user installs by default on all platforms. We used to default to +-- global installs on Windows but that no longer works on Windows Vista or 7. defaultRemoteRepo :: RemoteRepo defaultRemoteRepo = RemoteRepo name uri diff --git a/Distribution/Client/Dependency/TopDown.hs b/Distribution/Client/Dependency/TopDown.hs --- a/Distribution/Client/Dependency/TopDown.hs +++ b/Distribution/Client/Dependency/TopDown.hs @@ -36,6 +36,8 @@ , PackageFixedDeps(depends) ) import Distribution.PackageDescription ( PackageDescription(buildDepends) ) +import Distribution.Client.PackageUtils + ( externalBuildDepends ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription, flattenPackageDescription ) import Distribution.Version @@ -301,7 +303,7 @@ platform comp [] p of Left missing -> Left missing Right (pkg, flags') -> Right $ - SemiConfiguredPackage apkg flags' (buildDepends pkg) + SemiConfiguredPackage apkg flags' (externalBuildDepends pkg) dependencySatisfiable = not . null . PackageIndex.lookupDependency available diff --git a/Distribution/Client/Fetch.hs b/Distribution/Client/Fetch.hs --- a/Distribution/Client/Fetch.hs +++ b/Distribution/Client/Fetch.hs @@ -36,7 +36,8 @@ ( getAvailablePackages, disambiguateDependencies , getInstalledPackages ) import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI) +import Distribution.Client.HttpUtils + ( downloadURI, isOldHackageURI ) import Distribution.Package ( PackageIdentifier, packageName, packageVersion, Dependency(..) ) @@ -46,8 +47,7 @@ import Distribution.Simple.Program ( ProgramConfiguration ) import Distribution.Simple.Utils - ( die, notice, info, debug, setupMessage - , copyFileVerbose, writeFileAtomic ) + ( die, notice, info, debug, setupMessage ) import Distribution.System ( buildPlatform ) import Distribution.Text @@ -56,7 +56,6 @@ ( Verbosity ) import qualified Data.Map as Map -import qualified Data.ByteString.Lazy.Char8 as BS import Control.Monad ( when, filterM ) import System.Directory @@ -66,37 +65,9 @@ import qualified System.FilePath.Posix as FilePath.Posix ( combine, joinPath ) import Network.URI - ( URI(uriPath, uriScheme) ) -import Network.HTTP - ( Response(..) ) -import Network.Stream - ( ConnError(..) ) + ( URI(uriPath) ) -downloadURI :: Verbosity - -> FilePath -- ^ Where to put it - -> URI -- ^ What to download - -> IO (Maybe ConnError) -downloadURI verbosity path uri | uriScheme uri == "file:" = do - copyFileVerbose verbosity (uriPath uri) path - return Nothing -downloadURI verbosity path uri = do - eitherResult <- getHTTP verbosity uri - case eitherResult of - Left err -> return (Just err) - Right rsp - | rspCode rsp == (2,0,0) - -> do info verbosity ("Downloaded to " ++ path) - writeFileAtomic path (BS.unpack $ rspBody rsp) - --FIXME: check the content-length header matches the body length. - --TODO: stream the download into the file rather than buffering the whole - -- thing in memory. - -- remember the ETag so we can not re-download if nothing changed. - >> return Nothing - - | otherwise - -> return (Just (ErrorMisc ("Unsucessful HTTP code: " ++ show (rspCode rsp)))) - -- Downloads a package to [config-dir/packages/package-id] and returns the path to the package. downloadPackage :: Verbosity -> Repo -> PackageIdentifier -> IO String downloadPackage _ repo@Repo{ repoKind = Right LocalRepo } pkgid = @@ -108,11 +79,8 @@ path = packageFile repo pkgid debug verbosity $ "GET " ++ show uri createDirectoryIfMissing True dir - status <- downloadURI verbosity path uri - case status of - Just err -> die $ "Failed to download '" ++ display pkgid - ++ "': " ++ show err - Nothing -> return path + downloadURI verbosity uri path + return path -- Downloads an index file to [config-dir/packages/serv-id]. downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath @@ -123,10 +91,8 @@ } path = cacheDir "00-index" <.> "tar.gz" createDirectoryIfMissing True cacheDir - mbError <- downloadURI verbosity path uri - case mbError of - Just err -> die $ "Failed to download index '" ++ show err ++ "'" - Nothing -> return path + downloadURI verbosity uri path + return path -- |Returns @True@ if the package has already been fetched. isFetched :: AvailablePackage -> IO Bool diff --git a/Distribution/Client/Haddock.hs b/Distribution/Client/Haddock.hs --- a/Distribution/Client/Haddock.hs +++ b/Distribution/Client/Haddock.hs @@ -16,12 +16,12 @@ ) where -import Data.Maybe (Maybe(..), listToMaybe) +import Data.Maybe (listToMaybe) import Data.List (maximumBy) -import Control.Monad (Monad(return), sequence, guard) +import Control.Monad (guard) import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile) -import System.FilePath (FilePath, (), splitFileName) +import System.FilePath ((), splitFileName) import Distribution.Package (Package(..)) import Distribution.Simple.Program (haddockProgram, ProgramConfiguration , rawSystemProgram, requireProgramVersion) diff --git a/Distribution/Client/HttpUtils.hs b/Distribution/Client/HttpUtils.hs --- a/Distribution/Client/HttpUtils.hs +++ b/Distribution/Client/HttpUtils.hs @@ -2,20 +2,26 @@ ----------------------------------------------------------------------------- -- | Separate module for HTTP actions, using a proxy server if one exists ----------------------------------------------------------------------------- -module Distribution.Client.HttpUtils (getHTTP, proxy, isOldHackageURI) where +module Distribution.Client.HttpUtils ( + downloadURI, + getHTTP, + proxy, + isOldHackageURI + ) where import Network.HTTP ( Request (..), Response (..), RequestMethod (..) , Header(..), HeaderName(..) ) import Network.URI ( URI (..), URIAuth (..), parseAbsoluteURI ) -import Network.Stream (Result) +import Network.Stream + ( Result, ConnError(..) ) import Network.Browser ( Proxy (..), Authority (..), browse , setOutHandler, setErrHandler, setProxy, request) import Control.Monad ( mplus, join, liftM2 ) -import qualified Data.ByteString.Lazy as ByteString +import qualified Data.ByteString.Lazy.Char8 as ByteString import Data.ByteString.Lazy (ByteString) #ifdef WIN32 import System.Win32.Types @@ -34,7 +40,9 @@ import qualified Paths_cabal_install (version) import Distribution.Verbosity (Verbosity) -import Distribution.Simple.Utils (warn, debug) +import Distribution.Simple.Utils + ( die, info, warn, debug + , copyFileVerbose, writeFileAtomic ) import Distribution.Text ( display ) import qualified System.FilePath.Posix as FilePath.Posix @@ -92,6 +100,7 @@ warn verbosity $ "ignoring http proxy, trying a direct connection" return NoProxy Just p -> return p +--TODO: print info message when we're using a proxy -- | We need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@ -- which lack the @\"http://\"@ URI scheme. The problem is that @@ -151,6 +160,33 @@ setProxy p request req return (Right resp) + +downloadURI :: Verbosity + -> URI -- ^ What to download + -> FilePath -- ^ Where to put it + -> IO () +downloadURI verbosity uri path | uriScheme uri == "file:" = + copyFileVerbose verbosity (uriPath uri) path +downloadURI verbosity uri path = do + result <- getHTTP verbosity uri + let result' = case result of + Left err -> Left err + Right rsp -> case rspCode rsp of + (2,0,0) -> Right (rspBody rsp) + (a,b,c) -> Left err + where + err = ErrorMisc $ "Unsucessful HTTP code: " + ++ concatMap show [a,b,c] + + case result' of + Left err -> die $ "Failed to download " ++ show uri ++ " : " ++ show err + Right body -> do + info verbosity ("Downloaded to " ++ path) + writeFileAtomic path (ByteString.unpack body) + --FIXME: check the content-length header matches the body length. + --TODO: stream the download into the file rather than buffering the whole + -- thing in memory. + -- remember the ETag so we can not re-download if nothing changed. -- Utility function for legacy support. isOldHackageURI :: URI -> Bool diff --git a/Distribution/Client/IndexUtils.hs b/Distribution/Client/IndexUtils.hs --- a/Distribution/Client/IndexUtils.hs +++ b/Distribution/Client/IndexUtils.hs @@ -128,8 +128,8 @@ let (pkgs, prefs) = mconcat pkgss prefs' = Map.fromListWith intersectVersionRanges [ (name, range) | Dependency name range <- prefs ] - evaluate pkgs - evaluate prefs' + _ <- evaluate pkgs + _ <- evaluate prefs' return AvailablePackageDb { packageIndex = pkgs, packagePreferences = prefs' diff --git a/Distribution/Client/Init.hs b/Distribution/Client/Init.hs --- a/Distribution/Client/Init.hs +++ b/Distribution/Client/Init.hs @@ -49,7 +49,7 @@ ( orLaterVersion ) import Distribution.Client.Init.Types - ( InitFlags(..), PackageType(..), Category(..), Stability(..) ) + ( InitFlags(..), PackageType(..), Category(..) ) import Distribution.Client.Init.Licenses ( bsd3, gplv2, gplv3, lgpl2, lgpl3 ) import Distribution.Client.Init.Heuristics @@ -92,7 +92,6 @@ >=> getAuthorInfo >=> getHomepage >=> getSynopsis - >=> getStability >=> getCategory >=> getLibOrExec >=> getSrcDir @@ -185,15 +184,6 @@ return $ flags { synopsis = maybeToFlag syn } -getStability :: InitFlags -> IO InitFlags -getStability flags = do - stab <- return (flagToMaybe $ stability flags) - ?>> maybePrompt flags (promptList "Project stability" [Stable ..] - (Just Experimental) - True) - - return $ flags { stability = maybeToFlag stab } - -- | Prompt for a package category. -- Note that it should be possible to do some smarter guessing here too, i.e. -- look at the name of the top level source directory. @@ -385,8 +375,7 @@ writeFile "Setup.hs" setupFile where setupFile = unlines - [ "#!/usr/bin/env runhaskell" - , "import Distribution.Simple" + [ "import Distribution.Simple" , "main = defaultMain" ] @@ -456,10 +445,6 @@ , fieldS "Copyright" NoFlag (Just "A copyright notice.") - True - - , fieldS "Stability" (either id display `fmap` stability c) - (Just "Stability of the pakcage (experimental, provisional, stable...)") True , fieldS "Category" (either id display `fmap` category c) diff --git a/Distribution/Client/Init/Licenses.hs b/Distribution/Client/Init/Licenses.hs --- a/Distribution/Client/Init/Licenses.hs +++ b/Distribution/Client/Init/Licenses.hs @@ -11,8 +11,8 @@ type License = String bsd3 :: String -> String -> License -bsd3 s y = unlines - [ "Copyright " ++ s ++ " " ++ y +bsd3 authors year = unlines + [ "Copyright (c)" ++ year ++ ", " ++ authors , "" , "All rights reserved." , "" @@ -27,7 +27,7 @@ , " disclaimer in the documentation and/or other materials provided" , " with the distribution." , "" - , " * Neither the name of " ++ s ++ " nor the names of other" + , " * Neither the name of " ++ authors ++ " nor the names of other" , " contributors may be used to endorse or promote products derived" , " from this software without specific prior written permission." , "" diff --git a/Distribution/Client/Init/Types.hs b/Distribution/Client/Init/Types.hs --- a/Distribution/Client/Init/Types.hs +++ b/Distribution/Client/Init/Types.hs @@ -46,7 +46,6 @@ , license :: Flag License , author :: Flag String , email :: Flag String - , stability :: Flag (Either String Stability) , homepage :: Flag String , synopsis :: Flag String @@ -83,7 +82,6 @@ , license = mempty , author = mempty , email = mempty - , stability = mempty , homepage = mempty , synopsis = mempty , category = mempty @@ -106,7 +104,6 @@ , license = combine license , author = combine author , email = combine email - , stability = combine stability , homepage = combine homepage , synopsis = combine synopsis , category = combine category @@ -143,18 +140,6 @@ instance Text Category where disp = Disp.text . show parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ] - --- | Some common package stability indicators. -data Stability - = Stable - | Provisional - | Experimental - | Alpha - deriving (Read, Show, Eq, Ord, Bounded, Enum) - -instance Text Stability where - disp = Disp.text . show - parse = Parse.choice $ map (fmap read . Parse.string . show) [Stable .. ] #if MIN_VERSION_base(3,0,0) #else diff --git a/Distribution/Client/Install.hs b/Distribution/Client/Install.hs --- a/Distribution/Client/Install.hs +++ b/Distribution/Client/Install.hs @@ -101,7 +101,7 @@ ( defaultPackageDesc, rawSystemExit, comparing ) import Distribution.Simple.InstallDirs as InstallDirs ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate - , initialPathTemplateEnv, compilerTemplateEnv, installDirsTemplateEnv ) + , initialPathTemplateEnv, installDirsTemplateEnv ) import Distribution.Package ( PackageName, PackageIdentifier, packageName, packageVersion , Package(..), PackageFixedDeps(..) @@ -558,7 +558,8 @@ printFailureReason reason = case reason of DependentFailed pkgid -> " depends on " ++ display pkgid ++ " which failed to install." - DownloadFailed _ -> " failed while downloading the package." + DownloadFailed e -> " failed while downloading the package." + ++ " The exception was:\n " ++ show e UnpackFailed e -> " failed while unpacking the package." ++ " The exception was:\n " ++ show e ConfigureFailed e -> " failed during the configure step." diff --git a/Distribution/Client/InstallPlan.hs b/Distribution/Client/InstallPlan.hs --- a/Distribution/Client/InstallPlan.hs +++ b/Distribution/Client/InstallPlan.hs @@ -54,8 +54,9 @@ ( Version, withinRange ) import Distribution.PackageDescription ( GenericPackageDescription(genPackageFlags) - , PackageDescription(buildDepends) , Flag(flagName), FlagName(..) ) +import Distribution.Client.PackageUtils + ( externalBuildDepends ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) import Distribution.Client.PackageIndex @@ -490,5 +491,5 @@ platform comp [] (packageDescription pkg) of - Right (resolvedPkg, _) -> buildDepends resolvedPkg + Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg Left _ -> error "configuredPackageInvalidDeps internal error" diff --git a/Distribution/Client/InstallSymlink.hs b/Distribution/Client/InstallSymlink.hs --- a/Distribution/Client/InstallSymlink.hs +++ b/Distribution/Client/InstallSymlink.hs @@ -66,6 +66,8 @@ ( canonicalizePath ) import System.FilePath ( (), splitPath, joinPath, isAbsolute ) + +import Prelude hiding (catch, ioError) import System.IO.Error ( catch, isDoesNotExistError, ioError ) import Control.Exception diff --git a/Distribution/Client/List.hs b/Distribution/Client/List.hs --- a/Distribution/Client/List.hs +++ b/Distribution/Client/List.hs @@ -171,10 +171,11 @@ Just pkg -> disp (packageVersion pkg) , text "Latest version installed:" <+> case latestInstalled pkginfo of - Nothing -> text "[ Not installed ]" + Nothing | hasLib pkginfo -> text "[ Not installed ]" + | otherwise -> text "[ Unknown ]" Just pkg -> disp (packageVersion pkg) , maybeShow (homepage pkginfo) "Homepage:" text - , text "License: " <+> text (show (license pkginfo)) + , text "License: " <+> text (display (license pkginfo)) ]) $+$ text "" where diff --git a/Distribution/Client/PackageUtils.hs b/Distribution/Client/PackageUtils.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/PackageUtils.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.PackageUtils +-- Copyright : (c) Duncan Coutts 2010 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@gmail.com +-- Stability : provisional +-- Portability : portable +-- +-- Various package description utils that should be in the Cabal lib +----------------------------------------------------------------------------- +module Distribution.Client.PackageUtils ( + externalBuildDepends, + ) where + +import Distribution.Package + ( packageVersion, packageName, Dependency(..) ) +import Distribution.PackageDescription + ( PackageDescription(..) ) +import Distribution.Version + ( withinRange ) + +-- | The list of dependencies that refer to external packages +-- rather than internal package components. +-- +externalBuildDepends :: PackageDescription -> [Dependency] +externalBuildDepends pkg = filter (not . internal) (buildDepends pkg) + where + -- True if this dependency is an internal one (depends on a library + -- defined in the same package). + internal (Dependency depName versionRange) = + depName == packageName pkg && + packageVersion pkg `withinRange` versionRange diff --git a/Distribution/Client/Setup.hs b/Distribution/Client/Setup.hs --- a/Distribution/Client/Setup.hs +++ b/Distribution/Client/Setup.hs @@ -65,6 +65,8 @@ ( ReadP, readP_to_S, char, munch1, pfail, (+++) ) import Distribution.Verbosity ( Verbosity, normal ) +import Distribution.Simple.Utils + ( wrapText ) import Data.Char ( isSpace, isAlphaNum ) @@ -264,7 +266,7 @@ fetchCommand :: CommandUI (Flag Verbosity) fetchCommand = CommandUI { commandName = "fetch", - commandSynopsis = "Downloads packages for later installation or study.", + commandSynopsis = "Downloads packages for later installation.", commandDescription = Nothing, commandUsage = usagePackages "fetch", commandDefaultFlags = toFlag normal, @@ -676,25 +678,21 @@ initCommand = CommandUI { commandName = "init", commandSynopsis = "Interactively create a .cabal file.", - commandUsage = \pname -> unlines - [ "Usage: " ++ pname ++ " init [FLAGS]" - , "" - , "Cabalise a project by creating a .cabal, Setup.lhs, and" - , "optionally a LICENSE file." - , "" - , "Calling init with no arguments (recommended) uses an" - , "interactive mode, which will try to guess as much as" - , "possible and prompt you for the rest. Command-line" - , "arguments are provided for scripting purposes." - , "If you don't want interactive mode, be sure to pass" - , "the -n flag." - , "" - , "Flags for init:" - ], - commandDescription = Nothing, + commandDescription = Just $ \_ -> wrapText $ + "Cabalise a project by creating a .cabal, Setup.hs, and " + ++ "optionally a LICENSE file.\n\n" + ++ "Calling init with no arguments (recommended) uses an " + ++ "interactive mode, which will try to guess as much as " + ++ "possible and prompt you for the rest. Command-line " + ++ "arguments are provided for scripting purposes. " + ++ "If you don't want interactive mode, be sure to pass " + ++ "the -n flag.\n", + commandUsage = \pname -> + "Usage: " ++ pname ++ " init [FLAGS]\n\n" + ++ "Flags for init:", commandDefaultFlags = defaultInitFlags, commandOptions = \_ -> - [ option ['n'] ["nonInteractive"] + [ option ['n'] ["non-interactive"] "Non-interactive mode." IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v }) trueArg @@ -704,22 +702,22 @@ IT.quiet (\v flags -> flags { IT.quiet = v }) trueArg - , option [] ["noComments"] + , option [] ["no-comments"] "Do not generate explanatory comments in the .cabal file." IT.noComments (\v flags -> flags { IT.noComments = v }) trueArg , option ['m'] ["minimal"] - "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --noComments." + "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." IT.minimal (\v flags -> flags { IT.minimal = v }) trueArg - , option [] ["packageDir"] + , option [] ["package-dir"] "Root directory of the package (default = current directory)." IT.packageDir (\v flags -> flags { IT.packageDir = v }) (reqArgFlag "DIRECTORY") - , option ['p'] ["packageName"] + , option ['p'] ["package-name"] "Name of the Cabal package to create." IT.packageName (\v flags -> flags { IT.packageName = v }) (reqArgFlag "PACKAGE") @@ -731,7 +729,7 @@ (toFlag `fmap` parse)) (flagToList . fmap display)) - , option [] ["cabalVersion"] + , option [] ["cabal-version"] "Required version of the Cabal library." IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal version range: "++) @@ -755,12 +753,6 @@ IT.email (\v flags -> flags { IT.email = v }) (reqArgFlag "EMAIL") - , option [] ["stability"] - "Package stability." - IT.stability (\v flags -> flags { IT.stability = v }) - (reqArg' "STABILITY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) - (flagToList . fmap (either id show))) - , option ['u'] ["homepage"] "Project homepage and/or repository." IT.homepage (\v flags -> flags { IT.homepage = v }) @@ -777,18 +769,18 @@ (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) (flagToList . fmap (either id show))) - , option [] ["isLibrary"] + , option [] ["is-library"] "Build a library." IT.packageType (\v flags -> flags { IT.packageType = v }) (noArg (Flag IT.Library)) - , option [] ["isExecutable"] + , option [] ["is-executable"] "Build an executable." IT.packageType (\v flags -> flags { IT.packageType = v }) (noArg (Flag IT.Executable)) - , option ['o'] ["exposeModule"] + , option ['o'] ["expose-module"] "Export a module from the package." IT.exposedModules (\v flags -> flags { IT.exposedModules = v }) @@ -803,13 +795,13 @@ ((Just . (:[])) `fmap` parse)) (fromMaybe [] . fmap (fmap display))) - , option [] ["sourceDir"] + , option [] ["source-dir"] "Directory containing package source." IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) (reqArg' "DIR" (Just . (:[])) (fromMaybe [])) - , option [] ["buildTool"] + , option [] ["build-tool"] "Required external build tool." IT.buildTools (\v flags -> flags { IT.buildTools = v }) (reqArg' "TOOL" (Just . (:[])) @@ -875,7 +867,7 @@ parseRepo :: Parse.ReadP r RemoteRepo parseRepo = do name <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "_-.") - Parse.char ':' + _ <- Parse.char ':' uriStr <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-=._/*()@'$:;&!?~") uri <- maybe Parse.pfail return (parseAbsoluteURI uriStr) return $ RemoteRepo { diff --git a/Distribution/Client/SrcDist.hs b/Distribution/Client/SrcDist.hs --- a/Distribution/Client/SrcDist.hs +++ b/Distribution/Client/SrcDist.hs @@ -55,10 +55,10 @@ | otherwise = pkg setupMessage verbosity "Building source dist for" (packageId pkg') - if snapshot + _ <- if snapshot then prepareSnapshotTree verbosity pkg' mb_lbi distPref tmpDir pps else prepareTree verbosity pkg' mb_lbi distPref tmpDir pps - targzFile <- createArchive verbosity pkg tmpDir distPref + targzFile <- createArchive verbosity pkg' tmpDir distPref notice verbosity $ "Source tarball created: " ++ targzFile where diff --git a/Distribution/Client/Unpack.hs b/Distribution/Client/Unpack.hs --- a/Distribution/Client/Unpack.hs +++ b/Distribution/Client/Unpack.hs @@ -45,7 +45,7 @@ import Control.Monad ( unless, when ) import Data.Ord (comparing) -import Data.List(null, maximumBy) +import Data.List(maximumBy) import System.FilePath ( (), addTrailingPathSeparator ) import qualified Data.Map as Map diff --git a/Distribution/Client/Update.hs b/Distribution/Client/Update.hs --- a/Distribution/Client/Update.hs +++ b/Distribution/Client/Update.hs @@ -33,7 +33,8 @@ import Distribution.Verbosity ( Verbosity ) -import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import qualified Codec.Compression.GZip as GZip (decompress) import qualified Data.Map as Map import System.FilePath (dropExtension) @@ -56,7 +57,7 @@ notice verbosity $ "Downloading the latest package list from " ++ remoteRepoName remoteRepo indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo) - writeFileAtomic (dropExtension indexPath) . BS.unpack + writeFileAtomic (dropExtension indexPath) . BS.Char8.unpack . GZip.decompress =<< BS.readFile indexPath diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs deleted file mode 100644 --- a/Distribution/Compat/TempFile.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -cpp #-} -{-# OPTIONS_NHC98 -cpp #-} -{-# OPTIONS_JHC -fcpp #-} --- #hide -module Distribution.Compat.TempFile ( - createTempDirectory, - ) where - -import System.FilePath (()) -#ifdef mingw32_HOST_OS -import System.Directory (createDirectory) -#else -import System.Posix.Directory (createDirectory) -#endif -import System.IO.Error (try, isAlreadyExistsError) - -#if __NHC__ -import System.Posix.Types (CPid(..)) -foreign import ccall unsafe "getpid" c_getpid :: IO CPid -#else -import System.Posix.Internals (c_getpid) -#endif - -createTempDirectory :: FilePath -> String -> IO FilePath -createTempDirectory dir template = do - pid <- c_getpid - findTempName pid - where - findTempName x = do - let dirpath = dir template ++ show x - r <- try $ mkPrivateDir dirpath - case r of - Right _ -> return dirpath - Left e | isAlreadyExistsError e -> findTempName (x+1) - | otherwise -> ioError e - -mkPrivateDir :: String -> IO () -#ifdef mingw32_HOST_OS -mkPrivateDir s = System.Directory.createDirectory s -#else -mkPrivateDir s = System.Posix.Directory.createDirectory s 0o700 -#endif diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -123,19 +123,19 @@ ++ " of the Cabal library " commands = - [configureExCommand `commandAddAction` configureAction - ,installCommand `commandAddAction` installAction + [installCommand `commandAddAction` installAction + ,updateCommand `commandAddAction` updateAction ,listCommand `commandAddAction` listAction ,infoCommand `commandAddAction` infoAction - ,updateCommand `commandAddAction` updateAction ,upgradeCommand `commandAddAction` upgradeAction ,fetchCommand `commandAddAction` fetchAction - ,uploadCommand `commandAddAction` uploadAction + ,unpackCommand `commandAddAction` unpackAction ,checkCommand `commandAddAction` checkAction ,sdistCommand `commandAddAction` sdistAction + ,uploadCommand `commandAddAction` uploadAction ,reportCommand `commandAddAction` reportAction - ,unpackCommand `commandAddAction` unpackAction ,initCommand `commandAddAction` initAction + ,configureExCommand `commandAddAction` configureAction ,wrapperAction (buildCommand defaultProgramConfiguration) buildVerbosity buildDistPref ,wrapperAction copyCommand @@ -259,7 +259,8 @@ (configUserInstall configFlags) let configFlags' = savedConfigureFlags config `mappend` configFlags configExFlags' = savedConfigureExFlags config `mappend` configExFlags - installFlags' = savedInstallFlags config `mappend` installFlags + installFlags' = defaultInstallFlags `mappend` + savedInstallFlags config `mappend` installFlags globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags' upgrade verbosity diff --git a/cabal-install.cabal b/cabal-install.cabal --- a/cabal-install.cabal +++ b/cabal-install.cabal @@ -1,5 +1,5 @@ Name: cabal-install -Version: 0.8.0 +Version: 0.8.2 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing @@ -33,7 +33,7 @@ source-repository this type: darcs location: http://darcs.haskell.org/cabal-branches/cabal-install-0.8/ - tag: 0.8.0 + tag: 0.8.2 flag old-base description: Old, monolithic base @@ -75,6 +75,7 @@ Distribution.Client.InstallSymlink Distribution.Client.List Distribution.Client.PackageIndex + Distribution.Client.PackageUtils Distribution.Client.Setup Distribution.Client.SetupWrapper Distribution.Client.SrcDist @@ -86,7 +87,6 @@ Distribution.Client.Utils Distribution.Client.Win32SelfUpgrade Distribution.Compat.Exception - Distribution.Compat.TempFile Paths_cabal_install build-depends: base >= 2 && < 5,