packages feed

cabal-db 0.1.9 → 0.1.10

raw patch · 7 files changed

+296/−97 lines, 7 filesdep ~optparse-applicative

Dependency ranges changed: optparse-applicative

Files

README.md view
@@ -1,6 +1,10 @@ A simple tool for cabal database query ====================================== +[![Build Status](https://travis-ci.org/vincenthz/cabal-db.png?branch=master)](https://travis-ci.org/vincenthz/cabal-db)+[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses)+[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org)+ A misc set of tools to operate misc queries on the local cabal database and the associated packages  Command@@ -14,6 +18,8 @@ * graph: generate a dot format graph of the dependency * license: list all licenses used by packages and their dependencies * bumpable: list all the upper version bounds that could be bumped for a list of packages+* check-policy: list the contraints type (policy) of dependency of packages+* check-revdeps-policy: list the contraints type (policy) of a specific package as used by all packages  Check the original blog post for more information: 
+ Src/Env.hs view
@@ -0,0 +1,35 @@+module Env+    ( isPlatformPackage+    ) where++import Distribution.Package (PackageName(..))+import qualified Data.Set as S++platformPackages = S.fromList $ map PackageName $+    ["array"+    ,"base", "bytestring"+    ,"containers", "cgi"+    ,"deepseq","directory"+    ,"extensible-exceptions"+    ,"fgl","filepath"+    ,"GLUT"+    ,"haskell-src","haskell2010","haskell98","hpc","html","HUnit"+    ,"mtl"+    ,"network"+    ,"old-locale","old-time","OpenGL"+    ,"parallel","parsec","pretty","primitive","process"+    ,"QuickCheck"+    ,"random","regex-base","regex-compat","regex-posix"+    ,"split","stm","syb"+    ,"template-haskell","text","time","transformers"+    ,"unix"+    ,"vector"+    ,"xhtml"+    ,"zlib"+    ] ++ -- not stricly platform package, but act as such+    ["GHC"+    ,"Cabal"+    ,"ghc-prim"+    ]++isPlatformPackage pn = pn `S.member` platformPackages
Src/Main.hs view
@@ -32,43 +32,48 @@ import Data.List import Data.Maybe import Data.Tuple (swap)+import Data.String  import Options import Graph+import Env+import Ver+import Printing  import qualified Text.PrettyPrint.ANSI.Leijen as PP -platformPackages = map PackageName $-    ["array"-    ,"base", "bytestring"-    ,"containers", "cgi"-    ,"deepseq","directory"-    ,"extensible-exceptions"-    ,"fgl","filepath"-    ,"GLUT"-    ,"haskell-src","haskell2010","haskell98","hpc","html","HUnit"-    ,"mtl"-    ,"network"-    ,"old-locale","old-time","OpenGL"-    ,"parallel","parsec","pretty","primitive","process"-    ,"QuickCheck"-    ,"random","regex-base","regex-compat","regex-posix"-    ,"split","stm","syb"-    ,"template-haskell","text","time","transformers"-    ,"unix"-    ,"vector"-    ,"xhtml"-    ,"zlib"-    ] ++ -- not stricly platform package, but act as such-    ["GHC"-    ,"Cabal"-    ,"ghc-prim"-    ]- -- FIXME use cabal's Version type.-type Ver = String-newtype AvailablePackages = AvailablePackages (M.Map PackageName [(String,L.ByteString)])+newtype AvailablePackages = AvailablePackages (M.Map PackageName [(Ver,L.ByteString)]) +data Policy =+      Policy_Any            -- ^ no bounds+    | Policy_LowerBoundOnly -- ^ only a lower specified+    | Policy_Bounded        -- ^ when both bounds specified but not following the pvp as the version is not correct+    | Policy_StrictPVP      -- ^ follow the PVP, lower bound, and higher bounds not greater to one that exist.+    | Policy_Other          -- ^ unspecified+    | Policy_Many [Policy]  -- ^ multiple policy in the same file. something probably went wrong in cabal-db :)+    deriving (Show,Eq,Ord)++showPolicy :: Policy -> PP.Doc -- String+showPolicy Policy_Any            = PP.green $ PP.text "any"+showPolicy Policy_LowerBoundOnly = PP.yellow $ PP.text "lower-bound"+showPolicy Policy_StrictPVP      = PP.red $ PP.text "strict-pvp"+showPolicy Policy_Bounded        = PP.blue $ PP.text "bounded"+showPolicy Policy_Other          = PP.blue $ PP.text "other"+showPolicy (Policy_Many  _)      = PP.blue $ PP.text "many"++getPolicy :: AvailablePackages -> VersionRange -> Policy+getPolicy (AvailablePackages _apkgs) vr+    | isAnyVersion vr = Policy_Any+    | otherwise       =+        let vi = asVersionIntervals vr+         in if and $ map isBounded vi+                then Policy_StrictPVP+                else Policy_LowerBoundOnly+  where+        isBounded (_, NoUpperBound)   = False+        isBounded (_, UpperBound _ _) = True+ -- | return cabal 00-index.tar filepath readCabalConfig = do     cfgEnv <- lookup "CABAL_CONFIG" <$> getEnvironment@@ -96,6 +101,12 @@ unPackageName :: PackageName -> String unPackageName (PackageName n) = n +dependencyName :: Dependency -> PackageName+dependencyName (Dependency n _) = n++dependencyConstraints :: Dependency -> VersionRange+dependencyConstraints (Dependency _ v) = v+ finPkgDesc :: GenericPackageDescription -> Either [Dependency] (PackageDescription, FlagAssignment) finPkgDesc = finalizePackageDescription [] (const True) buildPlatform (CompilerId buildCompilerFlavor (Version []{-[7, 6, 2]-} [])) [] @@ -111,21 +122,21 @@  getPackageVersions :: AvailablePackages -> PackageName -> Maybe [Ver] getPackageVersions (AvailablePackages apkgs) pn =-    sortVers . map fst <$> M.lookup pn apkgs+    sort . map fst <$> M.lookup pn apkgs +getPackageDependencies :: AvailablePackages -> PackageName -> IO [Dependency]+getPackageDependencies apkgs pn = do+    let desc = finPkgDesc <$> getPackageDescription apkgs pn Nothing+    case desc of+        Just (Right (d,_)) -> return $ buildDepends d+        _                  -> return []++getPackageDependencyNames apkgs pn =+    map dependencyName <$> getPackageDependencies apkgs pn+ -- | sort versions, lowest first sortVers :: [Ver] -> [Ver]-sortVers = sortBy compareVer-  where compareVer v1 v2 =-            case (break (== '.') v1, break (== '.') v2) of-                (("",_),("",_))   -> EQ-                (("",_),_)        -> LT-                (_,("",_))        -> GT-                ((i1,r1),(i2,r2)) | i1 == i2  -> compareVer (dropDot r1) (dropDot r2)-                                  | otherwise -> compare (read i1 :: Int) (read i2)-        dropDot s | s == []       = s-                  | head s == '.' = drop 1 s-                  | otherwise     = s+sortVers = sort  getPackageDescription :: AvailablePackages -> PackageName -> Maybe Ver -> Maybe GenericPackageDescription getPackageDescription (AvailablePackages apkgs) pn mver =@@ -133,6 +144,9 @@   where resolveVer Nothing pdescs  = lookup (last $ sortVers $ map fst pdescs) pdescs         resolveVer (Just v) pdescs = lookup v pdescs +getPackageLatestMajorVersion :: AvailablePackages -> PackageName -> Maybe (Int,Int)+getPackageLatestMajorVersion apkgs pn = versionMajor =<< last <$> getPackageVersions apkgs pn+ foldallLatest :: Monad m => AvailablePackages -> a -> (a -> PackageName -> PackageDescription -> m a) -> m a foldallLatest apkgs acc f = foldM process acc (getAllPackageName apkgs)         where process a pn = case finPkgDesc <$> getPackageDescription apkgs pn Nothing of@@ -143,7 +157,7 @@ loadAvailablePackages = do     tarFile <- readCabalConfig -    foldl' mkMap (AvailablePackages M.empty) . listTar . Tar.read <$> L.readFile tarFile +    foldl' mkMap (AvailablePackages M.empty) . listTar . Tar.read <$> L.readFile tarFile      where listTar :: Show e => Tar.Entries e -> [([FilePath],L.ByteString)]           listTar (Tar.Next ent nents) =@@ -157,7 +171,7 @@           mkMap (AvailablePackages acc) ([(dropTrailingPathSeparator -> packagename),packageVer,_],entBS)                 | packagename == "." = AvailablePackages acc                 | otherwise          = AvailablePackages $ tweak (PackageName packagename)-                                                                 (dropTrailingPathSeparator packageVer)+                                                                 (fromString $ dropTrailingPathSeparator packageVer)                                                                  entBS acc                           where tweak !pname !pver !cfile !m = M.alter alterF pname m                                   where alterF Nothing  = Just [(pver,cfile)]@@ -188,7 +202,7 @@ run apkgs hidePlatform hiddenPackages specifiedPackages = generateDotM colorize $ mapM_ (graphLoop getDeps) specifiedPackages   where colorize pn             | pn `elem` specifiedPackages = Just "red"-            | pn `elem` platformPackages  = Just "green"+            | isPlatformPackage pn        = Just "green"             | otherwise                   = Nothing          getDeps :: PackageName -> IO [PackageName]@@ -197,7 +211,7 @@             case desc of                 Just (Right (d,_)) ->                     return-                        $ (if hidePlatform then filter (not . flip elem platformPackages) else id)+                        $ (if hidePlatform then filter (not . isPlatformPackage) else id)                         $ filter (not . flip elem hiddenPackages)                         $ map (\(Dependency n _) -> n) $ buildDepends d                 _ -> do@@ -227,7 +241,7 @@                 return $ PP.string depname PP.<+> PP.string "->" PP.<+> PP.cat (intersperse PP.dot (map PP.int (versionBranch v)))     forM_ bumpables $ \(pname, desc) -> PP.putDoc (PP.string pname PP.<$> PP.indent 4 (PP.vcat desc) PP.<> PP.line) ------------------------------------------------------------------------runCmd (CmdDiff (PackageName -> pname) v1 v2) = runDiff+runCmd (CmdDiff (PackageName -> pname) (fromString -> v1) (fromString -> v2)) = runDiff   where runDiff = do             availablePackages <- loadAvailablePackages             let mvers = getPackageVersions availablePackages pname@@ -256,14 +270,15 @@                         Right () -> return dir         changeAndRemoveDirectory cd dir =             setCurrentDirectory cd >> removeDirectoryRecursive dir+        cabalUnpack :: PackageName -> Ver -> IO ()         cabalUnpack (PackageName pn) v = do-            ec <- rawSystem "cabal" ["unpack", pn ++ "-" ++ v]+            ec <- rawSystem "cabal" ["unpack", pn ++ "-" ++ show v]             case ec of                 ExitSuccess   -> return ()                 ExitFailure i -> error ("cabal unpack failed with error code: " ++ show i)         diff (PackageName pn) = do-            let dir1 = pn ++ "-" ++ v1-            let dir2 = pn ++ "-" ++ v2+            let dir1 = pn ++ "-" ++ show v1+            let dir2 = pn ++ "-" ++ show v2             _ <- rawSystem "diff" ["-Naur", dir1, dir2]             return () @@ -292,31 +307,23 @@             Just (Right (d,_)) -> do                 putStrLn (show arg)                 putStrLn ("  synopsis: " ++ synopsis d)-                putStrLn ("  versions: " ++ intercalate ", " vers)-                putStrLn ("  dependencies for " ++ (last vers) ++ ":")+                putStrLn ("  versions: " ++ intercalate ", " (map show vers))+                putStrLn ("  dependencies for " ++ show (last vers) ++ ":")                 mapM_ (\(Dependency p v) -> putStrLn ("    " ++ unPackageName p ++ " (" ++ showVerconstr v ++ ")")) (buildDepends d)             _                  -> error "cannot resolve package"  ----------------------------------------------------------------------- runCmd (CmdLicense printTree printSummary (map PackageName -> args)) = do     availablePackages <- loadAvailablePackages-    t <- M.fromList . unindexify <$> withGraph (mapM_ (graphLoop (getDeps availablePackages)) args)+    t <- M.fromList . unindexify <$> withGraph (mapM_ (graphLoop (getPackageDependencyNames availablePackages)) args)     foundLicenses <- foldM (loop availablePackages t 0) M.empty args      when ((not printTree && not printSummary) || printSummary) $ do         putStrLn "== license summary =="         forM_ (map nameAndLength $ group $ sortBy licenseCmp $ map snd $ M.toList foundLicenses) $ \(licenseName, licenseNumb) -> do             let (lstr, ppComb) = ppLicense licenseName-            PP.putDoc (ppComb (PP.text lstr) PP.<> PP.colon PP.<+> PP.text (show licenseNumb) PP.<> PP.line)--  where getDeps apkgs pn = do-            let desc = finPkgDesc <$> getPackageDescription apkgs pn Nothing-            case desc of-                Just (Right (d,_)) -> do-                    let deps = map (\(Dependency n _) -> n) $ buildDepends d-                    return deps-                _ ->-                    return []+            ppLine 0 (ppComb lstr PP.<> PP.colon PP.<+> PP.text (show licenseNumb))+  where         loop apkgs tbl indentSpaces founds pn@(PackageName name)             | M.member pn founds = return founds             | otherwise = do@@ -326,7 +333,7 @@                         let found = license d                         when printTree $ do                             let (lstr, ppComb) = ppLicense found-                            PP.putDoc $ PP.text (replicate indentSpaces ' ') PP.<> PP.text name PP.<> PP.colon PP.<+> ppComb (PP.text lstr) PP.<> PP.line+                            ppLine 0 (PP.text (replicate indentSpaces ' ') PP.<> PP.text name PP.<> PP.colon PP.<+> ppComb lstr)                         case M.lookup pn tbl of                             Just l  -> foldM (loop apkgs tbl (indentSpaces + 2)) (M.insert pn found founds) l                             Nothing -> error "internal error"@@ -338,18 +345,20 @@         nameAndLength []      = error "empty group"         nameAndLength l@(x:_) = (x, length l) -        ppLicense (GPL (Just (Version [v] [])))    = ("GPLv" ++ show v, PP.yellow)-        ppLicense (GPL Nothing)                    = ("GPL", PP.yellow)+        ppLicense (GPL (Just (Version [v] [])))    = ("GPLv" ++ show v, col Yellow)+        ppLicense (GPL Nothing)                    = ("GPL", col Yellow) #if MIN_VERSION_Cabal(1,18,0)-        ppLicense (AGPL (Just (Version [v] [])))   = ("AGPLv" ++ show v, PP.yellow)+        ppLicense (AGPL (Just (Version [v] [])))   = ("AGPLv" ++ show v, col Yellow) #endif-        ppLicense (LGPL (Just (Version [v] [])))   = ("LGPLv" ++ show v, PP.yellow)-        ppLicense (Apache (Just (Version [v] []))) = ("Apache" ++ show v, PP.green)-        ppLicense (UnknownLicense s)               = (s, PP.red)-        ppLicense BSD3                             = ("BSD3", PP.green)-        ppLicense BSD4                             = ("BSD4", PP.green)-        ppLicense MIT                              = ("MIT", PP.green)-        ppLicense l                                = (show l, PP.magenta)+        ppLicense (LGPL (Just (Version [v] [])))   = ("LGPLv" ++ show v, col Yellow)+#if MIN_VERSION_Cabal(1,16,0)+        ppLicense (Apache (Just (Version [v] []))) = ("Apache" ++ show v, col Green)+#endif+        ppLicense (UnknownLicense s)               = (s, col Red)+        ppLicense BSD3                             = ("BSD3", col Green)+        ppLicense BSD4                             = ("BSD4", col Green)+        ppLicense MIT                              = ("MIT", col Green)+        ppLicense l                                = (show l, col Magenta)  ----------------------------------------------------------------------- runCmd (CmdSearch term vals) = do@@ -364,6 +373,67 @@         accessor = toAccessor term         toAccessor SearchMaintainer = maintainer         toAccessor SearchAuthor     = author++-----------------------------------------------------------------------++runCmd (CmdCheckRevdepsPolicy (map PackageName -> pkgs)) = do+    availablePackages <- loadAvailablePackages++    ret <- foldallLatest availablePackages M.empty $ \accOuter pkgname pkgDesc -> do+        let deps = buildDepends pkgDesc+        foldM (accOnDep availablePackages pkgname) accOuter deps+    forM_ (M.toList ret) $ \(p, z) -> do+        let sums = map (\l -> (head l, length l)) $ group $ sort $ map snd $ M.toList z+        putStrLn ("== " ++ show p)+        forM_ (M.toList z) $ \(revDep, policy) -> do+            ppLine 2 $ PP.hcat [PP.string (unPackageName revDep), PP.colon, showPolicy policy]+        forM_ sums $ \(policy, n) ->+            ppLine 0 $ PP.hcat [PP.string (show n), PP.string " packages have a constraint set to ", showPolicy policy ]+    return ()+  where accOnDep allPackages pkg a dep =+            case find (== dependencyName dep) pkgs of+                Nothing              -> return a+                Just packageMatching ->+                    let vr = dependencyConstraints dep+                     in return $ updatePolTree a packageMatching pkg (getPolicy allPackages vr)++        updatePolTree :: M.Map PackageName (M.Map PackageName Policy)+                      -> PackageName+                      -> PackageName+                      -> Policy+                      -> M.Map PackageName (M.Map PackageName Policy)+        updatePolTree a withPkg pkg pol = M.alter updateRoot withPkg a+          where updateRoot :: Maybe (M.Map PackageName Policy) -> Maybe (M.Map PackageName Policy)+                updateRoot Nothing  = Just (M.alter x pkg M.empty)+                updateRoot (Just l) = Just (M.alter x pkg l)+                x :: Maybe Policy -> Maybe Policy+                x Nothing          = Just pol+                x (Just actualPol) =+                    case actualPol of+                        Policy_Many ps | pol `elem` ps -> Just actualPol+                                       | otherwise     -> Just $ Policy_Many (pol:ps)++                        _ | actualPol == pol -> Just actualPol+                          | otherwise        -> Just $ Policy_Many (pol:[actualPol])++runCmd (CmdCheckPolicy (map PackageName -> pkgs)) = do+    availablePackages <- loadAvailablePackages+    matched <- foldallLatest availablePackages M.empty $ \acc pkgName pkgDesc ->+        if pkgName `elem` pkgs+            then return $ M.insert pkgName pkgDesc acc+            else return acc+    forM_ (M.toList matched) $ \(pkgName, pkgDesc) -> do+        putStrLn ("== " ++ unPackageName pkgName)+        let depends = map (\d -> (dependencyName d, getPolicy availablePackages $ dependencyConstraints d))+                    $ buildDepends pkgDesc+        let sums = map (\l -> (head l, length l)) $ group $ sort $ map snd depends+        forM_ depends $ \(n,p) ->+            ppLine 4 $ PP.hcat [ PP.string "* ", PP.string (unPackageName n), PP.string " = ", showPolicy p]+        forM_ sums $ \(policy, n) ->+            ppLine 2 $ PP.hcat [ showPolicy policy, PP.string " = ", PP.string (show n), PP.string " packages"]++runCmd (CmdForAll) = do+    return ()  ----------------------------------------------------------------------- main = getOptions >>= runCmd
Src/Options.hs view
@@ -5,9 +5,7 @@     ) where  import Options.Applicative-import Paths_cabal_db (version)-import Data.Version-import Data.List (intercalate)+import Data.Monoid (mconcat)  data Command =       CmdGraph@@ -38,42 +36,56 @@     | CmdBumpable         { bumpablePackages :: [String]         }+    | CmdCheckPolicy+        { checkPolicyPackage :: [String]+        }+    | CmdCheckRevdepsPolicy+        { checkRevdepsPolicyPackage :: [String]+        }+    | CmdForAll  data SearchTerm = SearchMaintainer | SearchAuthor -parseCArgs = subparser-    (  command "graph" (info cmdGraph (progDesc "generate a .dot dependencies graph of all the packages in argument"))-    <> command "diff" (info cmdDiff (progDesc "generate a diff between two versions of a package"))-    <> command "revdeps" (info cmdRevdeps (progDesc "list all reverse dependencies of a set of packages"))-    <> command "info" (info cmdInfo (progDesc "list some information about a set of packages"))-    <> command "search-author" (info (cmdSearch SearchAuthor) (progDesc "search the cabal database by author(s)"))-    <> command "search-maintainer" (info (cmdSearch SearchMaintainer) (progDesc "search the cabal database by maintainer(s)"))-    <> command "license" (info cmdLicense (progDesc "list all licenses of a set of packages and their dependencies"))-    <> command "bumpable" (info cmdBumpable (progDesc "list all dependencies that could receive an upper-bound version bump"))-    )+commands =+    [ ("graph", cmdGraph, "generate a .dot dependencies graph of all the packages in argument")+    , ("diff", cmdDiff, "generate a diff between two versions of a package")+    , ("revdeps", cmdRevdeps, "list all reverse dependencies of a set of packages")+    , ("info", cmdInfo, "list some information about a set of packages")+    , ("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")+    , ("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")+    , ("forall", cmdForAll, "forall packages (debug)")+    ]   where cmdGraph = CmdGraph                 <$> many (strOption (long "hide" <> short 'h' <> metavar "PACKAGE" <> help "package to hide"))                 <*> switch (long "hide-platform" <> help "Hide all packages from the platform")                 <*> packages         cmdDiff = CmdDiff-                <$> argument Just (metavar "<package>")-                <*> argument Just (metavar "<ver1>")-                <*> argument Just (metavar "<ver2>")+                <$> argument str (metavar "<package>")+                <*> argument str (metavar "<ver1>")+                <*> argument str (metavar "<ver2>")         cmdRevdeps = CmdRevdeps                 <$> packages         cmdInfo = CmdInfo                 <$> packages         cmdSearch accessor = CmdSearch accessor-                <$> many (argument Just (metavar "<search-term>"))+                <$> many (argument str (metavar "<search-term>"))         cmdLicense = CmdLicense                 <$> switch (short 't' <> long "tree" <> help "show the tree dependencies of license")                 <*> switch (short 's' <> long "summary" <> help "Show the summary")                 <*> packages         cmdBumpable = CmdBumpable                 <$> packages-        packages = some (argument Just (metavar "<packages..>"))+        cmdCheckRevdepsPolicy = CmdCheckRevdepsPolicy+                <$> packages+        cmdCheckPolicy = CmdCheckPolicy+                <$> packages+        cmdForAll = pure CmdForAll+        packages = some (argument str (metavar "<packages..>"))  getOptions :: IO Command-getOptions = execParser (info (pVersion *> parseCArgs <**> helper) idm)-  where pVersion = infoOption ver (long "version" <> help "Print version information")-        ver = intercalate "." $ map show $ versionBranch version+getOptions = execParser (info (parseCArgs <**> helper) idm)+  where parseCArgs = subparser $ mconcat $ map (\(name, v, desc) -> command name (info v (progDesc desc))) commands
+ Src/Printing.hs view
@@ -0,0 +1,21 @@+module Printing+    ( col+    , Color(..)+    , ppLine+    ) where++import qualified Text.PrettyPrint.ANSI.Leijen as PP++data Color = Green | Yellow | Red | Blue | Magenta++col :: Color -> String -> PP.Doc+col Green txt   = PP.green $ PP.text txt+col Yellow txt  = PP.yellow $ PP.text txt+col Red txt     = PP.red $ PP.text txt+col Blue txt    = PP.blue $ PP.text txt+col Magenta txt = PP.magenta $ PP.text txt++ppLine :: Int -> PP.Doc -> IO ()+ppLine idt cont = PP.putDoc (PP.indent idt cont PP.<> PP.line)++--ppKV :: String -> PP.Doc -> IO ()
+ Src/Ver.hs view
@@ -0,0 +1,48 @@+module Ver+    ( Ver(..)+    , ver+    , versionMajor+    ) where++import Data.String+import Data.List++newtype Ver = Ver String -- [Int]+    deriving (Eq)++instance Ord Ver where+    compare (Ver v1) (Ver v2) = compareVer v1 v2++compareVer v1 v2 =+    case (break (== '.') v1, break (== '.') v2) of+        (("",_),("",_))   -> EQ+        (("",_),_)        -> LT+        (_,("",_))        -> GT+        ((i1,r1),(i2,r2)) | i1 == i2  -> compareVer (dropDot r1) (dropDot r2)+                          | otherwise -> compare (read i1 :: Int) (read i2)+  where dropDot s | s == []       = s+                  | head s == '.' = drop 1 s+                  | otherwise     = s++ver :: [Int] -> Ver+ver [] = error "empty version"+ver l  = Ver $ intercalate "." $ map show l++versionMajor :: Ver -> Maybe (Int,Int)+versionMajor (Ver l) =+    case toInts l of+        a:b:_ -> Just (a,b)+        _     -> Nothing++instance Show Ver where+    show (Ver s) = s++instance IsString Ver where+    fromString s = Ver s++toInts :: String -> [Int]+toInts verstr = loop verstr+  where loop s = case break (== '.') s of+            (v, '.':xs) -> read v : loop xs+            (v, "")     -> [read v]+            (_, _)      -> error ("cannot parse version: " ++ show verstr)
cabal-db.cabal view
@@ -1,6 +1,6 @@ Name:                cabal-db-Version:             0.1.9-Synopsis:            query tools for the local cabal database (revdeps, graph, info, search-by, license, bounds)+Version:             0.1.10+Synopsis:            query tools for the local cabal database Description:     Query tool for the local cabal database     .@@ -15,6 +15,10 @@       * List licenses of package and their dependencies     .       * List all the upper version bounds that could be bumped for a list of packages+    .+      * List dependencies constraint policy in package+    .+      * List package's contraint policy for dependency on specific package  License:             BSD3 License-file:        LICENSE@@ -33,6 +37,9 @@   hs-source-dirs:    Src   Other-modules:     Graph                    , Options+                   , Printing+                   , Env+                   , Ver   ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures   Build-depends:     base >= 4 && < 5                    , mtl@@ -45,7 +52,7 @@                    , utf8-string                    , pretty                    , process-                   , optparse-applicative+                   , optparse-applicative >= 0.11                    , ansi-wl-pprint   Buildable: True