module Debian.Debianize.BuildDependencies
( debianBuildDeps
, debianBuildDepsIndep
) where
import Control.Monad.State (MonadState(get))
import Control.Monad.Trans (MonadIO)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Lens.Lazy (access, getL)
import Data.List as List (filter, map, minimumBy, nub)
import Data.Map as Map (lookup, Map)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import qualified Data.Set as Set (member)
import Data.Version (showVersion, Version)
import Debian.Debianize.Bundled (builtIn)
import Debian.Debianize.DebianName (mkPkgName, mkPkgName')
import Debian.Debianize.Monad as Monad (Atoms, DebT)
import qualified Debian.Debianize.Types as T (buildDepends, buildDependsIndep, debianNameMap, epochMap, execMap, extraLibMap, missingDependencies, noDocumentationLibrary, noProfilingLibrary)
import Debian.Debianize.Types.Atoms (EnvSet(dependOS), compilerFlavor, buildEnv)
import qualified Debian.Debianize.Types.BinaryDebDescription as B (PackageType(Development, Documentation, Profiling))
import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits)
import Debian.Orphans ()
import Debian.Relation (BinPkgName(..), Relation(..), Relations, checkVersionReq)
import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT))
import Debian.Version (DebianVersion, parseDebianVersion)
#if MIN_VERSION_Cabal(1,21,0)
import Distribution.Compiler (CompilerFlavor(GHC, GHCJS))
#else
import Distribution.Compiler (CompilerFlavor(GHC))
#endif
import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))
import Distribution.PackageDescription (PackageDescription)
import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..))
import qualified Distribution.PackageDescription as Cabal (PackageDescription(buildDepends, executables, package))
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.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)
selfDependency :: PackageIdentifier -> Dependency_ -> Bool
selfDependency pkgId (BuildDepends (Dependency name _)) = name == pkgName pkgId
selfDependency _ _ = False
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 => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> DebT 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')]
where
fixDeps :: Atoms -> [String] -> Relations
fixDeps atoms xs =
concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]]
(Map.lookup cab (getL T.extraLibMap atoms))) xs
debianBuildDeps :: MonadIO m => PackageDescription -> DebT m D.Relations
debianBuildDeps pkgDesc =
do deb <- get
cDeps <- cabalDeps
let bDeps = getL T.buildDepends deb
prof = not $ getL T.noProfilingLibrary deb
cfl <- access compilerFlavor
let xs = nub $ [[D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion ("7.0" :: String)))) Nothing],
[D.Rel (D.BinPkgName "haskell-devscripts") (Just (D.GRE (parseDebianVersion ("0.8" :: String)))) Nothing],
anyrel "cdbs"] ++
(case cfl of
GHC -> [anyrel "ghc"] ++ if prof then [anyrel "ghc-prof"] else []
#if MIN_VERSION_Cabal(1,21,0)
GHCJS -> [anyrel "ghcjs"]
#endif
x -> error ("Unsupported compiler flavor: " ++ show x)) ++
bDeps ++
cDeps
filterMissing xs
where
cabalDeps =
do deps <- allBuildDepends
(Cabal.buildDepends pkgDesc ++ concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc))
(concatMap buildTools . allBuildInfo $ pkgDesc)
(concatMap pkgconfigDepends . allBuildInfo $ pkgDesc)
(concatMap extraLibs . allBuildInfo $ pkgDesc)
mapM buildDependencies (List.filter (not . selfDependency (Cabal.package pkgDesc)) deps) >>= return . concat
debianBuildDepsIndep :: MonadIO m => PackageDescription -> DebT m D.Relations
debianBuildDepsIndep pkgDesc =
do doc <- get >>= return . not . getL T.noDocumentationLibrary
bDeps <- get >>= return . getL T.buildDependsIndep
cDeps <- cabalDeps
let xs = if doc
then nub $ [anyrel "ghc-doc"] ++ bDeps ++ concat cDeps
else []
filterMissing xs
where
cabalDeps =
do deps <- allBuildDepends
(Cabal.buildDepends pkgDesc) (concatMap buildTools . allBuildInfo $ pkgDesc)
(concatMap pkgconfigDepends . allBuildInfo $ pkgDesc) (concatMap extraLibs . allBuildInfo $ pkgDesc)
let deps' = List.filter (not . selfDependency (Cabal.package pkgDesc)) deps
mapM docDependencies deps'
docDependencies :: MonadIO m => Dependency_ -> DebT m D.Relations
docDependencies (BuildDepends (Dependency name ranges)) = dependencies B.Documentation name ranges
docDependencies _ = return []
buildDependencies :: MonadIO m => Dependency_ -> DebT m D.Relations
buildDependencies (BuildDepends (Dependency name ranges)) =
do hc <- access compilerFlavor
dev <- dependencies B.Development name ranges
prof <- if hc == GHC then dependencies B.Profiling name ranges else return []
return $ dev ++ prof
buildDependencies dep@(ExtraLibs _) =
do mp <- get >>= return . getL T.execMap
return $ concat $ adapt mp dep
buildDependencies dep =
case unboxDependency dep of
Just (Dependency _name _ranges) ->
do mp <- get >>= return . getL T.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 $
do ret <- readProcessWithExitCode "apt-file" ["-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 :: MonadIO m => B.PackageType -> PackageName -> VersionRange -> DebT m Relations
dependencies typ name cabalRange =
do atoms <- get
hc <- access compilerFlavor
let alts :: [(BinPkgName, VersionRange)]
alts = case Map.lookup name (getL T.debianNameMap atoms) of
Nothing -> [(mkPkgName hc name typ, cabalRange')]
Just splits' -> List.map (\ (n, r) -> (mkPkgName' hc n typ, r)) (packageRangesFromVersionSplits splits')
mapM convert alts >>= mapM (doBundled typ name) . 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' =
foldVersionRange'
anyVersion
withinVersion
laterVersion
earlierVersion
orLaterVersion
orEarlierVersion
(\ lb ub -> intersectVersionRanges (orLaterVersion lb) (earlierVersion ub))
unionVersionRanges
intersectVersionRanges
id
cabalRange
simpler v1 v2 = minimumBy (compare `on` (length . asVersionIntervals)) [v1, v2]
canon = fromVersionIntervals . toVersionIntervals
doBundled :: MonadIO m =>
B.PackageType
-> PackageName
-> [D.Relation]
-> DebT m [D.Relation]
doBundled typ name rels =
mapM doRel rels >>= return . concat
where
comp = D.Rel (compilerPackageName typ) Nothing Nothing
doRel :: MonadIO m => D.Relation -> DebT m [D.Relation]
doRel rel@(D.Rel dname req _) = do
hc <- access compilerFlavor
splits <- access T.debianNameMap
root <- access buildEnv >>= return . dependOS
atoms <- get
let pver = maybe Nothing (Just . debianVersion'' atoms name) (builtIn splits hc root name)
let naiveDebianName = mkPkgName hc name typ
return $
(if isJust pver && (checkVersionReq req pver || (dname == naiveDebianName && conflictsWithHC naiveDebianName)) then [comp] else []) ++
(if isNothing pver || dname /= naiveDebianName || not (conflictsWithHC naiveDebianName) then [rel] else [])
compilerPackageName B.Documentation = D.BinPkgName "ghc-doc"
compilerPackageName B.Profiling = D.BinPkgName "ghc-prof"
compilerPackageName B.Development = D.BinPkgName "ghc"
compilerPackageName _ = D.BinPkgName "ghc"
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 -> DebT m DebianVersion
debianVersion' name v =
do atoms <- get
return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.epochMap atoms)) ++ showVersion v)
debianVersion'' :: Atoms -> PackageName -> Version -> DebianVersion
debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.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]] -> DebT m [[Relation]]
filterMissing rels =
get >>= \ atoms -> return $
List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (getL T.missingDependencies atoms)))) rels)