bumper-0.6: src/Bumper.hs

module Main where

import Config
import Control.Monad
import Data.Label
import Data.List
import Data.Maybe
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

     --Check for non-existent packages
     let changePks = map fst (get setVersion conf) ++ concat (M.elems (get bump conf))
         notFound = filter (not . isJust . flip lookupPackage ps) changePks
     when (not $ null notFound) $ putStrLn $ "[Warning] packages not found: " ++ (intercalate "," $ map display notFound)

     -- 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 3 (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