packages feed

bumper (empty) → 0.5

raw patch · 7 files changed

+414/−0 lines, 7 filesdep +Cabaldep +ConfigFiledep +HTTPsetup-changed

Dependencies added: Cabal, ConfigFile, HTTP, base, bytestring, containers, directory, fclabels, filepath, mtl, network, process, random, regex-compat, split, strict

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2012 Silk+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of Universiteit Utrecht nor the names of its contributors+   may be used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bumper.cabal view
@@ -0,0 +1,41 @@+Name:             bumper+Version:          0.5+Synopsis:         Automatically bump package versions, also transitively.+Description:      Automatically bump package versions, also transitively.+Author:           Silk+Copyright:        (c) 2012, Silk+Maintainer:       code@silkapp.com+Homepage:         http://github.com/silkapp/bumper+Category:         Development+License:          BSD3+License-File:     LICENSE+Cabal-Version:    >= 1.6+Build-Type:       Simple++Executable bumper+  Build-Depends:    base == 4.*+                  , Cabal        >= 1.6    && < 1.15+                  , ConfigFile   >= 1.0    && < 1.2+                  , HTTP         >= 4000.0 && < 4000.3+                  , bytestring   == 0.9.*+                  , containers   == 0.4.*+                  , directory    >= 1.0    && < 1.2+                  , fclabels     >= 1.0    && < 1.2+                  , filepath     >= 1.1    && < 1.4+                  , mtl          >= 1.1    && < 2.2+                  , network      >= 2.2    && < 2.4+                  , process      >= 1.0    && < 1.2+                  , random       == 1.0.*+                  , regex-compat >= 0.93   && < 0.96+                  , split        == 0.1.*+                  , strict       == 0.3.2+  GHC-Options:      -Wall+  HS-Source-Dirs:   src+  Main-is:          Bumper.hs+  Other-Modules:    Config+                    Package+                    Version++Source-Repository head+  Type:           git+  Location:       git://github.com/silkapp/bumper.git
+ src/Bumper.hs view
@@ -0,0 +1,79 @@+module Main where++import Config+import Data.Label+import Data.List+import Data.Version+import Distribution.Package hiding (Package)+import Distribution.Text+import Distribution.Version+import Package+import Version+import qualified Data.Map as M+import qualified Paths_bumper as Paths++main :: IO ()+main =+  do conf <- getConfig+     case get action conf of+       ShowHelp    -> printUsage options+       ShowVersion -> putStrLn $ "bumper, version " ++ showVersion Paths.version+       ShowDeps    -> run conf showDeps+       Run         -> run conf updateDeps+  where+    showDeps   _    changed = putStr $ intercalate " " $ map display $ M.keys changed+    updateDeps base changed = mapM_ (\p -> updatePackage p (makeUpdates p)) base+      where+        makeUpdates p = (M.lookup (get name p) changed, dependencyUpdates changed p)++run :: Config -> (Packages -> Changes -> IO ()) -> IO ()+run conf act =+  do -- Load packages+     ps   <- packages+     -- Retrieve base versions+     base <- maybe (return ps) (flip getBaseVersions ps) $ get global conf+     let changed = (if get transitive conf then trans base else id)+                 $ concatChanges (map (\(p,pks) -> bumpVersions p pks base) (M.toAscList (get bump conf)))+               <.> userVersions (get setVersion conf) base+     act base changed++type Changes = M.Map PackageName Version++-- Combine changes, not updating already changed packages+infixr 5 <.>+(<.>) :: Changes -> Changes -> Changes+(<.>) = M.unionWith (flip const)++concatChanges :: [Changes] -> Changes+concatChanges = foldr (<.>) M.empty++-- | Update versions+userVersions :: [(PackageName, Version)] -> Packages -> Changes+userVersions vs ps = M.fromList $ filter (\nv -> hasPackage (fst nv) ps) vs++bumpVersions :: Int -> [PackageName] -> Packages -> Changes+bumpVersions pos ns ps = M.fromList $ map (\p -> (get name p, bumpPosition pos (get version p))) $ lookupPackages ns ps++-- | Make transitive changes+trans :: Packages -> Changes -> Changes+trans ps = fix (transStep ps)++transStep :: Packages -> Changes -> Changes+transStep ps old = new <.> old+  where deps = filter (not . null . dependencyUpdates old) ps+        new  = M.fromList . map (\p -> (get name p, bumpPosition 2 (get version p))) $ deps++fix :: (Eq a) => (a -> a) -> a -> a+fix f a | b == a    = a+        | otherwise = fix f b+  where b = f a++-- | Caclulate updated dependencies+dependencyUpdates :: Changes -> Package -> [Dependency]+dependencyUpdates ch = foldr addDep [] . get dependencies+  where addDep (Dependency n r) dps =+          case M.lookup n ch of+            Just v  -> if withinRange v r+                        then dps+                        else Dependency n (addVersionToRange v r) : dps+            Nothing -> dps
+ src/Config.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE+    TypeOperators+  , TemplateHaskell+  #-}+module Config where++import Data.Label+import Data.List.Split+import Data.Version+import Distribution.Package+import Distribution.Text+import System.Console.GetOpt+import System.Environment+import qualified Data.Map as M++data Action = Run+            | ShowDeps+            | ShowHelp+            | ShowVersion+            deriving Show++data Config = Config+  { _bump       :: M.Map Int [PackageName] -- Map of which packages to bump at which position+  , _setVersion :: [(PackageName,Version)]+  , _transitive :: Bool+  , _ignore     :: [PackageName]+  , _global     :: Maybe String+  , _action     :: Action+  } deriving Show++$(mkLabels [''Config])++defaultConfig :: Config+defaultConfig = Config+    { _bump       = M.empty+    , _setVersion = []+    , _transitive = True+    , _ignore     = []+    , _global     = Nothing+    , _action     = Run+    }++versionPar :: String -> [(PackageName, Version)]+versionPar = foldr addVer [] . splitOn ","+  where addVer fld ac =+          case splitOn "@" fld of+            [p,v] -> case simpleParse v of+                        (Just ver) -> (PackageName p, ver) : ac+                        Nothing    -> ac+            _     -> ac++options :: [OptDescr (Config -> Config)]+options = [ Option ['m'] ["major"]         (ReqArg (addBumps 1) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a major bump (bump at position 1)."+          , Option ['n'] ["minor"]         (ReqArg (addBumps 2) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a minor bump (bump at position 2)."+          , Option ['0'] ["bump-0"]        (ReqArg (addBumps 0) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 0."+          , Option ['1'] ["bump-1"]        (ReqArg (addBumps 1) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 1."+          , Option ['2'] ["bump-2"]        (ReqArg (addBumps 2) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 2."+          , Option ['3'] ["bump-3"]        (ReqArg (addBumps 3) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 3."+          , Option []    ["set-versions"]  (ReqArg (\v -> modify setVersion (++ versionPar v)) "PACKAGE@VERSION(,PACKAGE@VERSION)*") "Comma-separated list of packages and their versions."+          , Option ['t'] ["no-transitive"] (NoArg  (set transitive False))   "Do not apply bumping transitively."+          , Option ['i'] ["ignore"]        (ReqArg (\v -> modify ignore (++ map PackageName (splitOn "," v))) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will be ignored when transitive bumping."+          , Option ['g'] ["global"]        (ReqArg (\v -> set global (Just v)) "PATH")     "Bump according to latest version number in the given package database."+          , Option ['d'] ["dry-run"]       (NoArg  (set action ShowDeps))                  "Just output the dependencies that will be updated."+          , Option ['?'] ["help"]          (NoArg  (set action ShowHelp))                  "Show usage help and exit."+          , Option ['v'] ["version"]       (NoArg  (set action ShowVersion))               "Show version info and exit."+          ]+      where addBumps :: Int -> String -> Config -> Config+            addBumps p pks = modify bump (M.insertWith (++) p (map PackageName $ splitOn "," pks))++getConfig :: IO Config+getConfig =+  do args <- getArgs+     (opts, _) <- processArgs defaultConfig options header args+     return opts++processArgs :: a -> [OptDescr (a -> a)] -> String -> [String] -> IO (a, [String])+processArgs def opts hdr args =+    case getOpt Permute opts args of+        (oargs, nonopts, []    ) -> return (foldl (flip ($)) def oargs, nonopts)+        (_    , _      , errors) -> ioError $ userError $ (concat errors) ++ usageInfo hdr opts++header :: String+header = "Usage: bumper [OPTIONS...], with the following options:"++printUsage :: [OptDescr a] -> IO ()+printUsage opts = putStrLn $ usageInfo header opts
+ src/Package.hs view
@@ -0,0 +1,108 @@+-- * Contains helper functions to load and manipulate .cabal files+{-# LANGUAGE+    TypeOperators+  , TemplateHaskell+  , TupleSections+  #-}+module Package where++import Prelude hiding (readFile)++import Control.Applicative+import Control.Monad+import Data.Label+import Data.List+import Data.List.Split+import Data.Maybe+import Data.Version+import Distribution.Package hiding (Package)+import Distribution.PackageDescription+import Distribution.PackageDescription.Configuration+import Distribution.PackageDescription.Parse+import Distribution.Text+import Distribution.Verbosity+import System.IO.Strict+import System.Process+import Text.Regex+import Version+import qualified Data.Map as M++data Package = Package+    { _name         :: PackageName+    , _path         :: String+    , _version      :: Version+    , _dependencies :: [Dependency]+    } deriving (Show, Eq)++$(mkLabels [''Package])++type Packages = [Package]++-- | Helper functions++lookupPackage :: PackageName -> Packages -> Maybe Package+lookupPackage s = find ((== s) . _name)++lookupPackages ::  [PackageName] -> Packages -> Packages+lookupPackages ns ps = catMaybes . map (flip lookupPackage ps) $ ns++hasPackage :: PackageName -> Packages -> Bool+hasPackage n = isJust . lookupPackage n++removePackage :: PackageName -> Packages -> Packages+removePackage s = filter ((/= s). _name)++removeAll :: [PackageName] -> Packages -> Packages+removeAll = flip $ foldr removePackage++-- | Loading packages+packages :: IO Packages+packages =+  do (_, hOut, _, _) <- runInteractiveCommand "find . -name *.cabal -type f"+     paths <- lines <$> hGetContents hOut+     forM paths $ \p ->+        do pkg <- flattenPackageDescription `liftM` readPackageDescription normal p+           return $ Package+                      { _name = pkgName $ package pkg+                      , _path = p+                      , _version = pkgVersion $ package pkg+                      , _dependencies = buildDepends pkg+                      }++getBaseVersions :: String -> Packages -> IO Packages+getBaseVersions ind ps =+ do (_, hOut, _, _) <- runInteractiveCommand $ "tar -tf " ++ ind+    gps <- lines <$> hGetContents hOut+    let vs = catMaybes $ map (parseVer . splitOn "/") gps+        parseVer (n:v:_) = fmap (PackageName n, ) $ simpleParse v+        parseVer _       = Nothing+        globver = M.fromListWith (\a b -> if a > b then a else b) vs+        updVer p = modify version (maybe id (\v -> if get version p < v then const v else id) $ M.lookup (_name p) globver) p+    return $ map updVer ps++-- | Manipulating package contents+whiteReg :: String+whiteReg = "[ \n\t]*"++modifyVersion :: Version -> String -> String+modifyVersion v s = subRegex (mkRegexWithOpts regex False False) s result+  where regex = "(version" ++ whiteReg ++ ":" ++ whiteReg ++ ") ([0-9.a-zA-Z]+)"+        result = "\\1 " ++ display v++modifyDependency :: Dependency -> String -> String+modifyDependency (Dependency nm range) s = subRegex (mkRegexWithOpts regex False False) s result+  where regex = "(build-depends" ++ whiteReg ++ ":" ++ "[^:]*"+              ++ "[ ,\n\t]" ++ display nm ++ whiteReg ++ ")[, ]([" ++ rangeChar ++ " \t\n]*[" ++ rangeChar ++ "])"+        rangeChar = "0-9.*&|()<>="+        result = "\\1 " ++ printRange range++-- | Data structure containing package modifications+type PackageChanges = (Maybe Version, [Dependency])++-- | Writing to packages+modifyPackage :: PackageChanges -> String -> String+modifyPackage (mv, deps) = flip (foldr modifyDependency) deps+                         . maybe id modifyVersion mv++updatePackage :: Package -> PackageChanges -> IO ()+updatePackage p ch = readFile (get path p) >>= writeFile (get path p) . modifyPackage ch
+ src/Version.hs view
@@ -0,0 +1,70 @@+-- * Manipulation functions for cabal versions and version ranges+{-# LANGUAGE+    TypeOperators+  , TemplateHaskell+  #-}+module Version where++import Data.Label+import Distribution.Text+import Distribution.Version++$(mkLabels [''Version])+$(mkLabels [''VersionRange])++-- | Function to bump the nth position in a version to a higher number+-- trailing version number will be discarded+bumpPosition :: Int -> Version -> Version+bumpPosition p = modify lVersionBranch (addPos p)+  where+    addPos 0 []      = [1]+    addPos 0 (v: _)  = [v+1]+    addPos x []      = 0 : addPos (x - 1) []+    addPos x (v: vs) = v : addPos (x - 1) vs++previousVersion :: Version -> Version+previousVersion = modify lVersionBranch mkPrevious+  where mkPrevious = reverse . prevHelp . reverse+        prevHelp []     = []+        prevHelp (x:xs) = if x <= 1 then xs else (x - 1): xs -- No trailing zeros++nextVersion :: Version -> Version+nextVersion = modify lVersionBranch mkNext+  where mkNext = reverse . nextHelp . reverse+        nextHelp []     = []+        nextHelp (x:xs) = (x + 1) : xs++addVersionToRange :: Version -> VersionRange -> VersionRange+addVersionToRange new r =+  if withinRange new r+  then r+  else+    let cVersion = const (thisVersion new)+        c2Version = const $ const (thisVersion new)+    in foldVersionRange'+        anyVersion      -- any+        cVersion        -- (==)+        cVersion        -- >+        cVersion        -- <+        cVersion        -- >=+        cVersion        -- <=+        (\v _ -> withinVersion $ v { versionBranch = take (length $ versionBranch v) $ versionBranch new })  -- .*+        c2Version       -- (||)+        c2Version       -- (&&)+        id              -- (_)+        r++printRange :: VersionRange -> String+printRange =+  let sShow s = ((s ++ " ") ++) . display+  in foldVersionRange'+      "*"+      (sShow "==")+      (sShow ">")+      (sShow "<")+      (sShow ">=")+      (sShow "<=")+      (\v _   -> "== " ++ display v ++ ".*")+      (\v1 v2 -> v1 ++ " || " ++ v2)+      (\v1 v2 -> v1 ++ " && " ++ v2)+      (\v -> "(" ++ v ++ ")")