module Debian.Debianize.BuildDependencies
( debianBuildDeps
, debianBuildDepsIndep
) where
import Control.Applicative ((<$>))
import Control.Lens
import Control.Monad.State (MonadState(get))
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)
import Data.Set as Set (empty, fold, fromList, map, member, Set, singleton, toList, union)
import Data.Version (showVersion, Version)
import Debian.Debianize.BasicInfo (buildEnv, compilerFlavor, EnvSet(dependOS))
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(..), PackageName(PackageName))
import Distribution.PackageDescription (PackageDescription)
import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..), TestSuite(..))
import qualified Distribution.PackageDescription as Cabal (PackageDescription(buildDepends, executables, testSuites))
import Distribution.Version (anyVersion, asVersionIntervals, earlierVersion, foldVersionRange', fromVersionIntervals, intersectVersionRanges, isNoVersion, laterVersion, orEarlierVersion, orLaterVersion, toVersionIntervals, unionVersionRanges, VersionRange, withinVersion)
import Distribution.Version.Invert (invertVersionRange)
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 (Eq, Show)
unboxDependency :: Dependency_ -> Maybe Dependency
unboxDependency (BuildDepends d) = Just d
unboxDependency (BuildTools d) = Just d
unboxDependency (PkgConfigDepends d) = Just d
unboxDependency (ExtraLibs _) = Nothing
allBuildDepends :: Monad m => PackageDescription -> CabalT m [Dependency_]
allBuildDepends pkgDesc =
use (A.debInfo . D.testsStatus) >>= \ testsStatus ->
allBuildDepends'
(mergeCabalDependencies $
Cabal.buildDepends pkgDesc ++
concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc) ++
(if testsStatus /= D.TestsDisable then concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) $ (Cabal.testSuites pkgDesc) else []))
(mergeCabalDependencies $ concatMap buildTools $ allBuildInfo pkgDesc)
(mergeCabalDependencies $ concatMap pkgconfigDepends $ allBuildInfo pkgDesc)
(concatMap extraLibs . allBuildInfo $ pkgDesc) >>=
return
where
allBuildDepends' :: Monad m => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> CabalT m [Dependency_]
allBuildDepends' buildDepends' buildTools' pkgconfigDepends' extraLibs' =
do atoms <- get
return $ nub $ List.map BuildDepends buildDepends' ++
List.map BuildTools buildTools' ++
List.map PkgConfigDepends pkgconfigDepends' ++
[ExtraLibs (fixDeps atoms extraLibs')]
fixDeps :: CabalInfo -> [String] -> Relations
fixDeps atoms xs =
concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ List.map toLower cab ++ "-dev")) Nothing Nothing]]
(Map.lookup cab (view (A.debInfo . D.extraLibMap) atoms))) xs
mergeCabalDependencies :: [Dependency] -> [Dependency]
mergeCabalDependencies =
List.map (foldl1 (\ (Dependency name range1) (Dependency _ range2) -> Dependency name (intersectVersionRanges range1 range2))) . groupBy ((==) `on` dependencyPackage) . sortBy (compare `on` dependencyPackage)
where
dependencyPackage (Dependency x _) = x
debianBuildDeps :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations
debianBuildDeps pkgDesc =
do hc <- use (A.debInfo . D.flags . compilerFlavor)
let hcs = singleton hc
let hcTypePairs =
fold union empty $
Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypes hc') hcs
cDeps <- allBuildDepends pkgDesc >>= mapM (buildDependencies hcTypePairs) >>= return . concat
bDeps <- use (A.debInfo . D.control . S.buildDepends)
prof <- not <$> use (A.debInfo . D.noProfilingLibrary)
official <- use (A.debInfo . D.official)
compat <- use (A.debInfo . D.compat)
let xs = nub $ [maybe [] (\ n -> [D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion (show n)))) Nothing]) compat,
[D.Rel (D.BinPkgName "haskell-devscripts") (Just $ D.GRE $ parseDebianVersion $ if official then "0.9" else "0.8" :: String) Nothing],
anyrel "cdbs"] ++
(if member GHC hcs
then [anyrel' (compilerPackageName GHC B.Development)] ++ if prof then [anyrel' (compilerPackageName GHC B.Profiling)] else []
else []) ++
#if MIN_VERSION_Cabal(1,22,0)
(if member GHCJS hcs then [anyrel "ghcjs"] else []) ++
#endif
bDeps ++
cDeps
filterMissing xs
where
hcPackageTypes :: CompilerFlavor -> Set B.PackageType
hcPackageTypes GHC = fromList [B.Development, B.Profiling]
#if MIN_VERSION_Cabal(1,22,0)
hcPackageTypes GHCJS = fromList [B.Development]
#endif
hcPackageTypes hc = error $ "Unsupported compiler flavor: " ++ show hc
debianBuildDepsIndep :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations
debianBuildDepsIndep pkgDesc =
do hc <- use (A.debInfo . D.flags . compilerFlavor)
let hcs = singleton hc
doc <- not <$> use (A.debInfo . D.noDocumentationLibrary)
bDeps <- use (A.debInfo . D.control . S.buildDependsIndep)
cDeps <- allBuildDepends pkgDesc >>= mapM docDependencies
let xs = nub $ if doc
then (if member GHC hcs then [anyrel' (compilerPackageName GHC B.Documentation)] else []) ++
#if MIN_VERSION_Cabal(1,22,0)
(if member GHCJS hcs then [anyrel "ghcjs"] else []) ++
#endif
bDeps ++ concat cDeps
else []
filterMissing xs
docDependencies :: (Monad m, Functor m) => Dependency_ -> CabalT m D.Relations
docDependencies (BuildDepends (Dependency name ranges)) =
do hc <- use (A.debInfo . D.flags . compilerFlavor)
let hcs = singleton hc
omitProfDeps <- use (A.debInfo . D.omitProfVersionDeps)
concat <$> mapM (\ hc' -> dependencies hc' B.Documentation name ranges omitProfDeps) (toList hcs)
docDependencies _ = return []
buildDependencies :: (Monad m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations
buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) =
use (A.debInfo . D.omitProfVersionDeps) >>= \ omitProfDeps ->
concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges omitProfDeps) (toList hcTypePairs)
buildDependencies _ dep@(ExtraLibs _) =
do mp <- use (A.debInfo . D.execMap)
return $ concat $ adapt mp dep
buildDependencies _ dep =
case unboxDependency dep of
Just (Dependency _name _ranges) ->
do mp <- get >>= return . view (A.debInfo . D.execMap)
return $ concat $ adapt mp dep
Nothing ->
return []
adapt :: Map.Map String Relations -> Dependency_ -> [Relations]
adapt mp (PkgConfigDepends (Dependency (PackageName pkg) _)) =
maybe (aptFile pkg) (: []) (Map.lookup pkg mp)
adapt mp (BuildTools (Dependency (PackageName pkg) _)) =
maybe (aptFile pkg) (: []) (Map.lookup pkg mp)
adapt _flags (ExtraLibs x) = [x]
adapt _flags (BuildDepends (Dependency (PackageName pkg) _)) = [[[D.Rel (D.BinPkgName pkg) Nothing Nothing]]]
aptFile :: String -> [Relations]
aptFile pkg = unsafePerformIO $
findExecutable "apt-file" >>= aptFile'
where
aptFile' Nothing = error "The apt-file executable could not be found."
aptFile' (Just aptfile) = do
ret <- readProcessWithExitCode aptfile ["-l", "search", pkg ++ ".pc"] ""
return $ case ret of
(ExitSuccess, out, _) ->
case takeWhile (not . isSpace) out of
"" -> error $ "Unable to locate a debian package containing the build tool " ++ pkg ++
", try using --exec-map " ++ pkg ++ "=<debname> or execMap " ++ show pkg ++
" [[Rel (BinPkgName \"<debname>\") Nothing Nothing]]"
s -> [[[D.Rel (D.BinPkgName s) Nothing Nothing]]]
_ -> []
anyrel :: String -> [D.Relation]
anyrel x = anyrel' (D.BinPkgName x)
anyrel' :: D.BinPkgName -> [D.Relation]
anyrel' x = [D.Rel x Nothing Nothing]
dependencies :: Monad m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations
dependencies hc typ name cabalRange omitProfVersionDeps =
do nameMap <- use A.debianNameMap
let alts :: [(BinPkgName, VersionRange)]
alts = case Map.lookup name nameMap of
Nothing -> [(mkPkgName hc name typ, cabalRange')]
Just splits' -> List.map (\ (n, r) -> (mkPkgName' hc typ n, r)) (packageRangesFromVersionSplits splits')
mapM convert alts >>= mapM (doBundled typ name hc) . convert' . canonical . Or . catMaybes
where
convert (dname, range) =
case isNoVersion range''' of
True -> return Nothing
False ->
foldVersionRange'
(return $ Rel' (D.Rel dname Nothing Nothing))
(\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.EEQ dv)) Nothing))
(\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SGR dv)) Nothing))
(\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SLT dv)) Nothing))
(\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.GRE dv)) Nothing))
(\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.LTE dv)) Nothing))
(\ 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)])
(\ x y -> x >>= \ x' -> y >>= \ y' -> return $ Or [x', y'])
(\ x y -> x >>= \ x' -> y >>= \ y' -> return $ And [x', y'])
id
range''' >>= return . Just
where
range''' = canon (simpler range' range'')
range'' = canon (unionVersionRanges range' (invertVersionRange range))
range' = intersectVersionRanges cabalRange' range
cabalRange' | typ `elem` noVersionPackageType = anyVersion
| otherwise = foldVersionRange'
anyVersion
withinVersion
laterVersion
earlierVersion
orLaterVersion
orEarlierVersion
(\ lb ub -> intersectVersionRanges (orLaterVersion lb) (earlierVersion ub))
unionVersionRanges
intersectVersionRanges
id
cabalRange
noVersionPackageType = (if omitProfVersionDeps then [B.Profiling] else []) ++ [B.Documentation]
simpler v1 v2 = minimumBy (compare `on` (length . asVersionIntervals)) [v1, v2]
canon = fromVersionIntervals . toVersionIntervals
doBundled :: Monad m =>
B.PackageType
-> PackageName
-> CompilerFlavor
-> [D.Relation]
-> CabalT m [D.Relation]
doBundled typ name hc rels =
mapM doRel rels >>= return . concat
where
comp = D.Rel (compilerPackageName hc typ) Nothing Nothing
doRel :: Monad m => D.Relation -> CabalT m [D.Relation]
doRel rel@(D.Rel dname req _) = do
splits <- use A.debianNameMap
root <- use (A.debInfo . D.flags . buildEnv) >>= return . dependOS
atoms <- get
let pver = maybe Nothing (Just . debianVersion'' atoms name) (builtIn splits hc root name)
let naiveDebianName = mkPkgName hc name typ
let compilerDependency = if isJust pver && (checkVersionReq req pver || (dname == naiveDebianName && conflictsWithHC naiveDebianName)) then [comp] else []
let libraryDependency = if isNothing pver || dname /= naiveDebianName || not (conflictsWithHC naiveDebianName) then [rel] else []
return $ case req of
Just (D.SLT lver) | Just lver < pver -> compilerDependency ++ libraryDependency
Just (D.LTE lver) | Just lver < pver -> compilerDependency ++ libraryDependency
Just (D.EEQ lver) | Just lver < pver -> compilerDependency ++ libraryDependency
_ -> libraryDependency ++ compilerDependency
conflictsWithHC (BinPkgName "libghc-cabal-dev") = False
conflictsWithHC (BinPkgName "libghc-cabal-prof") = False
conflictsWithHC (BinPkgName "libghc-cabal-doc") = False
conflictsWithHC _ = True
debianVersion' :: Monad m => PackageName -> Version -> CabalT m DebianVersion
debianVersion' name v =
do atoms <- get
return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (view A.epochMap atoms)) ++ showVersion v)
debianVersion'' :: CabalInfo -> PackageName -> Version -> DebianVersion
debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (view A.epochMap atoms)) ++ showVersion v)
data Rels a = And {unAnd :: [Rels a]} | Or {unOr :: [Rels a]} | Rel' {unRel :: a} deriving Show
convert' :: Rels a -> [[a]]
convert' = List.map (List.map unRel . unOr) . unAnd . canonical
canonical :: Rels a -> Rels a
canonical (Rel' rel) = And [Or [Rel' rel]]
canonical (And rels) = And $ concatMap (unAnd . canonical) rels
canonical (Or rels) = And . List.map Or $ sequence $ List.map (concat . List.map unOr . unAnd . canonical) $ rels
filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]]
filterMissing rels =
get >>= \ atoms -> return $
List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (view (A.debInfo . D.missingDependencies) atoms)))) rels)