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