cab 0.2.0 → 0.2.1

raw patch · 10 files changed

+107/−79 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Distribution/Cab.hs +0/−4
• Distribution/Cab/Commands.hs +21/−21
• Distribution/Cab/Sandbox.hs +9/−0
• Distribution/Cab/Utils.hs +1/−16
• cab.cabal +1/−1
• src/Commands.hs +6/−6
• src/Help.hs +43/−12
• src/Main.hs +13/−12
• src/Options.hs +6/−3
• src/Types.hs +7/−4

@@ -14,10 +14,6 @@   , add   , initSandbox   , ghci-  -- * Utilities-  , joinBy-  , split   ) where  import Distribution.Cab.Commands-import Distribution.Cab.Utils

@@ -8,7 +8,7 @@ import Control.Applicative hiding (many) import Control.Monad import Data.Char-import Data.List+import Data.List (isPrefixOf, intercalate) import qualified Data.Map as M import Distribution.Cab.GenPaths import Distribution.Cab.PkgDB@@ -16,14 +16,13 @@ import Distribution.Cab.Sandbox import Distribution.Cab.VerDB import Distribution.Cab.Version-import Distribution.Cab.Utils import System.Exit import System.IO import System.Process hiding (env)  ---------------------------------------------------------------- -type FunctionCommand = [String] -> [Option] -> IO ()+type FunctionCommand = [String] -> [Option] -> [String] -> IO ()  data Option = OptNoharm             | OptRecursive@@ -37,26 +36,27 @@             | OptLibProfile             | OptExecProfile             | OptJobs String+            | OptImport String             deriving (Eq,Show)  ----------------------------------------------------------------  search :: FunctionCommand-search [x] _ = do+search [x] _ _ = do     nvls <- toList <$> getVerDB AllRegistered     forM_ (lok nvls) $ \(n,v) -> putStrLn $ n ++ " " ++ verToString v   where     key = map toLower x     sat (n,_) = key `isPrefixOf` map toLower n     lok = filter sat-search _ _ = do+search _ _ _ = do     hPutStrLn stderr "One search-key should be specified."     exitFailure  ----------------------------------------------------------------  installed :: FunctionCommand-installed _ opts = do+installed _ opts _ = do     db <- getDB opts     let pkgs = toPkgInfos db     forM_ pkgs $ \pkgi -> do@@ -69,7 +69,7 @@     optrec = OptRecursive `elem` opts  outdated :: FunctionCommand-outdated _ opts = do+outdated _ opts _ = do     pkgs <- toPkgInfos <$> getDB opts     verDB <- toMap <$> getVerDB InstalledOnly     forM_ pkgs $ \p -> case M.lookup (nameOfPkgInfo p) verDB of@@ -87,7 +87,7 @@ ----------------------------------------------------------------  uninstall :: FunctionCommand-uninstall nmver opts = do+uninstall nmver opts _ = do     userDB <- getSandbox >>= getUserPkgDB     pkg <- lookupPkg nmver userDB     let sortedPkgs = topSortedPkgs pkg userDB@@ -105,7 +105,7 @@ unregister doit _ (name,ver) =     if doit then do         putStrLn $ "Deleting " ++ name ++ " " ++ ver-        sandboxOpts <- getSandboxOpts <$> getSandbox+        sandboxOpts <- getSandboxOpts2 <$> getSandbox         when doit $ void . system $ script sandboxOpts       else         putStrLn $ name ++ " " ++ ver@@ -115,12 +115,12 @@ ----------------------------------------------------------------  genpaths :: FunctionCommand-genpaths _ _ = genPaths+genpaths _ _ _ = genPaths  ----------------------------------------------------------------  check :: FunctionCommand-check _ _ = do+check _ _ _ = do     sandboxOpts <- getSandboxOpts <$> getSandbox     void . system $ script sandboxOpts   where@@ -129,10 +129,10 @@ ----------------------------------------------------------------  deps :: FunctionCommand-deps nmver opts = printDepends nmver opts printDeps+deps nmver opts _ = printDepends nmver opts printDeps  revdeps :: FunctionCommand-revdeps nmver opts = printDepends nmver opts printRevDeps+revdeps nmver opts _ = printDepends nmver opts printRevDeps  printDepends :: [String] -> [Option]              -> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()) -> IO ()@@ -170,23 +170,23 @@ ----------------------------------------------------------------  initSandbox :: FunctionCommand-initSandbox []     _ = void . system $ "cabal sandbox init"-initSandbox [path] _ = void . system $ "cabal sandbox init --sandbox " ++ path-initSandbox _      _ = do+initSandbox []     _ _ = void . system $ "cabal sandbox init"+initSandbox [path] _ _ = void . system $ "cabal sandbox init --sandbox " ++ path+initSandbox _      _ _ = do     hPutStrLn stderr "Only one argument is allowed"     exitFailure  ----------------------------------------------------------------  add :: FunctionCommand-add [src] _ = void . system $ "cabal sandbox add-source " ++ src-add _     _ = do+add [src] _ _ = void . system $ "cabal sandbox add-source " ++ src+add _     _ _ = do     hPutStrLn stderr "A source path be specified."     exitFailure  ----------------------------------------------------------------  ghci :: FunctionCommand-ghci args _ = do-    opts <- getSandboxOpts <$> getSandbox-    void $ system $ "ghci" ++ " " ++ opts ++ " " ++ joinBy " " args+ghci args _ options = do+    sbxOpts <- getSandboxOpts <$> getSandbox+    void $ system $ "ghci" ++ " " ++ sbxOpts ++ " " ++ intercalate " " (options ++ args)

@@ -3,6 +3,7 @@ module Distribution.Cab.Sandbox (     getSandbox   , getSandboxOpts+  , getSandboxOpts2   ) where  import Control.Applicative ((<$>))@@ -75,6 +76,14 @@     ghcver = extractGhcVer path     pkgOpt | ghcver >= 706 = "-package-db "            | otherwise     = "-package-conf "++getSandboxOpts2 :: Maybe FilePath -> String+getSandboxOpts2 Nothing     = ""+getSandboxOpts2 (Just path) = pkgOpt ++ "=" ++ path+  where+    ghcver = extractGhcVer path+    pkgOpt | ghcver >= 706 = "--package-db"+           | otherwise     = "--package-conf"  -- | Extracting GHC version from the path of package db. --   Exception is thrown if the string argument is incorrect.

@@ -15,19 +15,4 @@ -- >>> toDotted [1,2,3] -- "1.2.3" toDotted :: [Int] -> String-toDotted = joinBy "." . map show---- |--- >>> joinBy "," ["foo","bar","baz"]--- "foo,bar,baz"-joinBy :: String -> [String] -> String-joinBy = intercalate---- |--- >>> split 4 "0123457689"--- ["0123","4576","89"]-split :: Int -> [a] -> [[a]]-split _ [] = []-split n ss = x : split n rest-  where-    (x,rest) = splitAt n ss+toDotted = intercalate "." . map show

@@ -1,5 +1,5 @@ Name:                   cab-Version:                0.2.0+Version:                0.2.1 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3

@@ -23,12 +23,12 @@        , document = "Install packages"        , routing = RouteCabal ["install"]        , switches = [(SwNoharm, Solo "--dry-run -v")-                    ,(SwFlag, WithArg "--flags")+                    ,(SwFlag, WithEqArg "--flags")                     ,(SwTest, Solo "--enable-tests")                     ,(SwDepsOnly, Solo "--only-dependencies")                     ,(SwLibProfile, Solo "--enable-library-profiling")                     ,(SwExecProfile, Solo "--enable-executable-profiling")-                    ,(SwJobs, WithArg "--jobs")+                    ,(SwJobs, WithEqArg "--jobs")                     ]        , manual = Just "[<package> [<ver>]]"        }@@ -58,7 +58,7 @@        , commandNames = ["configure", "conf"]        , document = "Configure a cabal package"        , routing = RouteCabal ["configure"]-       , switches = [(SwFlag, WithArg "--flags")+       , switches = [(SwFlag, WithEqArg "--flags")                     ,(SwTest, Solo "--enable-tests")                     ,(SwBench, Solo "--enable-benchmarks")                     ,(SwLibProfile, Solo "--enable-library-profiling")@@ -71,7 +71,7 @@        , commandNames = ["build"]        , document = "Build a cabal package"        , routing = RouteCabal ["build"]-       , switches = [(SwJobs, WithArg "--jobs")]+       , switches = [(SwJobs, WithEqArg "--jobs")]        , manual = Nothing        }   , CommandSpec {@@ -182,7 +182,7 @@        , document = "Run tests"        , routing = RouteCabal ["test"]        , switches = []-       , manual = Nothing+       , manual = Just "[testsuite]"        }   , CommandSpec {          command = Bench@@ -205,7 +205,7 @@        , commandNames = ["ghci", "repl"]        , document = "Run GHCi (with a sandbox)"        , routing = RouteFunc ghci-       , switches = []+       , switches = [(SwImport, FollowArg "-i")]        , manual = Nothing        }   , CommandSpec {

@@ -3,6 +3,8 @@   , helpCommandAndExit   , illegalOptionsAndExit   , illegalCommandAndExit+  , usageDocAlias+  , optionDoc   ) where  import Control.Monad@@ -20,29 +22,41 @@ ----------------------------------------------------------------  helpCommandAndExit :: FunctionCommand-helpCommandAndExit [] _ = helpAndExit-helpCommandAndExit (cmd:_) _ = do+helpCommandAndExit [] _ _ = helpAndExit+helpCommandAndExit (cmd:_) _ _ = do     case mcmdspec of         Nothing -> helpAndExit         Just cmdspec -> do-            putStrLn $ "Usage: " ++ cmd ++ " " ++ showOptions cmdspec ++ showArgs cmdspec+            let (usage,doc,alias) = usageDocAlias cmdspec+            putStrLn $ "Usage: " ++ usage             putStr "\n"-            putStrLn $ document cmdspec+            putStrLn $ doc             putStr "\n"-            putStrLn $ "Aliases: " ++ showAliases cmdspec+            putStrLn $ "Aliases: " ++ alias             putStr "\n"             printOptions cmdspec     exitSuccess   where     mcmdspec = commandSpecByName cmd commandDB-    showOptions cmdspec = "[" ++ joinBy "] [" (concatMap (masterOption optionDB) (opts cmdspec)) ++ "]"-    showArgs cmdspec = maybe "" (" " ++) $ manual cmdspec++usageDocAlias :: CommandSpec -> (String, String, String)+usageDocAlias cmdspec = (usage,doc,alias)+  where+    usage = cmd ++ " " ++ showOptions ++ showArgs+    doc = document cmdspec+    alias = showAliases cmdspec+    cmd:_ = commandNames cmdspec+    options = opts cmdspec+    showOptions+      | null options = ""+      | otherwise    = "[" ++ intercalate "] [" (concatMap (masterOption optionDB) (opts cmdspec)) ++ "]"+    showArgs = maybe "" (" " ++) $ manual cmdspec     opts = map fst . switches     masterOption [] _ = []     masterOption (spec:specs) o       | fst spec == o = optionName spec : masterOption specs o       | otherwise     = masterOption specs o-    showAliases = joinBy ", " . commandNames+    showAliases = intercalate ", " . tail . commandNames  printOptions :: CommandSpec -> IO () printOptions cmdspec =@@ -51,11 +65,17 @@     opts = map fst $ switches cmdspec     printOption [] _ = return ()     printOption (spec:specs) o-      | fst spec == o =-          putStrLn $ (joinBy ", " . reverse . optionNames $ spec)-                   ++ "\t" ++ optionDesc spec+      | fst spec == o = do+          let (key,doc) = optionDoc spec+          putStrLn $ key ++ "\t" ++ doc       | otherwise        = printOption specs o +optionDoc :: OptionSpec -> (String, String)+optionDoc spec = (key,doc)+  where+    key = intercalate ", " . reverse . optionNames $ spec+    doc = optionDesc spec+ ----------------------------------------------------------------  optionName :: OptionSpec -> String@@ -107,5 +127,16 @@  illegalOptionsAndExit :: [UnknownOpt] -> IO () illegalOptionsAndExit xs = do -- FixME-    hPutStrLn stderr $ "Illegal options: " ++ joinBy " " xs+    hPutStrLn stderr $ "Illegal options: " ++ intercalate " " xs     exitFailure++----------------------------------------------------------------++-- |+-- >>> split 4 "0123457689"+-- ["0123","4576","89"]+split :: Int -> [a] -> [[a]]+split _ [] = []+split n ss = x : split n rest+  where+    (x,rest) = splitAt n ss

@@ -4,7 +4,7 @@ import qualified Control.Exception as E import Control.Monad import Data.Maybe-import Data.List (isPrefixOf)+import Data.List (isPrefixOf, intercalate) import Distribution.Cab import System.Cmd import System.Console.GetOpt@@ -25,7 +25,7 @@     checkOptions1 pargs illegalOptionsAndExit     let Right (args,opts0) = pargs     when (args == []) helpAndExit-    when (OptHelp `elem` opts0) $ helpCommandAndExit args undefined+    when (OptHelp `elem` opts0) $ helpCommandAndExit args [] []     let opts1 = filter (/= OptHelp) opts0         act:params = args         mcmdspec = commandSpecByName act commandDB@@ -65,17 +65,17 @@  run :: CommandSpec -> [Arg] -> [Option] -> IO () run cmdspec params opts = case routing cmdspec of-    RouteFunc func     -> func params opts-    RouteCabal subargs -> callProcess pro subargs params opts sws+    RouteFunc func     -> func params opts options+    RouteCabal subargs -> callProcess pro subargs params options   where     pro = "cabal"     sws = switches cmdspec+    options = optionsToString opts sws -callProcess :: String -> [String] -> [Arg] -> [Option] -> [SwitchSpec] -> IO ()-callProcess pro args0 args1 opts sws = void . system $ script+callProcess :: String -> [String] -> [Arg] -> [String] -> IO ()+callProcess pro args0 args1 options = void . system $ script   where-    swchs = optionsToString opts sws-    script = joinBy " " $ pro : args0 ++ cat args1 ++ swchs+    script = intercalate " " $ pro : args0 ++ cat args1 ++ options     cat [pkg,ver] = [pkg ++ "-" ++ ver]     cat x         = x @@ -98,7 +98,8 @@ optionsToString opts swdb = concatMap suboption opts   where     suboption opt = case lookup (toSwitch opt) swdb of-        Nothing          -> []-        Just None        -> []-        Just (Solo x)    -> [x]-        Just (WithArg x) -> [x ++ "=" ++ optionArg opt]+        Nothing            -> []+        Just None          -> []+        Just (Solo x)      -> [x]+        Just (WithEqArg x) -> [x ++ "=" ++ optionArg opt]+        Just (FollowArg x) -> [x ++ optionArg opt]

@@ -18,7 +18,7 @@   , Option ['a'] ["all"]       (NoArg OptAll)       "Show global packages in addition to user packages"-  , Option ['i'] ["info"]+  , Option ['m'] ["info"]       (NoArg OptInfo)       "Show license and author information"   , Option ['f'] ["flags"]@@ -33,7 +33,7 @@   , Option ['d'] ["dep-only"]       (NoArg OptDepsOnly)       "Target only dependencies"-  , Option ['p'] ["libr-prof"]+  , Option ['p'] ["lib-prof"]       (NoArg OptLibProfile)       "Enable library profiling"   , Option ['e'] ["exec-prof"]@@ -42,10 +42,13 @@   , Option ['j'] ["jobs"]       (ReqArg OptJobs "<jobs>")       "Run N jobs"+  , Option ['i'] ["import"]+      (ReqArg OptImport "<dir>:<dir>")+      "Add module import paths"   , Option ['h'] ["help"]       (NoArg OptHelp)       "Show help message"   ]  optionDB :: OptionDB-optionDB = zip [SwNoharm,SwRecursive,SwAll,SwInfo,SwFlag,SwTest,SwBench,SwDepsOnly,SwLibProfile,SwExecProfile,SwJobs] getOptDB+optionDB = zip [SwNoharm,SwRecursive,SwAll,SwInfo,SwFlag,SwTest,SwBench,SwDepsOnly,SwLibProfile,SwExecProfile,SwJobs,SwImport] getOptDB

@@ -20,6 +20,7 @@             | SwLibProfile             | SwExecProfile             | SwJobs+            | SwImport             deriving (Eq,Show)  toSwitch :: Option -> Switch@@ -34,18 +35,20 @@ toSwitch OptLibProfile  = SwLibProfile toSwitch OptExecProfile = SwExecProfile toSwitch (OptJobs _)    = SwJobs+toSwitch (OptImport _)  = SwImport toSwitch _              = error "toSwitch"  ----------------------------------------------------------------  optionArg :: Option -> String-optionArg (OptFlag str) = str-optionArg (OptJobs str) = str-optionArg _             = ""+optionArg (OptFlag   str) = str+optionArg (OptJobs   str) = str+optionArg (OptImport str) = str+optionArg _               = ""  ---------------------------------------------------------------- -data SwitchKind = None | Solo String | WithArg String+data SwitchKind = None | Solo String | WithEqArg String | FollowArg String  type SwitchSpec = (Switch, SwitchKind) type SwitchDB = [SwitchSpec]