cab 0.1.13 → 0.1.14

raw patch · 7 files changed

+39/−31 lines, 7 files

Files

• CmdDB.hs +8/−0
• Commands.hs +14/−8
• Main.hs +1/−1
• PkgDB.hs +12/−16
• Types.hs +1/−0
• VerDB.hs +1/−1
• cab.cabal +2/−5

@@ -205,6 +205,14 @@        , manual = Nothing        }   , CommandSpec {+         command = Ghci+       , commandNames = ["ghci"]+       , document = "Run GHCi within a sandbox"+       , routing = RouteFunc ghci+       , switches = [(SwSandbox, Just "--sandbox")]+       , manual = Nothing+       }+  , CommandSpec {          command = Help        , commandNames = ["help"]        , document = "Display the help message of the command"

@@ -1,6 +1,6 @@ module Commands (     deps, revdeps, installed, outdated, uninstall, search, env-  , genpaths, check, add+  , genpaths, check, add, ghci   ) where  import Control.Applicative hiding (many)@@ -86,7 +86,7 @@     if doit then do         putStrLn $ "Deleting " ++ name ++ " " ++ ver         pkgconf <- pkgConfOpt opts-        when doit $ system (script pkgconf) >> return ()+        when doit $ void . system $ script pkgconf       else         putStrLn $ name ++ " " ++ ver   where@@ -109,8 +109,7 @@ check :: FunctionCommand check _ _ opts = do     pkgconf <- pkgConfOpt opts-    system (script pkgconf)-    return ()+    void . system $ script pkgconf   where    script pkgconf = "ghc-pkg check -v " ++ pkgconf @@ -190,7 +189,14 @@ add _ params opts = case getSandbox opts of     Nothing -> hPutStrLn stderr "A sandbox must be specified with \"-s\" option."     Just sbox -> case params of-        [src] -> do-            system $ "cabal-dev add-source " ++ src ++ " -s " ++ sbox-            return ()-        _ -> hPutStrLn stderr "A source path be specified."+        [src] -> void . system $ "cabal-dev add-source " ++ src ++ " -s " ++ sbox+        _     -> hPutStrLn stderr "A source path be specified."++----------------------------------------------------------------++ghci :: FunctionCommand+ghci _ _ opts = case getSandbox opts of+    Nothing -> hPutStrLn stderr "A sandbox must be specified with \"-s\" option."+    Just sbox -> do+      _ <- system $ "cabal-dev -s " ++ sbox ++ " ghci"+      return ()

@@ -85,7 +85,7 @@     sws = switches cmdspec  callProcess :: String -> [String] -> [Arg] -> [Option] -> [SwitchSpec] -> IO ()-callProcess pro args0 args1 opts sws = system script >> return ()+callProcess pro args0 args1 opts sws = void . system $ script   where     swchs = optionsToString opts sws     script = joinBy " " $ pro : args0 ++ cat args1 ++ swchs

@@ -1,12 +1,11 @@-{-# LANGUAGE CPP #-}- module PkgDB where -import Control.Applicative import Control.Monad+import Data.Function import Data.List import Data.Map (Map) import qualified Data.Map as M+import Data.Maybe (isNothing) import Distribution.Compiler     (CompilerId(..)) import Distribution.License@@ -30,7 +29,6 @@ import Distribution.Verbosity     (normal) import System.FilePath-import System.Directory import Utils  type PkgDB = PackageIndex@@ -46,6 +44,11 @@             Just path -> SpecificPackageDB $ packageConf path com     getInstalledPackages normal [GlobalPackageDB,userDB] pro +getGlobalPkgDB :: IO PkgDB+getGlobalPkgDB = do+    (_,pro) <- configure normal Nothing Nothing defaultProgramDb+    getInstalledPackages normal [GlobalPackageDB] pro+ getPackageConf :: FilePath -> IO FilePath getPackageConf path = do     (com,_) <- configure normal Nothing Nothing defaultProgramDb@@ -85,15 +88,8 @@  userPkgs :: IO (PkgInfo -> Bool) userPkgs = do-#ifdef darwin_HOST_OS-    -- drop "/."-    userDirPref <- takeDirectory <$> getAppUserDataDirectory ""-#else-    userDirPref <- getAppUserDataDirectory ""-#endif-    return $ \pkgi -> case libraryDirs pkgi of-        [] -> False -- haskell-platform for example-        xs -> any (userDirPref `isPrefixOf`) xs+    gDB <- getGlobalPkgDB+    return$ \pkgi -> isNothing$ lookupInstalledPackageId gDB (installedPackageId pkgi)  allPkgs :: IO (PkgInfo -> Bool) allPkgs = return (const True)@@ -133,7 +129,7 @@  printDep :: Bool -> Bool -> PkgDB -> Int -> InstalledPackageId -> IO () printDep rec info db n pid = case lookupInstalledPackageId db pid of-    Nothing -> return ()+    Nothing   -> return ()     Just pkgi -> do         putStr $ prefix ++ fullNameOfPkgInfo pkgi         extraInfo info pkgi@@ -166,7 +162,7 @@  printRevDep' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> InstalledPackageId -> IO () printRevDep' rec info db revdb n pid = case lookupInstalledPackageId db pid of-    Nothing -> return ()+    Nothing   -> return ()     Just pkgi -> do         putStr $ prefix ++ fullNameOfPkgInfo pkgi         extraInfo info pkgi@@ -187,7 +183,7 @@     idDeps pkg = (installedPackageId pkg, depends pkg)     kvs = sort $ concatMap decomp deps     decomp (k,vs) = map (\v -> (v,k)) vs-    kvss = groupBy (\x y -> fst x == fst y) kvs+    kvss = groupBy ((==) `on` fst) kvs     comp xs = (fst (head xs), map snd xs)     revdeps = map comp kvss 

@@ -80,6 +80,7 @@              | Search              | Env              | Add+             | Ghci              | Test              | Doc              | Help

@@ -51,7 +51,7 @@     name <- string "* " *> nonEols <* endOfLine     synpsis     lat <- latestLabel *> latest <* endOfLine-    many skip+    _ <- many skip     endOfLine     return (name, lat)   where

@@ -1,5 +1,5 @@ Name:                   cab-Version:                0.1.13+Version:                0.1.14 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -19,10 +19,7 @@  Executable cab   Main-Is:              Main.hs-  if impl(ghc >= 6.12)-    GHC-Options:        -Wall -fno-warn-unused-do-bind-  else-    GHC-Options:        -Wall+  GHC-Options:          -Wall   Build-Depends:        base >= 4.0 && < 5                       , Cabal                       , attoparsec >= 0.10