cabal-install/src/Distribution/Client/GenBounds.hs

   1 {-# LANGUAGE CPP #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Distribution.Client.GenBounds
   5 -- Copyright   :  (c) Doug Beardsley 2015
   6 -- License     :  BSD-like
   7 --
   8 -- Maintainer  :  cabal-devel@gmail.com
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- The cabal gen-bounds command for generating PVP-compliant version bounds.
  13 -----------------------------------------------------------------------------
  14 module Distribution.Client.GenBounds (
  15     genBounds
  16   ) where
  17
  18 import Prelude ()
  19 import Distribution.Client.Compat.Prelude
  20
  21 import Distribution.Client.Utils
  22          ( hasElem, incVersion )
  23 import Distribution.Client.Freeze
  24          ( getFreezePkgs )
  25 import Distribution.Client.Setup
  26          ( GlobalFlags(..), FreezeFlags(..), RepoContext )
  27 import Distribution.Package
  28          ( Package(..), unPackageName, packageName, packageVersion )
  29 import Distribution.PackageDescription
  30          ( enabledBuildDepends )
  31 import Distribution.PackageDescription.Configuration
  32          ( finalizePD )
  33 import Distribution.Types.ComponentRequestedSpec
  34          ( defaultComponentRequestedSpec )
  35 import Distribution.Types.Dependency
  36 import Distribution.Simple.Compiler
  37          ( Compiler, PackageDBStack, compilerInfo )
  38 import Distribution.Simple.PackageDescription
  39          ( readGenericPackageDescription )
  40 import Distribution.Simple.Program
  41          ( ProgramDb )
  42 import Distribution.Simple.Utils
  43          ( notice, tryFindPackageDesc )
  44 import Distribution.System
  45          ( Platform )
  46 import Distribution.Version
  47          ( Version, alterVersion, VersionInterval (..)
  48          , LowerBound(..), UpperBound(..), VersionRange, asVersionIntervals
  49          , orLaterVersion, earlierVersion, intersectVersionRanges, hasUpperBound)
  50 import System.Directory
  51          ( getCurrentDirectory )
  52
  53 -- | Given a version, return an API-compatible (according to PVP) version range.
  54 --
  55 -- Example: @0.4.1.2@ produces the version range @>= 0.4.1 && < 0.5@.
  56 --
  57 -- This version is slightly different than the one in
  58 -- 'Distribution.Client.Init'.  This one uses a.b.c as the lower bound because
  59 -- the user could be using a new function introduced in a.b.c which would make
  60 -- ">= a.b" incorrect.
  61 pvpize :: Version -> VersionRange
  62 pvpize v = orLaterVersion (vn 3)
  63            `intersectVersionRanges`
  64            earlierVersion (incVersion 1 (vn 2))
  65   where
  66     vn n = alterVersion (take n) v
  67
  68 -- | Show the PVP-mandated version range for this package. The @padTo@ parameter
  69 -- specifies the width of the package name column.
  70 showBounds :: Package pkg => Int -> pkg -> String
  71 showBounds padTo p = unwords $
  72     (padAfter padTo $ unPackageName $ packageName p) :
  73     -- TODO: use normaliseVersionRange
  74     map showInterval (asVersionIntervals $ pvpize $ packageVersion p)
  75   where
  76     padAfter :: Int -> String -> String
  77     padAfter n str = str ++ replicate (n - length str) ' '
  78
  79     showInterval :: VersionInterval -> String
  80     showInterval (VersionInterval (LowerBound _ _) NoUpperBound) =
  81       error "Error: expected upper bound...this should never happen!"
  82     showInterval (VersionInterval (LowerBound l _) (UpperBound u _)) =
  83       unwords [">=", prettyShow l, "&& <", prettyShow u]
  84
  85 -- | Entry point for the @gen-bounds@ command.
  86 genBounds
  87     :: Verbosity
  88     -> PackageDBStack
  89     -> RepoContext
  90     -> Compiler
  91     -> Platform
  92     -> ProgramDb
  93     -> GlobalFlags
  94     -> FreezeFlags
  95     -> IO ()
  96 genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do
  97     let cinfo = compilerInfo comp
  98
  99     cwd <- getCurrentDirectory
 100     path <- tryFindPackageDesc verbosity cwd
 101     gpd <- readGenericPackageDescription verbosity path
 102     -- NB: We don't enable tests or benchmarks, since often they
 103     -- don't really have useful bounds.
 104     let epd = finalizePD mempty defaultComponentRequestedSpec
 105                     (const True) platform cinfo [] gpd
 106     case epd of
 107       Left _ -> putStrLn "finalizePD failed"
 108       Right (pd,_) -> do
 109        let needBounds = map depName $ filter (not . hasUpperBound . depVersion) $
 110                          enabledBuildDepends pd defaultComponentRequestedSpec
 111
 112        pkgs  <- getFreezePkgs
 113                   verbosity packageDBs repoCtxt comp platform progdb
 114                   globalFlags freezeFlags
 115
 116        let isNeeded = hasElem needBounds . unPackageName . packageName
 117        let thePkgs = filter isNeeded pkgs
 118
 119        let padTo = maximum $ map (length . unPackageName . packageName) pkgs
 120
 121        if null thePkgs then notice verbosity
 122          "Congratulations, all your dependencies have upper bounds!"
 123         else do
 124          notice verbosity boundsNeededMsg
 125          traverse_ (notice verbosity . (++",") . showBounds padTo) thePkgs
 126
 127 depName :: Dependency -> String
 128 depName (Dependency pn _ _) = unPackageName pn
 129
 130 depVersion :: Dependency -> VersionRange
 131 depVersion (Dependency _ vr _) = vr
 132
 133 -- | The message printed when some dependencies are found to be lacking proper
 134 -- PVP-mandated bounds.
 135 boundsNeededMsg :: String
 136 boundsNeededMsg = unlines
 137   [ ""
 138   , "The following packages need bounds and here is a suggested starting point."
 139   , "You can copy and paste this into the build-depends section in your .cabal"
 140   , "file and it should work (with the appropriate removal of commas)."
 141   , ""
 142   , "Note that version bounds are a statement that you've successfully built and"
 143   , "tested your package and expect it to work with any of the specified package"
 144   , "versions (PROVIDED that those packages continue to conform with the PVP)."
 145   , "Therefore, the version bounds generated here are the most conservative"
 146   , "based on the versions that you are currently building with.  If you know"
 147   , "your package will work with versions outside the ranges generated here,"
 148   , "feel free to widen them."
 149   , ""
 150   ]