cab 0.1.3 → 0.1.4
raw patch · 6 files changed
+68/−27 lines, 6 files
Files
- CmdDB.hs +8/−2
- Commands.hs +13/−6
- PkgDB.hs +42/−17
- Program.hs +1/−1
- Types.hs +3/−0
- cab.cabal +1/−1
CmdDB.hs view
@@ -32,7 +32,7 @@ ,(SwSandbox, Just "--sandbox") ,(SwFlag, Just "--flags") ]- , manual = Just "<package> [<ver>]"+ , manual = Just "[<package> [<ver>]]" } , CommandSpec { command = Uninstall@@ -52,6 +52,7 @@ , routing = RouteFunc installed , switches = [(SwAll, Nothing) ,(SwRecursive, Nothing)+ ,(SwInfo, Nothing) ,(SwSandbox, Just "--sandbox") ] , manual = Nothing@@ -121,6 +122,7 @@ , routing = RouteFunc deps , switches = [(SwRecursive, Nothing) ,(SwAll, Nothing)+ ,(SwInfo, Nothing) ,(SwSandbox, Just "--sandbox") ] , manual = Just "<package> [<ver>]"@@ -132,6 +134,7 @@ , routing = RouteFunc revdeps , switches = [(SwRecursive, Nothing) ,(SwAll, Nothing)+ ,(SwInfo, Nothing) ,(SwSandbox, Just "--sandbox") ] , manual = Just "<package> [<ver>]"@@ -199,6 +202,9 @@ , Option ['a'] ["all"] (NoArg OptAll) "Show global packages in addition to user packages"+ , Option ['i'] ["info"]+ (NoArg OptInfo)+ "Show license and author information" , Option ['s'] ["sandbox"] (ReqArg OptSandbox "<sandbox>") "Specify a sandbox directory"@@ -211,7 +217,7 @@ ] optionDB :: OptionDB-optionDB = zip [SwNoharm,SwRecursive,SwAll,SwSandbox,SwFlag] getOptDB+optionDB = zip [SwNoharm,SwRecursive,SwAll,SwInfo,SwSandbox,SwFlag] getOptDB ----------------------------------------------------------------
Commands.hs view
@@ -43,9 +43,13 @@ -- FIXME: the optall case does unnecessary conversion let pkgs = toPkgList flt db' db = toPkgDB pkgs- forM_ pkgs $ \pkg -> do- putStrLn . fullNameOfPkgInfo $ pkg- when optrec $ printDeps True db 1 pkg+ forM_ pkgs $ \pkgi -> do+ putStr $ fullNameOfPkgInfo pkgi+ extraInfo info pkgi+ putStrLn ""+ when optrec $ printDeps True info db 1 pkgi+ where+ info = OptInfo `elem` opts outdated :: FunctionCommand outdated _ _ opts = do@@ -101,7 +105,7 @@ system (script pkgconf) return () where- script pkgconf = "ghc-pkg check " ++ pkgconf+ script pkgconf = "ghc-pkg check -v " ++ pkgconf ---------------------------------------------------------------- @@ -112,14 +116,17 @@ revdeps _ nmver opts = printDepends nmver opts printRevDeps printDepends :: [String] -> [Option]- -> (Bool -> PkgDB -> Int -> PkgInfo -> IO ()) -> IO ()+ -> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()) -> IO () printDepends nmver opts func = do db' <- getPkgDB (getSandbox opts) pkg <- lookupPkg nmver db' db <- if OptAll `elem` opts then return db' else toPkgDB . flip toPkgList db' <$> userPkgs- func (OptRecursive `elem` opts) db 0 pkg+ func rec info db 0 pkg+ where+ rec = OptRecursive `elem` opts+ info = OptInfo `elem` opts ----------------------------------------------------------------
PkgDB.hs view
@@ -7,6 +7,8 @@ import qualified Data.Map as M import Distribution.Compiler (CompilerId(..))+import Distribution.License+ (License(..)) import Distribution.Version (Version(..)) import Distribution.InstalledPackageInfo@@ -48,14 +50,16 @@ return $ packageConf path com packageConf :: FilePath -> Compiler -> FilePath-packageConf path com = path </> "packages-" ++ version ++ ".conf"+packageConf path com = path </> "packages-" ++ version ver ++ ".conf" where CompilerId _ ver = compilerId com- version = toDotted . versionBranch $ ver toPkgDB :: [PkgInfo] -> PkgDB toPkgDB = fromList +version :: Version -> String+version = toDotted . versionBranch+ ---------------------------------------------------------------- lookupByName :: String -> PkgDB -> [PkgInfo]@@ -109,38 +113,59 @@ ---------------------------------------------------------------- -printDeps :: Bool -> PkgDB -> Int -> PkgInfo -> IO ()-printDeps rec db n pkgi = mapM_ (printDep rec db n) $ depends pkgi+extraInfo :: Bool -> PkgInfo -> IO ()+extraInfo False _ = return ()+extraInfo True pkgi = putStr $ " " ++ lcns ++ " \"" ++ auth ++ "\""+ where+ lcns = showLicense (license pkgi)+ auth = author pkgi -printDep :: Bool -> PkgDB -> Int -> InstalledPackageId -> IO ()-printDep rec db n pid = case lookupInstalledPackageId db pid of+----------------------------------------------------------------++printDeps :: Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()+printDeps rec info db n pkgi = mapM_ (printDep rec info db n) $ depends pkgi++printDep :: Bool -> Bool -> PkgDB -> Int -> InstalledPackageId -> IO ()+printDep rec info db n pid = case lookupInstalledPackageId db pid of Nothing -> return () Just pkgi -> do- putStrLn $ prefix ++ fullNameOfPkgInfo pkgi- when rec $ printDeps rec db (n+1) pkgi+ putStr $ prefix ++ fullNameOfPkgInfo pkgi+ extraInfo info pkgi+ putStrLn ""+ when rec $ printDeps rec info db (n+1) pkgi where prefix = replicate (n * 4) ' ' +showLicense :: License -> String+showLicense (GPL (Just v)) = "GPL" ++ version v+showLicense (GPL Nothing) = "GPL"+showLicense (LGPL (Just v)) = "LGPL" ++ version v+showLicense (LGPL Nothing) = "LGPL"+showLicense (UnknownLicense s) = s+showLicense x = show x+ ---------------------------------------------------------------- -printRevDeps :: Bool -> PkgDB -> Int -> PkgInfo -> IO ()-printRevDeps rec db n pkgi = printRevDeps' rec db revdb n pkgi+printRevDeps :: Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()+printRevDeps rec info db n pkgi = printRevDeps' rec info db revdb n pkgi where revdb = makeRevDepDB db -printRevDeps' :: Bool -> PkgDB -> RevDB -> Int -> PkgInfo -> IO ()-printRevDeps' rec db revdb n pkgi = case M.lookup pkgid revdb of+printRevDeps' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> PkgInfo -> IO ()+printRevDeps' rec info db revdb n pkgi = case M.lookup pkgid revdb of Nothing -> return ()- Just pkgids -> mapM_ (printRevDep' rec db revdb n) pkgids+ Just pkgids -> mapM_ (printRevDep' rec info db revdb n) pkgids where pkgid = installedPackageId pkgi -printRevDep' :: Bool -> PkgDB -> RevDB -> Int -> InstalledPackageId -> IO ()-printRevDep' rec db revdb n pid = case lookupInstalledPackageId db pid of+printRevDep' :: Bool -> Bool -> PkgDB -> RevDB -> Int -> InstalledPackageId -> IO ()+printRevDep' rec info db revdb n pid = case lookupInstalledPackageId db pid of Nothing -> return () Just pkgi -> do- putStrLn $ prefix ++ fullNameOfPkgInfo pkgi- when rec $ printRevDeps' rec db revdb (n+1) pkgi+ putStr $ prefix ++ fullNameOfPkgInfo pkgi+ extraInfo info pkgi+ putStrLn ""+ when rec $ printRevDeps' rec info db revdb (n+1) pkgi where prefix = replicate (n * 4) ' '
Program.hs view
@@ -1,7 +1,7 @@ module Program where version :: String-version = "0.1.3"+version = "0.1.4" programName :: String programName = "cab"
Types.hs view
@@ -12,6 +12,7 @@ data Switch = SwNoharm | SwRecursive | SwAll+ | SwInfo | SwSandbox | SwFlag deriving (Eq,Show)@@ -19,6 +20,7 @@ data Option = OptNoharm | OptRecursive | OptAll+ | OptInfo | OptSandbox String | OptFlag String | OptHelp@@ -28,6 +30,7 @@ toSwitch OptNoharm = SwNoharm toSwitch OptRecursive = SwRecursive toSwitch OptAll = SwAll+toSwitch OptInfo = SwInfo toSwitch (OptSandbox _) = SwSandbox toSwitch (OptFlag _) = SwFlag toSwitch _ = error "toSwitch"
cab.cabal view
@@ -1,5 +1,5 @@ Name: cab-Version: 0.1.3+Version: 0.1.4 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3