diff --git a/CmdDB.hs b/CmdDB.hs --- a/CmdDB.hs +++ b/CmdDB.hs @@ -32,7 +32,7 @@ ,(SwSandbox, Just "--sandbox") ,(SwFlag, Just "--flags") ] - , manual = Just " []" + , manual = Just "[ []]" } , 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 " []" @@ -132,6 +134,7 @@ , routing = RouteFunc revdeps , switches = [(SwRecursive, Nothing) ,(SwAll, Nothing) + ,(SwInfo, Nothing) ,(SwSandbox, Just "--sandbox") ] , manual = Just " []" @@ -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 "") "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 ---------------------------------------------------------------- diff --git a/Commands.hs b/Commands.hs --- a/Commands.hs +++ b/Commands.hs @@ -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 ---------------------------------------------------------------- diff --git a/PkgDB.hs b/PkgDB.hs --- a/PkgDB.hs +++ b/PkgDB.hs @@ -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) ' ' diff --git a/Program.hs b/Program.hs --- a/Program.hs +++ b/Program.hs @@ -1,7 +1,7 @@ module Program where version :: String -version = "0.1.3" +version = "0.1.4" programName :: String programName = "cab" diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -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" diff --git a/cab.cabal b/cab.cabal --- a/cab.cabal +++ b/cab.cabal @@ -1,5 +1,5 @@ Name: cab -Version: 0.1.3 +Version: 0.1.4 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3