-- | Compute the debianization of a cabal package.
{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections #-}
module Debian.Debianize.BuildDependencies
    ( debianBuildDeps
    , debianBuildDepsIndep
    ) where


import Control.Lens
import Control.Monad ((>=>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (MonadState(get))
import Control.Monad.Trans (MonadIO)
import Data.Char (isSpace, toLower)
import Data.Function (on)
import Data.List as List (filter, groupBy, map, minimumBy, nub, sortBy)
import Data.Map as Map (lookup, Map)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
import Data.Set as Set (empty, fold, fromList, map, member, Set, singleton, toList, union)
import Debian.Debianize.Prelude
import Debian.Debianize.BasicInfo (compilerFlavor)
import Debian.Debianize.Bundled (builtIn)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.DebianName (mkPkgName, mkPkgName')
import Debian.Debianize.Monad as Monad (CabalInfo, CabalT)
import qualified Debian.Debianize.BinaryDebDescription as B
import qualified Debian.Debianize.CabalInfo as A
import qualified Debian.Debianize.SourceDebDescription as S
import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits)
import Debian.GHC (compilerPackageName)
import Debian.Orphans ()
import Debian.Relation (BinPkgName(..), checkVersionReq, Relation(..), Relations)
import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT))
import Debian.Version (DebianVersion, parseDebianVersion')
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.Package (Dependency(..), PackageIdentifier(pkgName, pkgVersion), PackageName)
import Distribution.PackageDescription as Cabal (BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Library(..), Executable(..), TestSuite(..), SetupBuildInfo(..), PackageDescription(setupBuildInfo))
import qualified Distribution.PackageDescription as Cabal (PackageDescription(library, executables, testSuites))
import Distribution.Pretty (prettyShow)
import Distribution.Types.LegacyExeDependency (LegacyExeDependency(..))
#if MIN_VERSION_Cabal(3,4,0)
import qualified Distribution.Compat.NonEmptySet as NES
import Distribution.Types.LibraryName (defaultLibName)
import Distribution.Version (anyVersion, asVersionIntervals, fromVersionIntervals, intersectVersionRanges, isNoVersion, toVersionIntervals, unionVersionRanges, VersionRange, withinVersion)
#else
import Distribution.Version (anyVersion, asVersionIntervals, fromVersionIntervals, intersectVersionRanges, invertVersionRange, isNoVersion, toVersionIntervals, unionVersionRanges, VersionRange, withinVersion)
#endif
import Distribution.Types.PkgconfigDependency (PkgconfigDependency(..))
import Prelude hiding (init, log, map, unlines, unlines, writeFile)
import System.Directory (findExecutable)
import System.Exit (ExitCode(ExitSuccess))
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcessWithExitCode)

data Dependency_
  = BuildDepends Dependency
  | BuildTools Dependency
  | PkgConfigDepends Dependency
  | ExtraLibs Relations
    deriving (Dependency_ -> Dependency_ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency_ -> Dependency_ -> Bool
$c/= :: Dependency_ -> Dependency_ -> Bool
== :: Dependency_ -> Dependency_ -> Bool
$c== :: Dependency_ -> Dependency_ -> Bool
Eq, Int -> Dependency_ -> ShowS
[Dependency_] -> ShowS
Dependency_ -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Dependency_] -> ShowS
$cshowList :: [Dependency_] -> ShowS
show :: Dependency_ -> [Char]
$cshow :: Dependency_ -> [Char]
showsPrec :: Int -> Dependency_ -> ShowS
$cshowsPrec :: Int -> Dependency_ -> ShowS
Show)

-- | Naive conversion of Cabal build dependencies to Debian
-- dependencies will usually result in a self dependency, due to the
-- fact that a Cabal executable often depends on the associated
-- library to build.  Due to the fact that Debian build dependencies
-- are global to the package, this results in unwanted self
-- dependencies, which usually need to be filtered out.
-- Unfortunately, some Debian packages actually do depend on an
-- earlier version of themselves to build (e.g. most compilers.)  So a
-- command line option is probably necessary.
--
-- selfDependency :: PackageIdentifier -> Dependency_ -> Bool
-- selfDependency pkgId (BuildDepends (Dependency name _)) = name == pkgName pkgId
-- selfDependency _ _ = False

unboxDependency :: Dependency_ -> Maybe Dependency
unboxDependency :: Dependency_ -> Maybe Dependency
unboxDependency (BuildDepends Dependency
d) = forall a. a -> Maybe a
Just Dependency
d
unboxDependency (BuildTools Dependency
d) = forall a. a -> Maybe a
Just Dependency
d
unboxDependency (PkgConfigDepends Dependency
d) = forall a. a -> Maybe a
Just Dependency
d
unboxDependency (ExtraLibs Relations
_) = forall a. Maybe a
Nothing -- Dependency (PackageName d) anyVersion mempty

-- |Debian packages don't have per binary package build dependencies,
-- so we just gather them all up here.
allBuildDepends :: Monad m => [BuildInfo] -> CabalT m [Dependency_]
allBuildDepends :: forall (m :: * -> *).
Monad m =>
[BuildInfo] -> CabalT m [Dependency_]
allBuildDepends [BuildInfo]
buildInfos =
    forall (m :: * -> *).
Monad m =>
[Dependency]
-> [Dependency]
-> [Dependency]
-> [[Char]]
-> CabalT m [Dependency_]
allBuildDepends'
      ([Dependency] -> [Dependency]
mergeCabalDependencies forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
Cabal.targetBuildDepends [BuildInfo]
buildInfos)
      ([Dependency] -> [Dependency]
mergeCabalDependencies forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LegacyExeDependency -> Maybe Dependency
convertLegacy forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [LegacyExeDependency]
buildTools [BuildInfo]
buildInfos)
      ([Dependency] -> [Dependency]
mergeCabalDependencies forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PkgconfigDependency -> Maybe Dependency
convertPkgconfig forall a b. (a -> b) -> a -> b
$  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [PkgconfigDependency]
pkgconfigDepends [BuildInfo]
buildInfos)
      (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [[Char]]
extraLibs [BuildInfo]
buildInfos)
    where
      convertLegacy :: LegacyExeDependency -> Maybe Dependency
      convertLegacy :: LegacyExeDependency -> Maybe Dependency
convertLegacy = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
      convertPkgconfig :: PkgconfigDependency -> Maybe Dependency
      convertPkgconfig :: PkgconfigDependency -> Maybe Dependency
convertPkgconfig = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
      allBuildDepends' :: Monad m => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> CabalT m [Dependency_]
      allBuildDepends' :: forall (m :: * -> *).
Monad m =>
[Dependency]
-> [Dependency]
-> [Dependency]
-> [[Char]]
-> CabalT m [Dependency_]
allBuildDepends' [Dependency]
buildDepends' [Dependency]
buildTools' [Dependency]
pkgconfigDepends' [[Char]]
extraLibs' =
          do CabalInfo
atoms <- forall s (m :: * -> *). MonadState s m => m s
get
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
List.map Dependency -> Dependency_
BuildDepends [Dependency]
buildDepends' forall a. [a] -> [a] -> [a]
++
                            forall a b. (a -> b) -> [a] -> [b]
List.map Dependency -> Dependency_
BuildTools [Dependency]
buildTools' forall a. [a] -> [a] -> [a]
++
                            forall a b. (a -> b) -> [a] -> [b]
List.map Dependency -> Dependency_
PkgConfigDepends [Dependency]
pkgconfigDepends' forall a. [a] -> [a] -> [a]
++
                            [Relations -> Dependency_
ExtraLibs (CabalInfo -> [[Char]] -> Relations
fixDeps CabalInfo
atoms [[Char]]
extraLibs')]

      fixDeps :: CabalInfo -> [String] -> Relations
      fixDeps :: CabalInfo -> [[Char]] -> Relations
fixDeps CabalInfo
atoms =
          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ [Char]
cab -> forall a. a -> Maybe a -> a
fromMaybe [[BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName ([Char]
"lib" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Char
toLower [Char]
cab forall a. [a] -> [a] -> [a]
++ [Char]
"-dev")) forall a. Maybe a
Nothing forall a. Maybe a
Nothing]]
                                        (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
cab (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map [Char] Relations)
D.extraLibMap) CabalInfo
atoms)))

setupBuildDepends :: SetupBuildInfo -> [Dependency_]
setupBuildDepends :: SetupBuildInfo -> [Dependency_]
setupBuildDepends = forall a b. (a -> b) -> [a] -> [b]
List.map Dependency -> Dependency_
BuildDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends

-- | Take the intersection of all the dependencies on a given package name
mergeCabalDependencies :: [Dependency] -> [Dependency]
mergeCabalDependencies :: [Dependency] -> [Dependency]
mergeCabalDependencies =
#if MIN_VERSION_Cabal(3,4,0)
    forall a b. (a -> b) -> [a] -> [b]
List.map (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\ (Dependency PackageName
name VersionRange
range1 NonEmptySet LibraryName
_) (Dependency PackageName
_ VersionRange
range2 NonEmptySet LibraryName
_) -> PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
name (VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
range1 VersionRange
range2) (forall a. a -> NonEmptySet a
NES.singleton LibraryName
defaultLibName))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Dependency -> PackageName
dependencyPackage) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Dependency -> PackageName
dependencyPackage)
#else
    List.map (foldl1 (\ (Dependency name range1 _) (Dependency _ range2 _) -> Dependency name (intersectVersionRanges range1 range2) mempty)) . groupBy ((==) `on` dependencyPackage) . sortBy (compare `on` dependencyPackage)
#endif
    where
      dependencyPackage :: Dependency -> PackageName
dependencyPackage (Dependency PackageName
x VersionRange
_ NonEmptySet LibraryName
_) = PackageName
x

-- The haskell-devscripts-minimal package contains the hlibrary.mk file with
-- the rules for building haskell packages.
debianBuildDeps :: (MonadIO m) => PackageDescription -> CabalT m D.Relations
debianBuildDeps :: forall (m :: * -> *).
MonadIO m =>
PackageDescription -> CabalT m Relations
debianBuildDeps PackageDescription
pkgDesc =
    do CompilerFlavor
hflavor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Flags
D.flags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Flags CompilerFlavor
compilerFlavor)
       Bool
prof <- Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Bool
D.noProfilingLibrary)
       let hcPackageTypes :: CompilerFlavor -> Set B.PackageType
           hcPackageTypes :: CompilerFlavor -> Set PackageType
hcPackageTypes CompilerFlavor
GHC = forall a. Ord a => [a] -> Set a
fromList ([PackageType
B.Development] forall a. Semigroup a => a -> a -> a
<> if Bool
prof then [PackageType
B.Profiling] else [])
           hcPackageTypes CompilerFlavor
GHCJS = forall a. Ord a => [a] -> Set a
fromList [PackageType
B.Development]
           hcPackageTypes CompilerFlavor
hc = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported compiler flavor: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CompilerFlavor
hc

       let hcs :: Set CompilerFlavor
hcs = forall a. a -> Set a
singleton CompilerFlavor
hflavor -- vestigial
           hcTypePairs :: Set (CompilerFlavor, PackageType)
hcTypePairs =
               forall a b. (a -> b -> b) -> b -> Set a -> b
fold forall a. Ord a => Set a -> Set a -> Set a
union forall a. Set a
empty forall a b. (a -> b) -> a -> b
$
                  forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\ CompilerFlavor
hc' -> forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (CompilerFlavor
hc',) forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> Set PackageType
hcPackageTypes CompilerFlavor
hc') Set CompilerFlavor
hcs
           setupDeps :: [Dependency_]
setupDeps = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SetupBuildInfo -> [Dependency_]
setupBuildDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc

       [Dependency_]
libDeps <- forall (m :: * -> *).
Monad m =>
[BuildInfo] -> CabalT m [Dependency_]
allBuildDepends (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. (a -> Bool) -> [a] -> [a]
filter forall e. IsBuildable e => e -> Bool
isBuildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) (PackageDescription -> Maybe Library
Cabal.library PackageDescription
pkgDesc))
       [Dependency_]
binDeps <- forall (m :: * -> *).
Monad m =>
[BuildInfo] -> CabalT m [Dependency_]
allBuildDepends (forall a b. (a -> b) -> [a] -> [b]
List.map Executable -> BuildInfo
buildInfo (forall a. (a -> Bool) -> [a] -> [a]
filter forall e. IsBuildable e => e -> Bool
isBuildable (PackageDescription -> [Executable]
Cabal.executables PackageDescription
pkgDesc)))
       [Dependency_]
testDeps <- forall (m :: * -> *).
Monad m =>
[BuildInfo] -> CabalT m [Dependency_]
allBuildDepends (forall a b. (a -> b) -> [a] -> [b]
List.map TestSuite -> BuildInfo
testBuildInfo (forall a. (a -> Bool) -> [a] -> [a]
filter forall e. IsBuildable e => e -> Bool
isBuildable (PackageDescription -> [TestSuite]
Cabal.testSuites PackageDescription
pkgDesc)))
       TestsStatus
testsStatus <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo TestsStatus
D.testsStatus)

       Relations
cDeps <- forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
            [ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Set (CompilerFlavor, PackageType)
-> Dependency_ -> CabalT m Relations
buildDependencies Set (CompilerFlavor, PackageType)
hcTypePairs) [Dependency_]
libDeps
            , forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Set (CompilerFlavor, PackageType)
-> Dependency_ -> CabalT m Relations
buildDependencies Set (CompilerFlavor, PackageType)
hcTypePairs) [Dependency_]
binDeps
            , forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Set (CompilerFlavor, PackageType)
-> Dependency_ -> CabalT m Relations
buildDependencies Set (CompilerFlavor, PackageType)
hcTypePairs) [Dependency_]
setupDeps
            , forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Set (CompilerFlavor, PackageType)
-> Dependency_ -> CabalT m Relations
buildDependencies Set (CompilerFlavor, PackageType)
hcTypePairs) (if TestsStatus
testsStatus forall a. Eq a => a -> a -> Bool
/= TestsStatus
D.TestsDisable then [Dependency_]
testDeps else [])
            ]

       Relations
bDeps <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo SourceDebDescription
D.control forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SourceDebDescription Relations
S.buildDepends)
       Maybe Int
compat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Maybe Int)
D.compat)
       Maybe BinPkgName
ghcdev <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> PackageType -> IO (Maybe BinPkgName)
compilerPackageName CompilerFlavor
hflavor PackageType
B.Development
       Maybe BinPkgName
ghcprof <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> PackageType -> IO (Maybe BinPkgName)
compilerPackageName CompilerFlavor
hflavor PackageType
B.Profiling
       let ghcrel :: Relations
ghcrel = if forall a. Ord a => a -> Set a -> Bool
member CompilerFlavor
GHC Set CompilerFlavor
hcs then forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> [Relation]
anyrel') Maybe BinPkgName
ghcdev else []
       let ghcrelprof :: Relations
ghcrelprof = if Bool
prof then forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> [Relation]
anyrel') Maybe BinPkgName
ghcprof else []
       let xs :: Relations
xs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ Int
n -> [BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName [Char]
"debhelper") (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.GRE (forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (forall a. Show a => a -> [Char]
show Int
n)))) forall a. Maybe a
Nothing]) Maybe Int
compat,
                       [BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName [Char]
"haskell-devscripts-minimal") forall a. Maybe a
Nothing forall a. Maybe a
Nothing,
                        BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName [Char]
"haskell-devscripts") (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
D.GRE forall a b. (a -> b) -> a -> b
$ forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' ([Char]
"0.13" :: String)) forall a. Maybe a
Nothing],
                       [Char] -> [Relation]
anyrel [Char]
"cdbs"] forall a. [a] -> [a] -> [a]
++
                      (Relations
ghcrel forall a. [a] -> [a] -> [a]
++ Relations
ghcrelprof) forall a. [a] -> [a] -> [a]
++
                       Relations
bDeps forall a. [a] -> [a] -> [a]
++
                       Relations
cDeps
       forall (m :: * -> *). Monad m => Relations -> CabalT m Relations
filterMissing Relations
xs
    where
      -- No point in installing profiling packages for the
      -- dependencies of binaries and test suites.  (I take it back,
      -- some executable builds fail if the profiling library isn't
      -- installed.)
#if 0
      hcPackageTypesBins :: CompilerFlavor -> Set B.PackageType
      hcPackageTypesBins GHC = singleton [B.Development, B.Profiling]

      hcPackageTypesTests :: CompilerFlavor -> Set B.PackageType
      hcPackageTypesTests GHC = singleton [B.Development, B.Profiling]
#endif

class IsBuildable e where
    isBuildable :: e -> Bool

instance IsBuildable Executable where
    isBuildable :: Executable -> Bool
isBuildable = BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo

instance IsBuildable BuildInfo where
    isBuildable :: BuildInfo -> Bool
isBuildable = BuildInfo -> Bool
buildable

instance IsBuildable TestSuite where
    isBuildable :: TestSuite -> Bool
isBuildable = BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo

-- | Collect the dependencies required to build any packages that have
-- architecture "all".
debianBuildDepsIndep :: (MonadIO m) => PackageDescription -> CabalT m D.Relations
debianBuildDepsIndep :: forall (m :: * -> *).
MonadIO m =>
PackageDescription -> CabalT m Relations
debianBuildDepsIndep PackageDescription
pkgDesc =
    do CompilerFlavor
hc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Flags
D.flags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Flags CompilerFlavor
compilerFlavor)
       let hcs :: Set CompilerFlavor
hcs = forall a. a -> Set a
singleton CompilerFlavor
hc -- vestigial
       Bool
doc <- Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Bool
D.noDocumentationLibrary)
       Relations
bDeps <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo SourceDebDescription
D.control forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SourceDebDescription Relations
S.buildDependsIndep)
       [Dependency_]
libDeps <- forall (m :: * -> *).
Monad m =>
[BuildInfo] -> CabalT m [Dependency_]
allBuildDepends (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) (PackageDescription -> Maybe Library
Cabal.library PackageDescription
pkgDesc))
       [Relations]
cDeps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
MonadIO m =>
Dependency_ -> CabalT m Relations
docDependencies [Dependency_]
libDeps
       Maybe BinPkgName
ghcdoc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> PackageType -> IO (Maybe BinPkgName)
compilerPackageName CompilerFlavor
hc PackageType
B.Documentation
       let hcdocdep :: Relations
hcdocdep = if Bool
doc Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
member CompilerFlavor
GHC Set CompilerFlavor
hcs then forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> [Relation]
anyrel') Maybe BinPkgName
ghcdoc else []
       let xs :: Relations
xs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ if Bool
doc Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (PackageDescription -> Maybe Library
Cabal.library PackageDescription
pkgDesc)
                      then Relations
hcdocdep forall a. [a] -> [a] -> [a]
++ Relations
bDeps forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Relations]
cDeps
                      else []
       forall (m :: * -> *). Monad m => Relations -> CabalT m Relations
filterMissing Relations
xs

-- | The documentation dependencies for a package include the
-- documentation package for any libraries which are build
-- dependencies, so we have use to all the cross references.
docDependencies :: (MonadIO m) => Dependency_ -> CabalT m D.Relations
docDependencies :: forall (m :: * -> *).
MonadIO m =>
Dependency_ -> CabalT m Relations
docDependencies (BuildDepends (Dependency PackageName
name VersionRange
ranges NonEmptySet LibraryName
_)) =
    do CompilerFlavor
hc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Flags
D.flags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Flags CompilerFlavor
compilerFlavor)
       let hcs :: Set CompilerFlavor
hcs = forall a. a -> Set a
singleton CompilerFlavor
hc -- vestigial
       Bool
omitProfDeps <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Bool
D.omitProfVersionDeps)
       forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ CompilerFlavor
hc' -> forall (m :: * -> *).
MonadIO m =>
CompilerFlavor
-> PackageType
-> PackageName
-> VersionRange
-> Bool
-> CabalT m Relations
dependencies CompilerFlavor
hc' PackageType
B.Documentation PackageName
name VersionRange
ranges Bool
omitProfDeps) (forall a. Set a -> [a]
toList Set CompilerFlavor
hcs)
docDependencies Dependency_
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | The Debian build dependencies for a package include the profiling
-- libraries and the documentation packages, used for creating cross
-- references.  Also the packages associated with extra libraries.
buildDependencies :: (MonadIO m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations
buildDependencies :: forall (m :: * -> *).
MonadIO m =>
Set (CompilerFlavor, PackageType)
-> Dependency_ -> CabalT m Relations
buildDependencies Set (CompilerFlavor, PackageType)
hcTypePairs (BuildDepends (Dependency PackageName
name VersionRange
ranges NonEmptySet LibraryName
_)) =
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo Bool
D.omitProfVersionDeps) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Bool
omitProfDeps ->
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ (CompilerFlavor
hc, PackageType
typ) -> forall (m :: * -> *).
MonadIO m =>
CompilerFlavor
-> PackageType
-> PackageName
-> VersionRange
-> Bool
-> CabalT m Relations
dependencies CompilerFlavor
hc PackageType
typ PackageName
name VersionRange
ranges Bool
omitProfDeps) (forall a. Set a -> [a]
toList Set (CompilerFlavor, PackageType)
hcTypePairs)
buildDependencies Set (CompilerFlavor, PackageType)
_ dep :: Dependency_
dep@(ExtraLibs Relations
_) =
    do Map [Char] Relations
mp <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map [Char] Relations)
D.execMap)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Map [Char] Relations -> Dependency_ -> [Relations]
adapt Map [Char] Relations
mp Dependency_
dep
buildDependencies Set (CompilerFlavor, PackageType)
_ Dependency_
dep =
    case Dependency_ -> Maybe Dependency
unboxDependency Dependency_
dep of
      Just (Dependency PackageName
_name VersionRange
_ranges NonEmptySet LibraryName
_) ->
          do Map [Char] Relations
mp <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Map [Char] Relations)
D.execMap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Map [Char] Relations -> Dependency_ -> [Relations]
adapt Map [Char] Relations
mp Dependency_
dep
      Maybe Dependency
Nothing ->
          forall (m :: * -> *) a. Monad m => a -> m a
return []

adapt :: Map.Map String Relations -> Dependency_ -> [Relations]
adapt :: Map [Char] Relations -> Dependency_ -> [Relations]
adapt Map [Char] Relations
mp (PkgConfigDepends (Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_)) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> [Relations]
aptFile (PackageName -> [Char]
unPackageName PackageName
pkg)) (forall a. a -> [a] -> [a]
: []) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName -> [Char]
unPackageName PackageName
pkg) Map [Char] Relations
mp)
adapt Map [Char] Relations
mp (BuildTools (Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_)) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> [Relations]
aptFile (PackageName -> [Char]
unPackageName PackageName
pkg)) (forall a. a -> [a] -> [a]
: []) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName -> [Char]
unPackageName PackageName
pkg) Map [Char] Relations
mp)
adapt Map [Char] Relations
_flags (ExtraLibs Relations
x) = [Relations
x]
adapt Map [Char] Relations
_flags (BuildDepends (Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_)) = [[[BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName (PackageName -> [Char]
unPackageName PackageName
pkg)) forall a. Maybe a
Nothing forall a. Maybe a
Nothing]]]

-- There are three reasons this may not work, or may work
-- incorrectly: (1) the build environment may be a different
-- distribution than the parent environment (the environment the
-- autobuilder was run from), so the packages in that
-- environment might have different names, (2) the package
-- we are looking for may not be installed in the parent
-- environment, and (3) the apt-file executable is not installed.
aptFile :: String -> [Relations] -- Maybe would probably be more correct
aptFile :: [Char] -> [Relations]
aptFile [Char]
pkg = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    [Char] -> IO (Maybe [Char])
findExecutable [Char]
"apt-file" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [Char] -> IO [Relations]
aptFile'
  where
    aptFile' :: Maybe [Char] -> IO [Relations]
aptFile' Maybe [Char]
Nothing = forall a. HasCallStack => [Char] -> a
error [Char]
"The apt-file executable could not be found."
    aptFile' (Just [Char]
aptfile) = do
        (ExitCode, [Char], [Char])
ret <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
aptfile [[Char]
"-l", [Char]
"search", [Char]
pkg forall a. [a] -> [a] -> [a]
++ [Char]
".pc"] [Char]
""
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (ExitCode, [Char], [Char])
ret of
                  (ExitCode
ExitSuccess, [Char]
out, [Char]
_) ->
                      case forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) [Char]
out of
                        [Char]
"" -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to locate a debian package containing the build tool " forall a. [a] -> [a] -> [a]
++ [Char]
pkg forall a. [a] -> [a] -> [a]
++
                                      [Char]
", try using --exec-map " forall a. [a] -> [a] -> [a]
++ [Char]
pkg forall a. [a] -> [a] -> [a]
++ [Char]
":<debname> or execMap " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
pkg forall a. [a] -> [a] -> [a]
++
                                      [Char]
" [[Rel (BinPkgName \"<debname>\") Nothing Nothing]]"
                        [Char]
s -> [[[BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel ([Char] -> BinPkgName
D.BinPkgName [Char]
s) forall a. Maybe a
Nothing forall a. Maybe a
Nothing]]]
                  (ExitCode, [Char], [Char])
_ -> []

anyrel :: String -> [D.Relation]
anyrel :: [Char] -> [Relation]
anyrel [Char]
x = BinPkgName -> [Relation]
anyrel' ([Char] -> BinPkgName
D.BinPkgName [Char]
x)

anyrel' :: D.BinPkgName -> [D.Relation]
anyrel' :: BinPkgName -> [Relation]
anyrel' BinPkgName
x = [BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
x forall a. Maybe a
Nothing forall a. Maybe a
Nothing]

-- | Turn a cabal dependency into debian dependencies.  The result
-- needs to correspond to a single debian package to be installed,
-- so we will return just an OrRelation.
dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations
dependencies :: forall (m :: * -> *).
MonadIO m =>
CompilerFlavor
-> PackageType
-> PackageName
-> VersionRange
-> Bool
-> CabalT m Relations
dependencies CompilerFlavor
hc PackageType
typ PackageName
name VersionRange
cabalRange Bool
omitProfVersionDeps =
    do Map PackageName VersionSplits
nameMap <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo (Map PackageName VersionSplits)
A.debianNameMap
       -- Compute a list of alternative debian dependencies for
       -- satisfying a cabal dependency.  The only caveat is that
       -- we may need to distribute any "and" dependencies implied
       -- by a version range over these "or" dependences.
       let alts :: [(BinPkgName, VersionRange)]
           alts :: [(BinPkgName, VersionRange)]
alts = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName VersionSplits
nameMap of
                    -- If there are no splits for this package just
                    -- return the single dependency for the package.
                    Maybe VersionSplits
Nothing -> [(forall name.
PkgName name =>
CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName CompilerFlavor
hc PackageName
name PackageType
typ, VersionRange
cabalRange')]
                    -- If there are splits create a list of (debian package name, VersionRange) pairs
                    Just VersionSplits
splits' -> forall a b. (a -> b) -> [a] -> [b]
List.map (\ (DebBase
n, VersionRange
r) -> (forall name.
PkgName name =>
CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' CompilerFlavor
hc PackageType
typ DebBase
n, VersionRange
r)) (VersionSplits -> [(DebBase, VersionRange)]
packageRangesFromVersionSplits VersionSplits
splits')
       forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
Monad m =>
(BinPkgName, VersionRange)
-> StateT CabalInfo m (Maybe (Rels Relation))
convert [(BinPkgName, VersionRange)]
alts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
PackageType
-> PackageName
-> CompilerFlavor
-> [Relation]
-> CabalT m [Relation]
doBundled PackageType
typ PackageName
name CompilerFlavor
hc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> [[a]]
convert' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> Rels a
canonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Rels a] -> Rels a
Or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
    where
      convert :: (BinPkgName, VersionRange)
-> StateT CabalInfo m (Maybe (Rels Relation))
convert (BinPkgName
dname, VersionRange
range) =
          case VersionRange -> Bool
isNoVersion VersionRange
range''' of
            Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Bool
False ->
                forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange forall {m :: * -> *}.
Monad m =>
VersionRangeF (StateT CabalInfo m (Rels Relation))
-> StateT CabalInfo m (Rels Relation)
rangeToRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionRange
normaliseVersionRange) VersionRange
range'''
          where
#if !MIN_VERSION_Cabal(3,4,0)
            rangeToRange AnyVersionF                     = return $ Rel' (D.Rel dname Nothing Nothing)
#endif
            rangeToRange :: VersionRangeF (StateT CabalInfo m (Rels Relation))
-> StateT CabalInfo m (Rels Relation)
rangeToRange (ThisVersionF Version
v)                = (forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ DebianVersion
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.EEQ DebianVersion
dv)) forall a. Maybe a
Nothing)) Version
v
            rangeToRange (LaterVersionF Version
v)               = (forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ DebianVersion
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.SGR DebianVersion
dv)) forall a. Maybe a
Nothing)) Version
v
            rangeToRange (EarlierVersionF Version
v)             = (forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ DebianVersion
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.SLT DebianVersion
dv)) forall a. Maybe a
Nothing)) Version
v
            rangeToRange (OrLaterVersionF Version
v)
               | Version
v forall a. Eq a => a -> a -> Bool
== [Int] -> Version
mkVersion [Int
0] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
               | Bool
otherwise = (forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ DebianVersion
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.GRE DebianVersion
dv)) forall a. Maybe a
Nothing)) Version
v
            rangeToRange (OrEarlierVersionF Version
v)           = (forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ DebianVersion
dv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.LTE DebianVersion
dv)) forall a. Maybe a
Nothing)) Version
v
#if !MIN_VERSION_Cabal(3,4,0)
            rangeToRange (WildcardVersionF v)            = (\ x y -> debianVersion' name x >>= \ dvx ->
                                    debianVersion' name y >>= \ dvy ->
                                    return $ And [Rel' (D.Rel dname (Just (D.GRE dvx)) Nothing),
                                                  Rel' (D.Rel dname (Just (D.SLT dvy)) Nothing)]) v (wildcardUpperBound v)
#endif
            rangeToRange (MajorBoundVersionF Version
v)          = (\ Version
x Version
y -> forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name Version
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ DebianVersion
dvx ->
                                    forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name Version
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ DebianVersion
dvy ->
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Rels a] -> Rels a
And [forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.GRE DebianVersion
dvx)) forall a. Maybe a
Nothing),
                                                  forall a. a -> Rels a
Rel' (BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
dname (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.SLT DebianVersion
dvy)) forall a. Maybe a
Nothing)]) Version
v (Version -> Version
majorUpperBound Version
v)
            rangeToRange (UnionVersionRangesF StateT CabalInfo m (Rels Relation)
v1 StateT CabalInfo m (Rels Relation)
v2)     = (\ StateT CabalInfo m (Rels Relation)
x StateT CabalInfo m (Rels Relation)
y -> StateT CabalInfo m (Rels Relation)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Rels Relation
x' -> StateT CabalInfo m (Rels Relation)
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Rels Relation
y' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Rels a] -> Rels a
Or [Rels Relation
x', Rels Relation
y']) StateT CabalInfo m (Rels Relation)
v1 StateT CabalInfo m (Rels Relation)
v2
            rangeToRange (IntersectVersionRangesF StateT CabalInfo m (Rels Relation)
v1 StateT CabalInfo m (Rels Relation)
v2) = (\ StateT CabalInfo m (Rels Relation)
x StateT CabalInfo m (Rels Relation)
y -> StateT CabalInfo m (Rels Relation)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Rels Relation
x' -> StateT CabalInfo m (Rels Relation)
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Rels Relation
y' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Rels a] -> Rels a
And [Rels Relation
x', Rels Relation
y']) StateT CabalInfo m (Rels Relation)
v1 StateT CabalInfo m (Rels Relation)
v2
#if !MIN_VERSION_Cabal(3,4,0)
            rangeToRange (VersionRangeParensF v)         = v
#endif
            -- Choose the simpler of the two
            range''' :: VersionRange
range''' = VersionRange -> VersionRange
canon (VersionRange -> VersionRange -> VersionRange
simpler VersionRange
range' VersionRange
range'')
            -- Unrestrict the range for versions that we know don't exist for this debian package
#if MIN_VERSION_Cabal(3,6,0)
            range'' :: VersionRange
range'' = VersionRange
range' -- inversion functions are gone
#else
            range'' = canon (unionVersionRanges range' (invertVersionRange range))
#endif
            -- Restrict the range to the versions specified for this debian package
            range' :: VersionRange
range' = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
cabalRange' VersionRange
range
            -- When we see a cabal equals dependency we need to turn it into
            -- a wildcard because the resulting debian version numbers have
            -- various suffixes added.
      cabalRange' :: VersionRange
cabalRange' | PackageType
typ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageType]
noVersionPackageType = VersionRange
anyVersion
                  | Bool
otherwise = ((VersionRangeF VersionRange -> VersionRange)
-> (VersionRange -> VersionRangeF VersionRange)
-> VersionRange
-> VersionRange
hyloVersionRange VersionRangeF VersionRange -> VersionRange
tweak VersionRange -> VersionRangeF VersionRange
projectVersionRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionRange
normaliseVersionRange) VersionRange
cabalRange
      tweak :: VersionRangeF VersionRange -> VersionRange
tweak (ThisVersionF Version
v) = Version -> VersionRange
withinVersion Version
v
      tweak VersionRangeF VersionRange
vr = VersionRangeF VersionRange -> VersionRange
embedVersionRange VersionRangeF VersionRange
vr
      noVersionPackageType :: [PackageType]
noVersionPackageType = (if Bool
omitProfVersionDeps then [PackageType
B.Profiling] else []) forall a. [a] -> [a] -> [a]
++ [PackageType
B.Documentation]
      simpler :: VersionRange -> VersionRange -> VersionRange
simpler VersionRange
v1 VersionRange
v2 = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> [VersionInterval]
asVersionIntervals)) [VersionRange
v1, VersionRange
v2]
      -- Simplify a VersionRange
      canon :: VersionRange -> VersionRange
canon = VersionIntervals -> VersionRange
fromVersionIntervals forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionIntervals
toVersionIntervals

-- | If a package is bundled with the compiler we make the
-- compiler a substitute for that package.  If we were to
-- specify the virtual package (e.g. libghc-base-dev) we would
-- have to make sure not to specify a version number.
doBundled :: MonadIO m =>
             B.PackageType
          -> PackageName
          -> CompilerFlavor
          -> [D.Relation]
          -> CabalT m [D.Relation]
doBundled :: forall (m :: * -> *).
MonadIO m =>
PackageType
-> PackageName
-> CompilerFlavor
-> [Relation]
-> CabalT m [Relation]
doBundled PackageType
typ PackageName
name CompilerFlavor
hc [Relation]
rels = do
  Maybe BinPkgName
hcname <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> PackageType -> IO (Maybe BinPkgName)
compilerPackageName CompilerFlavor
hc PackageType
typ
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Maybe BinPkgName -> Relation -> CabalT m [Relation]
doRel Maybe BinPkgName
hcname) [Relation]
rels
    where
      -- If a library is built into the compiler, this is the debian
      -- package name the compiler will conflict with.
      doRel :: MonadIO m => Maybe BinPkgName -> D.Relation -> CabalT m [D.Relation]
      doRel :: forall (m :: * -> *).
MonadIO m =>
Maybe BinPkgName -> Relation -> CabalT m [Relation]
doRel Maybe BinPkgName
hcname rel :: Relation
rel@(D.Rel BinPkgName
dname Maybe VersionReq
req Maybe ArchitectureReq
_) = do
        let comp :: [Relation]
comp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\BinPkgName
x -> [BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
D.Rel BinPkgName
x forall a. Maybe a
Nothing forall a. Maybe a
Nothing]) Maybe BinPkgName
hcname
        -- gver <- use ghcVersion
        -- Look at what version of the package is provided by the compiler.
        CabalInfo
atoms <- forall s (m :: * -> *). MonadState s m => m s
get
        -- What version of this package (if any) does the compiler provide?
        [PackageIdentifier]
relInfo <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> IO [PackageIdentifier]
builtIn CompilerFlavor
hc
        let pver :: Maybe DebianVersion
pver = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CabalInfo -> PackageIdentifier -> DebianVersion
debianVersion'' CabalInfo
atoms) (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== PackageName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName) [PackageIdentifier]
relInfo)
        -- The name this library would have if it was in the compiler conflicts list.
        let naiveDebianName :: BinPkgName
naiveDebianName = forall name.
PkgName name =>
CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName CompilerFlavor
hc PackageName
name PackageType
typ
        -- The compiler should appear in the build dependency
        -- if it provides a suitable version of the library,
        -- or if it conflicts with all versions of the
        -- library (which, if pver is Nothing, will certainly
        -- result in an error which needs to be corrected in
        -- the packaging.)
        let compilerDependency :: [Relation]
compilerDependency = if forall a. Maybe a -> Bool
isJust Maybe DebianVersion
pver Bool -> Bool -> Bool
&& (Maybe VersionReq -> Maybe DebianVersion -> Bool
checkVersionReq Maybe VersionReq
req Maybe DebianVersion
pver Bool -> Bool -> Bool
|| BinPkgName
dname forall a. Eq a => a -> a -> Bool
== BinPkgName
naiveDebianName) then [Relation]
comp else []
        -- The library package can satisfy the dependency if
        -- the compiler doesn't provide a version, or if the
        -- compiler doesn't conflict with the package's
        -- debian name.
        let libraryDependency :: [Relation]
libraryDependency = if forall a. Maybe a -> Bool
isNothing Maybe DebianVersion
pver Bool -> Bool -> Bool
|| BinPkgName
dname forall a. Eq a => a -> a -> Bool
/= BinPkgName
naiveDebianName then [Relation
rel] else []
        -- Is the version number in the library dependency newer than
        -- the compiler version?  If so it should appear to its left,
        -- otherwise to its right.
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe VersionReq
req of
                   Just (D.SLT DebianVersion
lver) | forall a. a -> Maybe a
Just DebianVersion
lver forall a. Ord a => a -> a -> Bool
< Maybe DebianVersion
pver -> [Relation]
compilerDependency forall a. [a] -> [a] -> [a]
++ [Relation]
libraryDependency
                   Just (D.LTE DebianVersion
lver) | forall a. a -> Maybe a
Just DebianVersion
lver forall a. Ord a => a -> a -> Bool
< Maybe DebianVersion
pver -> [Relation]
compilerDependency forall a. [a] -> [a] -> [a]
++ [Relation]
libraryDependency
                   Just (D.EEQ DebianVersion
lver) | forall a. a -> Maybe a
Just DebianVersion
lver forall a. Ord a => a -> a -> Bool
< Maybe DebianVersion
pver -> [Relation]
compilerDependency forall a. [a] -> [a] -> [a]
++ [Relation]
libraryDependency
                   Maybe VersionReq
_ -> [Relation]
libraryDependency forall a. [a] -> [a] -> [a]
++ [Relation]
compilerDependency

-- Convert a cabal version to a debian version, adding an epoch number if requested
debianVersion' :: Monad m => PackageName -> Version -> CabalT m DebianVersion
debianVersion' :: forall (m :: * -> *).
Monad m =>
PackageName -> Version -> CabalT m DebianVersion
debianVersion' PackageName
name Version
v =
    do CabalInfo
atoms <- forall s (m :: * -> *). MonadState s m => m s
get
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\ Int
n -> forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
":") (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CabalInfo (Map PackageName Int)
A.epochMap CabalInfo
atoms)) forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow Version
v)

debianVersion'' :: CabalInfo -> PackageIdentifier -> DebianVersion
debianVersion'' :: CabalInfo -> PackageIdentifier -> DebianVersion
debianVersion'' CabalInfo
atoms PackageIdentifier
i = forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\ Int
n -> forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
":") (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageIdentifier -> PackageName
pkgName PackageIdentifier
i) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CabalInfo (Map PackageName Int)
A.epochMap CabalInfo
atoms)) forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow (PackageIdentifier -> Version
pkgVersion PackageIdentifier
i))

data Rels a = And {forall a. Rels a -> [Rels a]
unAnd :: [Rels a]} | Or {forall a. Rels a -> [Rels a]
unOr :: [Rels a]} | Rel' {forall a. Rels a -> a
unRel :: a} deriving Int -> Rels a -> ShowS
forall a. Show a => Int -> Rels a -> ShowS
forall a. Show a => [Rels a] -> ShowS
forall a. Show a => Rels a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Rels a] -> ShowS
$cshowList :: forall a. Show a => [Rels a] -> ShowS
show :: Rels a -> [Char]
$cshow :: forall a. Show a => Rels a -> [Char]
showsPrec :: Int -> Rels a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Rels a -> ShowS
Show

convert' :: Rels a -> [[a]]
convert' :: forall a. Rels a -> [[a]]
convert' = forall a b. (a -> b) -> [a] -> [b]
List.map (forall a b. (a -> b) -> [a] -> [b]
List.map forall a. Rels a -> a
unRel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> [Rels a]
unOr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> [Rels a]
unAnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> Rels a
canonical

-- | return and of ors of rel
canonical :: Rels a -> Rels a
canonical :: forall a. Rels a -> Rels a
canonical (Rel' a
rel) = forall a. [Rels a] -> Rels a
And [forall a. [Rels a] -> Rels a
Or [forall a. a -> Rels a
Rel' a
rel]]
canonical (And [Rels a]
rels) = forall a. [Rels a] -> Rels a
And forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Rels a -> [Rels a]
unAnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> Rels a
canonical) [Rels a]
rels
canonical (Or [Rels a]
rels) = forall a. [Rels a] -> Rels a
And forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall a. [Rels a] -> Rels a
Or forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Rels a -> [Rels a]
unOr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> [Rels a]
unAnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rels a -> Rels a
canonical) [Rels a]
rels

filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]]
filterMissing :: forall (m :: * -> *). Monad m => Relations -> CabalT m Relations
filterMissing Relations
rels =
    forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ CabalInfo
atoms -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    forall a. (a -> Bool) -> [a] -> [a]
List.filter (forall a. Eq a => a -> a -> Bool
/= []) (forall a b. (a -> b) -> [a] -> [b]
List.map (forall a. (a -> Bool) -> [a] -> [a]
List.filter (\ (Rel BinPkgName
name Maybe VersionReq
_ Maybe ArchitectureReq
_) -> Bool -> Bool
not (forall a. Ord a => a -> Set a -> Bool
Set.member BinPkgName
name (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' CabalInfo DebInfo
A.debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Set BinPkgName)
D.missingDependencies) CabalInfo
atoms)))) Relations
rels)