cabal-dev 0.7.3.2 → 0.7.4.0
raw patch · 6 files changed
+109/−73 lines, 6 files
Files
- cabal-dev.cabal +1/−1
- src/Distribution/Dev/AddSource.hs +29/−37
- src/Distribution/Dev/InstallDependencies.hs +3/−4
- src/Distribution/Dev/InvokeCabal.hs +45/−22
- src/Distribution/Dev/RewriteCabalConfig.hs +19/−9
- test/RunTests.hs +12/−0
cabal-dev.cabal view
@@ -1,5 +1,5 @@ Name: cabal-dev-Version: 0.7.3.2+Version: 0.7.4.0 Synopsis: Manage sandboxed Haskell build environments Description: cabal-dev is a tool for managing development builds of
src/Distribution/Dev/AddSource.hs view
@@ -68,7 +68,6 @@ import qualified Data.ByteString.Lazy.Char8 as L8 ( unpack ) import qualified Distribution.Verbosity as V -import Distribution.Dev.InvokeCabal ( cabalArgs ) import Distribution.Dev.Command ( CommandActions(..), CommandResult(..) ) import Distribution.Dev.Flags ( Config, getVerbosity ) import Distribution.Dev.Sandbox ( resolveSandbox, localRepoPath@@ -92,39 +91,33 @@ let v = getVerbosity flgs debug v $ "Making a cabal repo in " ++ localRepoPath sandbox ++ " out of " ++ show fns- eArgs <- cabalArgs flgs- case eArgs of- Left err -> return $ CommandError $ "Error getting cabal arguments: " ++ err- Right args ->- do- results <- mapM (processLocalSource v) fns- let errs = [e | Left e <- results]- srcs = [s | Right s <- results]- if not $ null errs- then return $ CommandError $ unlines $- "Errors finding cabal files:":map (showString " ") errs- else do- let (sources, newEntries) = unzip srcs- res <- readExistingIndex sandbox- case res of- Left err -> return $- CommandError $ "Error reading existing index: " ++ err- Right existingIndex ->- do let newIndex = mergeIndices existingIndex newEntries- -- Now we have the new index ready and have- -- sanity-checked all of the package locations- -- to be sure that they contain a cabal package- -- (or at least a .cabal file)- --- -- Now to install the tarballs for the- -- directories:- forM_ sources $ \(src, pkgId, pkgDesc) ->- installTarball flgs sandbox src pkgId pkgDesc args-- -- and now that the tarballs are in place,- -- write out the updated index- writeIndex sandbox newIndex- return CommandOk+ results <- mapM (processLocalSource v) fns+ let errs = [e | Left e <- results]+ srcs = [s | Right s <- results]+ if not $ null errs+ then return $ CommandError $ unlines $+ "Errors finding cabal files:":map (showString " ") errs+ else do+ let (sources, newEntries) = unzip srcs+ res <- readExistingIndex sandbox+ case res of+ Left err -> return $+ CommandError $ "Error reading existing index: " ++ err+ Right existingIndex ->+ do let newIndex = mergeIndices existingIndex newEntries+ -- Now we have the new index ready and have+ -- sanity-checked all of the package locations+ -- to be sure that they contain a cabal package+ -- (or at least a .cabal file)+ --+ -- Now to install the tarballs for the+ -- directories:+ forM_ sources $ \(src, pkgId, pkgDesc) ->+ installTarball flgs sandbox src pkgId pkgDesc+ -- and now that the tarballs are in place,+ -- write out the updated index+ writeIndex sandbox newIndex+ return CommandOk -- |Atomically write an index tarball in the supplied directory writeIndex :: Sandbox a -- ^The local repository path@@ -196,9 +189,8 @@ -> LocalSource -- ^What kind of package source -> PackageIdentifier -> PackageDescription -- ^Package description- -> [String] -- ^Cabal args, computed at the top level -> IO (Either String ())-installTarball flgs sandbox src pkgId pkgDesc args =+installTarball flgs sandbox src pkgId pkgDesc = do createDirectoryIfMissing True $ localRepoPath sandbox </> repoDir pkgId case src of TarPkg fn -> do copyFile fn dest@@ -228,7 +220,7 @@ -- program. We do this to work -- around a different bug in Cabal -- (http://hackage.haskell.org/trac/hackage/ticket/731)- rawSystem "cabal" ["configure"]+ _ <- rawSystem "cabal" ["configure"] rawSystem "dist/setup/setup" ["sdist"] _ -> rawSystem "cabal" ["sdist"]
src/Distribution/Dev/InstallDependencies.hs view
@@ -27,12 +27,11 @@ installDependencies flgs pkgNames = do let v = getVerbosity flgs s <- initPkgDb v =<< resolveSandbox flgs- setupRes <- setup s flgs+ (cabal, _) <- requireProgram v cabalProgram emptyProgramDb+ setupRes <- setup s cabal flgs case setupRes of Left err -> return $ CommandError err- Right args ->- do- (cabal, _) <- requireProgram v cabalProgram emptyProgramDb+ Right args -> do out <- getProgramOutput v cabal $ concat [ args , ["install", "--dry-run", "--verbose=1"]
src/Distribution/Dev/InvokeCabal.hs view
@@ -8,11 +8,12 @@ ) where -import Distribution.Version ( Version(..) )+import Distribution.Version ( Version(..), VersionRange, withinRange, earlierVersion ) import Distribution.Verbosity ( Verbosity, showForCabal ) import Distribution.Simple.Program ( Program( programFindVersion , programFindLocation )+ , ConfiguredProgram , emptyProgramConfiguration , findProgramVersion , locationPath@@ -20,11 +21,12 @@ , programVersion , requireProgram , runProgram+ , getProgramOutput , simpleProgram ) import Distribution.Simple.Utils ( withUTF8FileContents, writeUTF8File , debug, cabalVersion )-import Distribution.Text ( display )+import Distribution.Text ( display, simpleParse ) import System.Console.GetOpt ( OptDescr ) import Distribution.Dev.Command ( CommandActions(..)@@ -60,34 +62,41 @@ invokeCabal flgs args = do let v = getVerbosity flgs s <- initPkgDb v =<< resolveSandbox flgs- res <- setup s flgs+ cabal <- findCabalOnPath v+ res <- setup s cabal flgs case res of Left err -> return $ CommandError err Right args' -> do- invokeCabalCfg v $ args' ++ args+ runProgram v cabal $ args' ++ args return CommandOk -cabalArgs :: Config -> IO (Either String [String])-cabalArgs flgs = do+cabalArgs :: ConfiguredProgram -> Config -> IO (Either String [String])+cabalArgs cabal flgs = do let v = getVerbosity flgs s <- initPkgDb v =<< resolveSandbox flgs- setup s flgs+ setup s cabal flgs -setup :: Sandbox KnownVersion-> Config -> IO (Either String [String])-setup s flgs = do+setup :: Sandbox KnownVersion -> ConfiguredProgram -> Config -> IO (Either String [String])+setup s cabal flgs = do let v = getVerbosity flgs+ verOut <- getProgramOutput v cabal ["--version"] cfgIn <- getCabalConfig flgs let cfgOut = cabalConf s- cabalHome <- getAppUserDataDirectory "cabal"- withUTF8FileContents cfgIn $ \cIn ->- do cfgRes <- R.rewriteCabalConfig (R.Rewrite cabalHome (sandbox s) (pkgConf s)) cIn- case cfgRes of- Left err -> return $ Left $- "Error processing cabal config file " ++ cfgIn ++ ": " ++ err- Right cOut -> do- writeUTF8File cfgOut cOut- args <- extraArgs v cfgOut (getVersion s)- return $ Right args+ case cabalVer verOut of+ Left err -> return $ Left err+ Right ver -> do+ cabalHome <- getAppUserDataDirectory "cabal"+ let qInstDirs = withinRange ver cabalNeedsQuotes+ rew = R.Rewrite cabalHome (sandbox s) (pkgConf s) qInstDirs+ withUTF8FileContents cfgIn $ \cIn ->+ do cfgRes <- R.rewriteCabalConfig rew cIn+ case cfgRes of+ Left err -> return $ Left $+ "Error processing cabal config file " ++ cfgIn ++ ": " ++ err+ Right cOut -> do+ writeUTF8File cfgOut cOut+ args <- extraArgs v cfgOut (getVersion s)+ return $ Right args extraArgs :: Verbosity -> FilePath -> PackageDbType -> IO [String] extraArgs v cfg pdb =@@ -135,12 +144,26 @@ findProgramVersion "--numeric-version" id } -invokeCabalCfg :: Verbosity -> [String] -> IO ()-invokeCabalCfg v args = do+findCabalOnPath :: Verbosity -> IO ConfiguredProgram+findCabalOnPath v = do (cabal, _) <- requireProgram v cabalProgram emptyProgramConfiguration debug v $ concat [ "Using cabal-install " , maybe "(unknown version)" display $ programVersion cabal , " at " , show (programLocation cabal) ]- runProgram v cabal args+ return cabal++cabalVer :: String -> Either String Version+cabalVer str =+ case lines str of+ [] -> Left "No version string provided."+ [_] -> Left "Could not find Cabal version line."+ (_:ln:_) -> case simpleParse ((words ln)!!2) of+ Just v -> Right v+ Nothing -> Left $ err ln+ where err line = "Could not parse Cabal verison.\n"+ ++ "(simpleParse "++show line++")"++cabalNeedsQuotes :: VersionRange+cabalNeedsQuotes = earlierVersion $ Version [1,10] []
src/Distribution/Dev/RewriteCabalConfig.hs view
@@ -20,17 +20,18 @@ import Distribution.ParseUtils ( readFields, ParseResult(..), Field(..) ) import Text.PrettyPrint.HughesPJ -data Rewrite = Rewrite { homeDir :: FilePath- , sandboxDir :: FilePath- , packageDb :: FilePath+data Rewrite = Rewrite { homeDir :: FilePath+ , sandboxDir :: FilePath+ , packageDb :: FilePath+ , quoteInstallDirs :: Bool } -- |Rewrite a cabal-install config file so that all paths are made -- absolute and canonical. rewriteCabalConfig :: Rewrite -> String -> IO (Either String String)-rewriteCabalConfig r =- rewriteConfig (expandCabalConfig (homeDir r) (sandboxDir r))- (setPackageDb $ packageDb r)+rewriteCabalConfig r = rewriteConfig expand (setPackageDb $ packageDb r)+ where+ expand = expandCabalConfig (quoteInstallDirs r) (homeDir r) (sandboxDir r) -- |Given an expansion configuration, read the input config file and -- write the expansion into the output config file@@ -113,8 +114,13 @@ -- -- If the cabal-install config file changes, or if this list is not -- complete, this code will have to be updated.-expandCabalConfig :: FilePath -> FilePath -> Expand IO-expandCabalConfig home sandbox =+expandCabalConfig :: Bool -- ^Whether the install-dirs section of the+ -- cabal config file will quote paths.+ -- Versions of cabal-install prior to 0.9+ -- required quoting. Versions 0.9 and later+ -- forbit it.+ -> FilePath -> FilePath -> Expand IO+expandCabalConfig shouldQuote home sandbox = Expand { eExpand = ePath , eLeaves = [ "remote-repo-cache" , "local-repo"@@ -134,7 +140,7 @@ } where expandInstallDirs =- Expand { eExpand = fmap show . ePath+ Expand { eExpand = quote . ePath , eLeaves = [ "prefix" , "bindir"@@ -149,5 +155,9 @@ ] , eSections = [] }++ -- How install-dirs should quote its paths+ quote | shouldQuote = fmap show+ | otherwise = id ePath = return . expandDot sandbox . expandTilde home
test/RunTests.hs view
@@ -27,6 +27,7 @@ import Distribution.Text ( simpleParse, display ) import Distribution.Verbosity ( normal, Verbosity, showForCabal, verbose ) import Distribution.Version ( Version(..) )+import Distribution.Dev.Flags ( parseGlobalFlags ) import Distribution.Dev.InitPkgDb ( initPkgDb ) import Distribution.Dev.Sandbox ( newSandbox, pkgConf, Sandbox, KnownVersion, sandbox, indexTar ) import System.IO ( withBinaryFile, IOMode(ReadMode) )@@ -39,6 +40,7 @@ import System.Random ( RandomGen ) import Test.Framework ( defaultMainWithArgs, Test, testGroup ) import Test.Framework.Providers.HUnit ( testCase )+import Test.HUnit ( (@?=) ) import qualified Test.HUnit as HUnit import Distribution.Client.Config -- ( parseConfig )@@ -84,6 +86,9 @@ , testCase "exits with failure when no arguments are supplied" $ assertExitsFailure p []++ , testCase "short flag is passed through to cabal" $+ assertShortFlags ] main :: IO ()@@ -161,6 +166,13 @@ assertExitsFailure :: FilePath -> [String] -> HUnit.Assertion assertExitsFailure = assertProgram "exits with failure" $ (ExitSuccess /=) . fst3+++-- | Test for short flags. Verifies that a short flag can make it past the cabal-dev+-- command line arg parser (and then, presumably, to cabal-install).+-- Created due to issue 6: https://github.com/creswick/cabal-dev/issues#issue/6+assertShortFlags :: HUnit.Assertion+assertShortFlags = (parseGlobalFlags $ words "install -f-curl") @?= ([],["install", "-f-curl"],[]) fst3 :: (a, b, c) -> a fst3 (x, _, _) = x