{-# LANGUAGE CPP #-}
module Distribution.Client.GenBounds (
genBounds
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.Utils
( hasElem, incVersion )
import Distribution.Client.Freeze
( getFreezePkgs )
import Distribution.Client.Setup
( GlobalFlags(..), FreezeFlags(..), RepoContext )
import Distribution.Package
( Package(..), unPackageName, packageName, packageVersion )
import Distribution.PackageDescription
( enabledBuildDepends )
import Distribution.PackageDescription.Configuration
( finalizePD )
import Distribution.Types.ComponentRequestedSpec
( defaultComponentRequestedSpec )
import Distribution.Types.Dependency
import Distribution.Simple.Compiler
( Compiler, PackageDBStack, compilerInfo )
import Distribution.Simple.PackageDescription
( readGenericPackageDescription )
import Distribution.Simple.Program
( ProgramDb )
import Distribution.Simple.Utils
( notice, tryFindPackageDesc )
import Distribution.System
( Platform )
import Distribution.Version
( Version, alterVersion, VersionInterval (..)
, LowerBound(..), UpperBound(..), VersionRange, asVersionIntervals
, orLaterVersion, earlierVersion, intersectVersionRanges, hasUpperBound)
import System.Directory
( getCurrentDirectory )
pvpize :: Version -> VersionRange
pvpize :: Version -> VersionRange
pvpize Version
v = Version -> VersionRange
orLaterVersion (Int -> Version
vn Int
3)
VersionRange -> VersionRange -> VersionRange
`intersectVersionRanges`
Version -> VersionRange
earlierVersion (Int -> Version -> Version
incVersion Int
1 (Int -> Version
vn Int
2))
where
vn :: Int -> Version
vn Int
n = ([Int] -> [Int]) -> Version -> Version
alterVersion (forall a. Int -> [a] -> [a]
take Int
n) Version
v
showBounds :: Package pkg => Int -> pkg -> String
showBounds :: forall pkg. Package pkg => Int -> pkg -> String
showBounds Int
padTo pkg
p = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$
(Int -> String -> String
padAfter Int
padTo forall a b. (a -> b) -> a -> b
$ PackageName -> String
unPackageName forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> PackageName
packageName pkg
p) forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map VersionInterval -> String
showInterval (VersionRange -> [VersionInterval]
asVersionIntervals forall a b. (a -> b) -> a -> b
$ Version -> VersionRange
pvpize forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> Version
packageVersion pkg
p)
where
padAfter :: Int -> String -> String
padAfter :: Int -> String -> String
padAfter Int
n String
str = String
str forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Char
' '
showInterval :: VersionInterval -> String
showInterval :: VersionInterval -> String
showInterval (VersionInterval (LowerBound Version
_ Bound
_) UpperBound
NoUpperBound) =
forall a. HasCallStack => String -> a
error String
"Error: expected upper bound...this should never happen!"
showInterval (VersionInterval (LowerBound Version
l Bound
_) (UpperBound Version
u Bound
_)) =
[String] -> String
unwords [String
">=", forall a. Pretty a => a -> String
prettyShow Version
l, String
"&& <", forall a. Pretty a => a -> String
prettyShow Version
u]
genBounds
:: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FreezeFlags
-> IO ()
genBounds :: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FreezeFlags
-> IO ()
genBounds Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Compiler
comp Platform
platform ProgramDb
progdb GlobalFlags
globalFlags FreezeFlags
freezeFlags = do
let cinfo :: CompilerInfo
cinfo = Compiler -> CompilerInfo
compilerInfo Compiler
comp
String
cwd <- IO String
getCurrentDirectory
String
path <- Verbosity -> String -> IO String
tryFindPackageDesc Verbosity
verbosity String
cwd
GenericPackageDescription
gpd <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity String
path
let epd :: Either [Dependency] (PackageDescription, FlagAssignment)
epd = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD forall a. Monoid a => a
mempty ComponentRequestedSpec
defaultComponentRequestedSpec
(forall a b. a -> b -> a
const Bool
True) Platform
platform CompilerInfo
cinfo [] GenericPackageDescription
gpd
case Either [Dependency] (PackageDescription, FlagAssignment)
epd of
Left [Dependency]
_ -> String -> IO ()
putStrLn String
"finalizePD failed"
Right (PackageDescription
pd,FlagAssignment
_) -> do
let needBounds :: [String]
needBounds = forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
depName forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Bool
hasUpperBound forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> VersionRange
depVersion) forall a b. (a -> b) -> a -> b
$
PackageDescription -> ComponentRequestedSpec -> [Dependency]
enabledBuildDepends PackageDescription
pd ComponentRequestedSpec
defaultComponentRequestedSpec
[SolverPlanPackage]
pkgs <- Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FreezeFlags
-> IO [SolverPlanPackage]
getFreezePkgs
Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Compiler
comp Platform
platform ProgramDb
progdb
GlobalFlags
globalFlags FreezeFlags
freezeFlags
let isNeeded :: SolverPlanPackage -> Bool
isNeeded = forall a. Ord a => [a] -> a -> Bool
hasElem [String]
needBounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName
let thePkgs :: [SolverPlanPackage]
thePkgs = forall a. (a -> Bool) -> [a] -> [a]
filter SolverPlanPackage -> Bool
isNeeded [SolverPlanPackage]
pkgs
let padTo :: Int
padTo = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName) [SolverPlanPackage]
pkgs
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SolverPlanPackage]
thePkgs then Verbosity -> String -> IO ()
notice Verbosity
verbosity
String
"Congratulations, all your dependencies have upper bounds!"
else do
Verbosity -> String -> IO ()
notice Verbosity
verbosity String
boundsNeededMsg
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> String -> IO ()
notice Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
",") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => Int -> pkg -> String
showBounds Int
padTo) [SolverPlanPackage]
thePkgs
depName :: Dependency -> String
depName :: Dependency -> String
depName (Dependency PackageName
pn VersionRange
_ NonEmptySet LibraryName
_) = PackageName -> String
unPackageName PackageName
pn
depVersion :: Dependency -> VersionRange
depVersion :: Dependency -> VersionRange
depVersion (Dependency PackageName
_ VersionRange
vr NonEmptySet LibraryName
_) = VersionRange
vr
boundsNeededMsg :: String
boundsNeededMsg :: String
boundsNeededMsg = [String] -> String
unlines
[ String
""
, String
"The following packages need bounds and here is a suggested starting point."
, String
"You can copy and paste this into the build-depends section in your .cabal"
, String
"file and it should work (with the appropriate removal of commas)."
, String
""
, String
"Note that version bounds are a statement that you've successfully built and"
, String
"tested your package and expect it to work with any of the specified package"
, String
"versions (PROVIDED that those packages continue to conform with the PVP)."
, String
"Therefore, the version bounds generated here are the most conservative"
, String
"based on the versions that you are currently building with. If you know"
, String
"your package will work with versions outside the ranges generated here,"
, String
"feel free to widen them."
, String
""
]