{-# Language CPP #-} module CabalBounds.Update ( update ) where import qualified Distribution.PackageDescription as D import qualified Distribution.Package as P import qualified Distribution.Version as V import qualified Distribution.Types.VersionInterval as VI import Control.Lens import CabalBounds.Bound (UpdateBound(..)) import CabalBounds.Dependencies (Dependencies(..), filterDependency, dependencyIf) import CabalBounds.VersionComp (VersionComp(..)) import CabalBounds.Types import qualified CabalLenses as CL import Data.List (foldl') import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) #endif update :: UpdateBound -> [CL.Section] -> Dependencies -> LibraryMap -> D.GenericPackageDescription -> D.GenericPackageDescription update :: UpdateBound -> [Section] -> Dependencies -> LibraryMap -> GenericPackageDescription -> GenericPackageDescription update UpdateBound bound [Section] sections Dependencies deps LibraryMap libs GenericPackageDescription pkgDescrp = (GenericPackageDescription -> Section -> GenericPackageDescription) -> GenericPackageDescription -> [Section] -> GenericPackageDescription forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' GenericPackageDescription -> Section -> GenericPackageDescription updateSection GenericPackageDescription pkgDescrp [Section] sections where updateSection :: GenericPackageDescription -> Section -> GenericPackageDescription updateSection GenericPackageDescription pkgDescrp Section section = GenericPackageDescription pkgDescrp GenericPackageDescription -> (GenericPackageDescription -> GenericPackageDescription) -> GenericPackageDescription forall a b. a -> (a -> b) -> b & CondVars -> Section -> Traversal' GenericPackageDescription Dependency dependencyIf CondVars condVars Section section ((Dependency -> Identity Dependency) -> GenericPackageDescription -> Identity GenericPackageDescription) -> ((Dependency -> Identity Dependency) -> Dependency -> Identity Dependency) -> (Dependency -> Identity Dependency) -> GenericPackageDescription -> Identity GenericPackageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c . (Dependency -> Identity Dependency) -> Dependency -> Identity Dependency filterDep ((Dependency -> Identity Dependency) -> GenericPackageDescription -> Identity GenericPackageDescription) -> (Dependency -> Dependency) -> GenericPackageDescription -> GenericPackageDescription forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ Dependency -> Dependency updateDep filterDep :: (Dependency -> Identity Dependency) -> Dependency -> Identity Dependency filterDep = Dependencies -> Traversal' Dependency Dependency filterDependency Dependencies deps updateDep :: Dependency -> Dependency updateDep = UpdateBound -> LibraryMap -> Dependency -> Dependency updateDependency UpdateBound bound LibraryMap libs condVars :: CondVars condVars = GenericPackageDescription -> CondVars CL.fromDefaults GenericPackageDescription pkgDescrp updateDependency :: UpdateBound -> LibraryMap -> P.Dependency -> P.Dependency updateDependency :: UpdateBound -> LibraryMap -> Dependency -> Dependency updateDependency (UpdateLower LowerComp comp IfMissing ifMissing) LibraryMap libs Dependency dep = Dependency -> Maybe Dependency -> Dependency forall a. a -> Maybe a -> a fromMaybe Dependency dep (Maybe Dependency -> Dependency) -> Maybe Dependency -> Dependency forall a b. (a -> b) -> a -> b $ if IfMissing ifMissing IfMissing -> IfMissing -> IfMissing && LowerBound lowerBound_ LowerBound -> LowerBound -> IfMissing forall a. Eq a => a -> a -> IfMissing /= LowerBound CL.noLowerBound then Maybe Dependency forall a. Maybe a Nothing else do Version lowerVersion <- String -> LibraryMap -> Maybe Version forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup String pkgName_ LibraryMap libs let newLowerVersion :: Version newLowerVersion = LowerComp comp LowerComp -> Version -> Version `compOf` Version lowerVersion newLowerBound :: LowerBound newLowerBound = Version -> Bound -> LowerBound V.LowerBound Version newLowerVersion Bound V.InclusiveBound newIntervals :: [VersionInterval] newIntervals = (VersionRange versionRange_ VersionRange -> Getting [VersionInterval] VersionRange [VersionInterval] -> [VersionInterval] forall s a. s -> Getting a s a -> a ^. Getting [VersionInterval] VersionRange [VersionInterval] Iso' VersionRange [VersionInterval] CL.intervals) [VersionInterval] -> ([VersionInterval] -> [VersionInterval]) -> [VersionInterval] forall a b. a -> (a -> b) -> b & (VersionInterval -> Identity VersionInterval) -> [VersionInterval] -> Identity [VersionInterval] forall s a. Cons s s a a => Traversal' s a Traversal' [VersionInterval] VersionInterval _head ((VersionInterval -> Identity VersionInterval) -> [VersionInterval] -> Identity [VersionInterval]) -> ((LowerBound -> Identity LowerBound) -> VersionInterval -> Identity VersionInterval) -> (LowerBound -> Identity LowerBound) -> [VersionInterval] -> Identity [VersionInterval] forall b c a. (b -> c) -> (a -> b) -> a -> c . (LowerBound -> Identity LowerBound) -> VersionInterval -> Identity VersionInterval Lens' VersionInterval LowerBound CL.lowerBound ((LowerBound -> Identity LowerBound) -> [VersionInterval] -> Identity [VersionInterval]) -> (LowerBound -> LowerBound) -> [VersionInterval] -> [VersionInterval] forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ LowerBound -> LowerBound -> LowerBound updateIfLower LowerBound newLowerBound vrange :: VersionRange vrange = [VersionInterval] -> VersionRange mkVersionRange [VersionInterval] newIntervals Dependency -> Maybe Dependency forall a. a -> Maybe a forall (m :: * -> *) a. Monad m => a -> m a return (Dependency -> Maybe Dependency) -> Dependency -> Maybe Dependency forall a b. (a -> b) -> a -> b $ Dependency dep Dependency -> (Dependency -> Dependency) -> Dependency forall a b. a -> (a -> b) -> b & (VersionRange -> Identity VersionRange) -> Dependency -> Identity Dependency Lens' Dependency VersionRange CL.versionRange ((VersionRange -> Identity VersionRange) -> Dependency -> Identity Dependency) -> VersionRange -> Dependency -> Dependency forall s t a b. ASetter s t a b -> b -> s -> t .~ VersionRange vrange where pkgName_ :: Unwrapped PackageName pkgName_ = Dependency dep Dependency -> Getting (Unwrapped PackageName) Dependency (Unwrapped PackageName) -> Unwrapped PackageName forall s a. s -> Getting a s a -> a ^. (PackageName -> Const (Unwrapped PackageName) PackageName) -> Dependency -> Const (Unwrapped PackageName) Dependency Lens' Dependency PackageName CL.packageName ((PackageName -> Const (Unwrapped PackageName) PackageName) -> Dependency -> Const (Unwrapped PackageName) Dependency) -> ((Unwrapped PackageName -> Const (Unwrapped PackageName) (Unwrapped PackageName)) -> PackageName -> Const (Unwrapped PackageName) PackageName) -> Getting (Unwrapped PackageName) Dependency (Unwrapped PackageName) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Unwrapped PackageName -> Const (Unwrapped PackageName) (Unwrapped PackageName)) -> PackageName -> Const (Unwrapped PackageName) PackageName forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t) Iso PackageName PackageName (Unwrapped PackageName) (Unwrapped PackageName) _Wrapped versionRange_ :: VersionRange versionRange_ = Dependency dep Dependency -> Getting VersionRange Dependency VersionRange -> VersionRange forall s a. s -> Getting a s a -> a ^. Getting VersionRange Dependency VersionRange Lens' Dependency VersionRange CL.versionRange lowerBound_ :: LowerBound lowerBound_ = LowerBound -> Maybe LowerBound -> LowerBound forall a. a -> Maybe a -> a fromMaybe LowerBound CL.noLowerBound (Maybe LowerBound -> LowerBound) -> Maybe LowerBound -> LowerBound forall a b. (a -> b) -> a -> b $ VersionRange versionRange_ VersionRange -> Getting (First LowerBound) VersionRange LowerBound -> Maybe LowerBound forall s a. s -> Getting (First a) s a -> Maybe a ^? ([VersionInterval] -> Const (First LowerBound) [VersionInterval]) -> VersionRange -> Const (First LowerBound) VersionRange Iso' VersionRange [VersionInterval] CL.intervals (([VersionInterval] -> Const (First LowerBound) [VersionInterval]) -> VersionRange -> Const (First LowerBound) VersionRange) -> ((LowerBound -> Const (First LowerBound) LowerBound) -> [VersionInterval] -> Const (First LowerBound) [VersionInterval]) -> Getting (First LowerBound) VersionRange LowerBound forall b c a. (b -> c) -> (a -> b) -> a -> c . (VersionInterval -> Const (First LowerBound) VersionInterval) -> [VersionInterval] -> Const (First LowerBound) [VersionInterval] forall s a. Cons s s a a => Traversal' s a Traversal' [VersionInterval] VersionInterval _head ((VersionInterval -> Const (First LowerBound) VersionInterval) -> [VersionInterval] -> Const (First LowerBound) [VersionInterval]) -> ((LowerBound -> Const (First LowerBound) LowerBound) -> VersionInterval -> Const (First LowerBound) VersionInterval) -> (LowerBound -> Const (First LowerBound) LowerBound) -> [VersionInterval] -> Const (First LowerBound) [VersionInterval] forall b c a. (b -> c) -> (a -> b) -> a -> c . (LowerBound -> Const (First LowerBound) LowerBound) -> VersionInterval -> Const (First LowerBound) VersionInterval Lens' VersionInterval LowerBound CL.lowerBound updateIfLower :: LowerBound -> LowerBound -> LowerBound updateIfLower LowerBound newBound LowerBound oldBound | LowerBound oldBound LowerBound -> LowerBound -> IfMissing forall a. Eq a => a -> a -> IfMissing /= LowerBound CL.noLowerBound = if (LowerBound -> Version version LowerBound newBound) Version -> Version -> IfMissing forall a. Ord a => a -> a -> IfMissing < (LowerBound -> Version version LowerBound oldBound) then LowerBound newBound else LowerBound oldBound | IfMissing otherwise = LowerBound newBound where version :: LowerBound -> Version version (V.LowerBound Version vers Bound _) = Version vers updateDependency (UpdateUpper LowerComp comp IfMissing ifMissing) LibraryMap libs Dependency dep = Dependency -> Maybe Dependency -> Dependency forall a. a -> Maybe a -> a fromMaybe Dependency dep (Maybe Dependency -> Dependency) -> Maybe Dependency -> Dependency forall a b. (a -> b) -> a -> b $ if IfMissing ifMissing IfMissing -> IfMissing -> IfMissing && UpperBound upperBound_ UpperBound -> UpperBound -> IfMissing forall a. Eq a => a -> a -> IfMissing /= UpperBound V.NoUpperBound then Maybe Dependency forall a. Maybe a Nothing else do Version upperVersion <- String -> LibraryMap -> Maybe Version forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup String pkgName_ LibraryMap libs let newUpperVersion :: Version newUpperVersion = LowerComp -> Version -> Version nextVersion LowerComp comp Version upperVersion newUpperBound :: UpperBound newUpperBound = Version -> Bound -> UpperBound V.UpperBound Version newUpperVersion Bound V.ExclusiveBound newIntervals :: [VersionInterval] newIntervals = (VersionRange versionRange_ VersionRange -> Getting [VersionInterval] VersionRange [VersionInterval] -> [VersionInterval] forall s a. s -> Getting a s a -> a ^. Getting [VersionInterval] VersionRange [VersionInterval] Iso' VersionRange [VersionInterval] CL.intervals) [VersionInterval] -> ([VersionInterval] -> [VersionInterval]) -> [VersionInterval] forall a b. a -> (a -> b) -> b & (VersionInterval -> Identity VersionInterval) -> [VersionInterval] -> Identity [VersionInterval] forall s a. Snoc s s a a => Traversal' s a Traversal' [VersionInterval] VersionInterval _last ((VersionInterval -> Identity VersionInterval) -> [VersionInterval] -> Identity [VersionInterval]) -> ((UpperBound -> Identity UpperBound) -> VersionInterval -> Identity VersionInterval) -> (UpperBound -> Identity UpperBound) -> [VersionInterval] -> Identity [VersionInterval] forall b c a. (b -> c) -> (a -> b) -> a -> c . (UpperBound -> Identity UpperBound) -> VersionInterval -> Identity VersionInterval Lens' VersionInterval UpperBound CL.upperBound ((UpperBound -> Identity UpperBound) -> [VersionInterval] -> Identity [VersionInterval]) -> (UpperBound -> UpperBound) -> [VersionInterval] -> [VersionInterval] forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ UpperBound -> UpperBound -> UpperBound updateIfGreater UpperBound newUpperBound vrange :: VersionRange vrange = [VersionInterval] -> VersionRange mkVersionRange [VersionInterval] newIntervals Dependency -> Maybe Dependency forall a. a -> Maybe a forall (m :: * -> *) a. Monad m => a -> m a return (Dependency -> Maybe Dependency) -> Dependency -> Maybe Dependency forall a b. (a -> b) -> a -> b $ Dependency dep Dependency -> (Dependency -> Dependency) -> Dependency forall a b. a -> (a -> b) -> b & (VersionRange -> Identity VersionRange) -> Dependency -> Identity Dependency Lens' Dependency VersionRange CL.versionRange ((VersionRange -> Identity VersionRange) -> Dependency -> Identity Dependency) -> VersionRange -> Dependency -> Dependency forall s t a b. ASetter s t a b -> b -> s -> t .~ VersionRange vrange where versionRange_ :: VersionRange versionRange_ = Dependency dep Dependency -> Getting VersionRange Dependency VersionRange -> VersionRange forall s a. s -> Getting a s a -> a ^. Getting VersionRange Dependency VersionRange Lens' Dependency VersionRange CL.versionRange pkgName_ :: Unwrapped PackageName pkgName_ = Dependency dep Dependency -> Getting (Unwrapped PackageName) Dependency (Unwrapped PackageName) -> Unwrapped PackageName forall s a. s -> Getting a s a -> a ^. (PackageName -> Const (Unwrapped PackageName) PackageName) -> Dependency -> Const (Unwrapped PackageName) Dependency Lens' Dependency PackageName CL.packageName ((PackageName -> Const (Unwrapped PackageName) PackageName) -> Dependency -> Const (Unwrapped PackageName) Dependency) -> ((Unwrapped PackageName -> Const (Unwrapped PackageName) (Unwrapped PackageName)) -> PackageName -> Const (Unwrapped PackageName) PackageName) -> Getting (Unwrapped PackageName) Dependency (Unwrapped PackageName) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Unwrapped PackageName -> Const (Unwrapped PackageName) (Unwrapped PackageName)) -> PackageName -> Const (Unwrapped PackageName) PackageName forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t) Iso PackageName PackageName (Unwrapped PackageName) (Unwrapped PackageName) _Wrapped upperBound_ :: UpperBound upperBound_ = UpperBound -> Maybe UpperBound -> UpperBound forall a. a -> Maybe a -> a fromMaybe UpperBound V.NoUpperBound (Maybe UpperBound -> UpperBound) -> Maybe UpperBound -> UpperBound forall a b. (a -> b) -> a -> b $ VersionRange versionRange_ VersionRange -> Getting (First UpperBound) VersionRange UpperBound -> Maybe UpperBound forall s a. s -> Getting (First a) s a -> Maybe a ^? ([VersionInterval] -> Const (First UpperBound) [VersionInterval]) -> VersionRange -> Const (First UpperBound) VersionRange Iso' VersionRange [VersionInterval] CL.intervals (([VersionInterval] -> Const (First UpperBound) [VersionInterval]) -> VersionRange -> Const (First UpperBound) VersionRange) -> ((UpperBound -> Const (First UpperBound) UpperBound) -> [VersionInterval] -> Const (First UpperBound) [VersionInterval]) -> Getting (First UpperBound) VersionRange UpperBound forall b c a. (b -> c) -> (a -> b) -> a -> c . (VersionInterval -> Const (First UpperBound) VersionInterval) -> [VersionInterval] -> Const (First UpperBound) [VersionInterval] forall s a. Snoc s s a a => Traversal' s a Traversal' [VersionInterval] VersionInterval _last ((VersionInterval -> Const (First UpperBound) VersionInterval) -> [VersionInterval] -> Const (First UpperBound) [VersionInterval]) -> ((UpperBound -> Const (First UpperBound) UpperBound) -> VersionInterval -> Const (First UpperBound) VersionInterval) -> (UpperBound -> Const (First UpperBound) UpperBound) -> [VersionInterval] -> Const (First UpperBound) [VersionInterval] forall b c a. (b -> c) -> (a -> b) -> a -> c . (UpperBound -> Const (First UpperBound) UpperBound) -> VersionInterval -> Const (First UpperBound) VersionInterval Lens' VersionInterval UpperBound CL.upperBound updateIfGreater :: UpperBound -> UpperBound -> UpperBound updateIfGreater UpperBound newBound UpperBound oldBound | V.UpperBound Version newVers Bound _ <- UpperBound newBound , V.UpperBound Version oldVers Bound _ <- UpperBound oldBound = if Version newVers Version -> Version -> IfMissing forall a. Ord a => a -> a -> IfMissing > Version oldVers then UpperBound newBound else UpperBound oldBound | IfMissing otherwise = UpperBound newBound updateDependency (UpdateBoth LowerComp lowerComp LowerComp upperComp IfMissing ifMissing) LibraryMap libs Dependency dep = UpdateBound -> LibraryMap -> Dependency -> Dependency updateDependency (LowerComp -> IfMissing -> UpdateBound UpdateLower LowerComp lowerComp IfMissing ifMissing) LibraryMap libs (Dependency -> Dependency) -> Dependency -> Dependency forall a b. (a -> b) -> a -> b $ UpdateBound -> LibraryMap -> Dependency -> Dependency updateDependency (LowerComp -> IfMissing -> UpdateBound UpdateUpper LowerComp upperComp IfMissing ifMissing) LibraryMap libs Dependency dep compOf :: VersionComp -> V.Version -> V.Version LowerComp Major1 compOf :: LowerComp -> Version -> Version `compOf` Version version = Version version Version -> (Version -> Version) -> Version forall a b. a -> (a -> b) -> b & ([Int] -> Identity [Int]) -> Version -> Identity Version Iso' Version [Int] CL.versionBranchL (([Int] -> Identity [Int]) -> Version -> Identity Version) -> ([Int] -> [Int]) -> Version -> Version forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ Int -> [Int] -> [Int] forall a. Int -> [a] -> [a] take Int 1 LowerComp Major2 `compOf` Version version = Version version Version -> (Version -> Version) -> Version forall a b. a -> (a -> b) -> b & ([Int] -> Identity [Int]) -> Version -> Identity Version Iso' Version [Int] CL.versionBranchL (([Int] -> Identity [Int]) -> Version -> Identity Version) -> ([Int] -> [Int]) -> Version -> Version forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ Int -> [Int] -> [Int] forall a. Int -> [a] -> [a] take Int 2 LowerComp Minor `compOf` Version version = Version version nextVersion :: VersionComp -> V.Version -> V.Version nextVersion :: LowerComp -> Version -> Version nextVersion LowerComp comp Version version = (LowerComp comp LowerComp -> Version -> Version `compOf` Version version) Version -> (Version -> Version) -> Version forall a b. a -> (a -> b) -> b & ([Int] -> Identity [Int]) -> Version -> Identity Version Iso' Version [Int] CL.versionBranchL (([Int] -> Identity [Int]) -> Version -> Identity Version) -> ([Int] -> [Int]) -> Version -> Version forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ LowerComp -> [Int] -> [Int] ensureMinimalVersionBranch LowerComp comp Version -> (Version -> Version) -> Version forall a b. a -> (a -> b) -> b & ([Int] -> Identity [Int]) -> Version -> Identity Version Iso' Version [Int] CL.versionBranchL (([Int] -> Identity [Int]) -> Version -> Identity Version) -> ((Int -> Identity Int) -> [Int] -> Identity [Int]) -> (Int -> Identity Int) -> Version -> Identity Version forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int -> Identity Int) -> [Int] -> Identity [Int] forall s a. Snoc s s a a => Traversal' s a Traversal' [Int] Int _last ((Int -> Identity Int) -> Version -> Identity Version) -> (Int -> Int) -> Version -> Version forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ (Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) ensureMinimalVersionBranch :: VersionComp -> [Int] -> [Int] ensureMinimalVersionBranch :: LowerComp -> [Int] -> [Int] ensureMinimalVersionBranch LowerComp comp [Int] branch = let numDigits :: Int numDigits = LowerComp -> Int forall {a}. Num a => LowerComp -> a numNeededVersionDigits LowerComp comp numMissing :: Int numMissing = Int numDigits Int -> Int -> Int forall a. Num a => a -> a -> a - [Int] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int] branch branch' :: [Int] branch' | Int numMissing Int -> Int -> IfMissing forall a. Ord a => a -> a -> IfMissing > Int 0 = [Int] branch [Int] -> [Int] -> [Int] forall a. [a] -> [a] -> [a] ++ Int -> Int -> [Int] forall a. Int -> a -> [a] replicate Int numMissing Int 0 | IfMissing otherwise = [Int] branch in [Int] branch' where numNeededVersionDigits :: LowerComp -> a numNeededVersionDigits LowerComp Major1 = a 1 numNeededVersionDigits LowerComp Major2 = a 2 numNeededVersionDigits LowerComp Minor = a 3 mkVersionRange :: [V.VersionInterval] -> V.VersionRange mkVersionRange :: [VersionInterval] -> VersionRange mkVersionRange [] = VersionRange V.anyVersion mkVersionRange [VersionInterval] vis = VersionRange -> Maybe VersionRange -> VersionRange forall a. a -> Maybe a -> a fromMaybe VersionRange V.noVersion (VersionIntervals -> VersionRange V.fromVersionIntervals (VersionIntervals -> VersionRange) -> Maybe VersionIntervals -> Maybe VersionRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [VersionInterval] -> Maybe VersionIntervals VI.mkVersionIntervals [VersionInterval] vis)