cabal-db 0.1.11 → 0.1.12

raw patch · 4 files changed

+56/−2 lines, 4 files

Files

• Src/Graph.hs +1/−0
• Src/Main.hs +48/−1
• Src/Options.hs +6/−0
• cabal-db.cabal +1/−1

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-} module Graph     ( GraphSt     , GraphIndex

@@ -24,8 +24,9 @@ import qualified Data.Map as M import Data.Either import Data.List-import Data.Tuple (swap)+import Data.Maybe (catMaybes) import Data.String+import Data.Tuple (swap)  import Options import Graph@@ -37,8 +38,10 @@  import qualified Text.PrettyPrint.ANSI.Leijen as PP +#if !MIN_VERSION_Cabal(1,22,0) unPackageName :: PackageName -> String unPackageName (PackageName n) = n+#endif  dependencyName :: Dependency -> PackageName dependencyName (Dependency n _) = n@@ -46,8 +49,14 @@ dependencyConstraints :: Dependency -> VersionRange dependencyConstraints (Dependency _ v) = v +#if MIN_VERSION_Cabal(1,22,0) finPkgDesc :: GenericPackageDescription -> Either [Dependency] (PackageDescription, FlagAssignment)+finPkgDesc = finalizePackageDescription [] (const True) buildPlatform compilerInfo []+  where compilerInfo = unknownCompilerInfo (CompilerId buildCompilerFlavor (Version []{-[7, 6, 2]-} [])) NoAbiTag+#else+finPkgDesc :: GenericPackageDescription -> Either [Dependency] (PackageDescription, FlagAssignment) finPkgDesc = finalizePackageDescription [] (const True) buildPlatform (CompilerId buildCompilerFlavor (Version []{-[7, 6, 2]-} [])) []+#endif  showVerconstr c = render $ Distribution.Text.disp c @@ -99,6 +108,15 @@         resolveIndex i = maybe (error ("internal error: unknown index: " ++ show i)) id $ M.lookup i idxTable         idxTable = M.fromList $ map swap $ M.toList aTable +vcs :: PackageDescription -> [(String,String)]+vcs = catMaybes . fmap f . sourceRepos+  where f r = do loc <- repoLocation r+                 let rev = case (repoTag r, repoBranch r) of+                       (Just a, _)        -> a+                       (Nothing, Just b)  -> b+                       (Nothing, Nothing) -> "master"+                 return (loc,rev)+ ----------------------------------------------------------------------- run apkgs hidePlatform hiddenPackages specifiedPackages = generateDotM colorize $ mapM_ (graphLoop getDeps) specifiedPackages   where colorize pn@@ -266,6 +284,35 @@         ppLicense BSD4                             = ("BSD4", col Green)         ppLicense MIT                              = ("MIT", col Green)         ppLicense l                                = (show l, col Magenta)++-----------------------------------------------------------------------+runCmd (CmdVCS rawArgs) = do+    (pkgNames, pkgFileNames) <- packageArgs rawArgs++    availablePackages <- loadAvailablePackages pkgFileNames++    let depNames = getPackageDependencyNames availablePackages+        mkGraph = mapM_ (graphLoop depNames) pkgNames+    t <- M.fromList . unindexify <$> withGraph mkGraph+    void $ foldM (loop availablePackages t 0) M.empty pkgNames+  where+        showVCS (url,rev) = col Yellow $ concat [url, "@",  rev]+        loop apkgs tbl indentSpaces founds pn@(PackageName name)+            | M.member pn founds = return founds+            | otherwise = do+                let desc = finPkgDesc <$> getPackageDescription apkgs pn Nothing+                case desc of+                    Just (Right (d,_)) -> do+                        let found = vcs d+                            uriTexts = showVCS <$> found+                        ppLine indentSpaces $ PP.text name PP.<> PP.colon+                        case uriTexts of+                          [] -> ppLine (indentSpaces+2) $ col Red "No associated repo"+                          _ -> mapM_ (ppLine(indentSpaces+2)) uriTexts+                        case M.lookup pn tbl of+                            Just l  -> foldM (loop apkgs tbl (indentSpaces + 2)) (M.insert pn found founds) l+                            Nothing -> error "internal error"+                    _ -> return founds  ----------------------------------------------------------------------- runCmd (CmdSearch term vals) = do

@@ -33,6 +33,9 @@         , licensePrintSummary :: Bool         , licensePackages :: [String]         }+    | CmdVCS+        { vcsPackages :: [String]+        }     | CmdBumpable         { bumpablePackages :: [String]         }@@ -54,6 +57,7 @@     , ("search-author", cmdSearch SearchAuthor, "search the cabal database by author(s)")     , ("search-maintainer", cmdSearch SearchMaintainer, "search the cabal database by maintainer(s)")     , ("license", cmdLicense, "list all licenses of a set of packages and their dependencies")+    , ("vcs", cmdVCS, "list all registered repo URLs for each a set of packages and their dependencies")     , ("bumpable", cmdBumpable, "list all dependencies that could receive an upper-bound version bump")     , ("check-revdeps-policy", cmdCheckRevdepsPolicy, "check dependencies policy for reverse dependencies of a list of packages")     , ("check-policy", cmdCheckPolicy, "check dependencies policy for packages")@@ -77,6 +81,8 @@                 <$> switch (short 't' <> long "tree" <> help "show the tree dependencies of license")                 <*> switch (short 's' <> long "summary" <> help "Show the summary")                 <*> packages+        cmdVCS = CmdVCS+                <$> packages         cmdBumpable = CmdBumpable                 <$> packages         cmdCheckRevdepsPolicy = CmdCheckRevdepsPolicy

@@ -1,5 +1,5 @@ Name:                cabal-db-Version:             0.1.11+Version:             0.1.12 Synopsis:            query tools for the local cabal database Description:     Query tool for the local cabal database