module CabalBounds.Update ( update , Libraries ) where import qualified Distribution.PackageDescription as D import qualified Distribution.Package as P import qualified Distribution.Version as V import Control.Lens import CabalBounds.Bound (UpdateBound(..)) import CabalBounds.Dependencies (Dependencies(..), filterDependency) import CabalBounds.VersionComp (VersionComp(..)) import qualified CabalLenses as CL import Data.List (foldl') import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) type PkgName = String type LibName = String type LibVersion = V.Version type Libraries = HM.HashMap LibName LibVersion update :: UpdateBound -> [CL.Section] -> Dependencies -> Libraries -> D.GenericPackageDescription -> D.GenericPackageDescription update bound sections deps libs pkgDescrp = foldl' updateSection pkgDescrp sections where updateSection pkgDescrp section = pkgDescrp & CL.dependencyIf condVars section . filterDep %~ updateDep filterDep = filterDependency deps updateDep = updateDependency bound libs condVars = CL.fromDefaults pkgDescrp updateDependency :: UpdateBound -> Libraries -> P.Dependency -> P.Dependency updateDependency (UpdateLower comp ifMissing) libs dep = fromMaybe dep $ if ifMissing && lowerBound_ /= CL.noLowerBound then return dep else do version <- HM.lookup pkgName_ libs let newLowerVersion = comp `compOf` version newLowerBound = V.LowerBound newLowerVersion V.InclusiveBound vrange = fromMaybe (V.orLaterVersion newLowerVersion) (modifyVersionIntervals (updateLower newLowerBound) versionRange_) return $ mkDependency pkgName_ vrange where updateLower newLowerBound [] = [(newLowerBound, V.NoUpperBound)] updateLower newLowerBound intervals = intervals & _head . CL.lowerBound .~ newLowerBound pkgName_ = pkgName dep versionRange_ = versionRange dep lowerBound_ = fromMaybe CL.noLowerBound $ V.asVersionIntervals versionRange_ ^? _head . CL.lowerBound updateDependency (UpdateUpper comp ifMissing) libs dep = fromMaybe dep $ if ifMissing && upperBound_ /= V.NoUpperBound then return dep else do upperVersion <- HM.lookup pkgName_ libs let newUpperVersion = comp `compOf` upperVersion newUpperBound = V.UpperBound (nextVersion newUpperVersion) V.ExclusiveBound vrange <- modifyVersionIntervals (updateUpper newUpperBound) versionRange_ return $ mkDependency pkgName_ vrange where versionRange_ = versionRange dep pkgName_ = pkgName dep upperBound_ = fromMaybe V.NoUpperBound $ V.asVersionIntervals versionRange_ ^? _head . CL.upperBound updateUpper newUpperBound [] = [(CL.noLowerBound, newUpperBound)] updateUpper newUpperBound intervals = intervals & _last . CL.upperBound .~ newUpperBound updateDependency (UpdateBoth lowerComp upperComp ifMissing) libs dep = updateDependency (UpdateLower lowerComp ifMissing) libs $ updateDependency (UpdateUpper upperComp ifMissing) libs dep modifyVersionIntervals :: ([V.VersionInterval] -> [V.VersionInterval]) -> V.VersionRange -> Maybe V.VersionRange modifyVersionIntervals f = fmap V.fromVersionIntervals . V.mkVersionIntervals . f . V.asVersionIntervals compOf :: VersionComp -> V.Version -> V.Version Major1 `compOf` version = version & CL.versionBranchL %~ (take 1 . ensureMinimalVersionBranch Major1) & CL.versionTagsL .~ [] Major2 `compOf` version = version & CL.versionBranchL %~ (take 2 . ensureMinimalVersionBranch Major2) & CL.versionTagsL .~ [] Minor `compOf` version = version & CL.versionBranchL %~ ensureMinimalVersionBranch Minor & CL.versionTagsL .~ [] ensureMinimalVersionBranch :: VersionComp -> [Int] -> [Int] ensureMinimalVersionBranch comp branch = let numDigits = numNeededVersionDigits comp numMissing = numDigits - length branch branch' | numMissing >= 0 = branch ++ replicate numMissing 0 | otherwise = branch in branch' where numNeededVersionDigits Major1 = 1 numNeededVersionDigits Major2 = 2 numNeededVersionDigits Minor = 3 nextVersion :: V.Version -> V.Version nextVersion version = version & CL.versionBranchL %~ increaseLastComp where increaseLastComp = reverse . (& ix 0 %~ (+ 1)) . reverse pkgName :: P.Dependency -> PkgName pkgName (P.Dependency (P.PackageName name) _) = name versionRange :: P.Dependency -> V.VersionRange versionRange (P.Dependency _ vrange) = vrange mkDependency :: PkgName -> V.VersionRange -> P.Dependency mkDependency name = P.Dependency (P.PackageName name)