module Distribution.Package.Debian
( debian
) where
import Control.Exception (SomeException, try, bracket)
import Control.Monad (when,mplus)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char (toLower, isSpace)
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Data.Version (showVersion)
import Debian.Control
import qualified Debian.Relation as D
import Debian.Release (parseReleaseName)
import Debian.Changes (ChangeLogEntry(..), prettyEntry)
import Debian.Time (getCurrentLocalRFC822Time)
import Debian.Version
import Debian.Version.String
import System.Cmd (system)
import System.Directory
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
import System.Posix.Files (setFileCreationMask)
import System.Unix.Process
import System.Environment
import Distribution.Text (display)
import Distribution.Simple.Compiler (CompilerFlavor(..), compilerFlavor, Compiler(..))
import Distribution.System (Platform(..), buildOS, buildArch)
import Distribution.License (License(..))
import Distribution.Package (Package(..), PackageIdentifier(..), PackageName(..), Dependency(..))
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Simple.Configure (configCompiler, maybeGetPersistBuildConfig)
import Distribution.Simple.InstallDirs (InstallDirs(..), InstallDirTemplates, toPathTemplate)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.PackageIndex (PackageIndex,fromList)
import Distribution.Simple.Utils (die, setupMessage)
import Distribution.PackageDescription (GenericPackageDescription(..),
PackageDescription(..),
allBuildInfo, buildTools, pkgconfigDepends,
exeName)
import Distribution.PackageDescription.Configuration (finalizePackageDescription)
import Distribution.ParseUtils (parseQuoted)
import Distribution.Verbosity (Verbosity)
import Distribution.Version (VersionRange(..))
import Distribution.Simple.Setup (defaultDistPref)
import Distribution.Package.Debian.Setup (Flags(..), DebAction(..), DebType(..))
import Distribution.Package.Debian.Bundled
import qualified Distribution.Compat.ReadP as ReadP
import Distribution.Text ( Text(parse) )
import Text.PrettyPrint.HughesPJ
parsePackageId' :: ReadP.ReadP PackageIdentifier PackageIdentifier
parsePackageId' = parseQuoted parse ReadP.<++ parse
type DebMap = Map.Map String (Maybe DebianVersion)
buildDebVersionMap :: IO DebMap
buildDebVersionMap =
readFile "/var/lib/dpkg/status" >>=
return . either (const []) unControl . parseControl "/var/lib/dpkg/status" >>=
mapM (\ p -> case (lookupP "Package" p, lookupP "Version" p) of
(Just (Field (_, name)), Just (Field (_, version))) ->
return (Just (stripWS name, Just (parseDebianVersion (stripWS version))))
_ -> return Nothing) >>=
return . Map.fromList . catMaybes
m ! k =
maybe (error ("No version number for " ++ show k ++ " in " ++ show m)) id (Map.findWithDefault Nothing k m)
trim = dropWhile isSpace
simplePackageDescription :: GenericPackageDescription -> Flags
-> IO (Compiler, PackageDescription)
simplePackageDescription genPkgDesc flags = do
(compiler, _) <- configCompiler (Just (rpmCompiler flags)) Nothing Nothing
defaultProgramConfiguration
(rpmVerbosity flags)
case finalizePackageDescription (rpmConfigurationsFlags flags)
(const True) (Platform buildArch buildOS) (compilerId compiler)
[] genPkgDesc of
Left e -> die $ "finalize failed: " ++ show e
Right (pd, _) -> return (compiler, pd)
debian :: GenericPackageDescription
-> Flags
-> IO ()
debian genPkgDesc flags =
case rpmCompiler flags of
GHC ->
do (compiler, pkgDesc) <- simplePackageDescription genPkgDesc flags
let verbose = rpmVerbosity flags
createDirectoryIfMissing True (debOutputDir flags)
debVersions <- buildDebVersionMap
cabalPackages <- libPaths compiler debVersions >>= return . Map.fromList . map (\ p -> (cabalName p, p))
bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do
autoreconf verbose pkgDesc
case debAction flags of
SubstVar name ->
do control <- readFile "debian/control" >>= either (error . show) return . parseControl "debian/control"
substvars pkgDesc compiler debVersions control cabalPackages name
Debianize ->
debianize True pkgDesc flags compiler (debOutputDir flags)
UpdateDebianization ->
updateDebianization True pkgDesc flags compiler (debOutputDir flags)
c -> die ("the " ++ show c ++ " compiler is not yet supported")
autoreconf :: Verbosity -> PackageDescription -> IO ()
autoreconf verbose pkgDesc = do
ac <- doesFileExist "configure.ac"
when ac $ do
c <- doesFileExist "configure"
when (not c) $ do
setupMessage verbose "Running autoreconf" (packageId pkgDesc)
ret <- system "autoreconf"
case ret of
ExitSuccess -> return ()
ExitFailure n -> die ("autoreconf failed with status " ++ show n)
data PackageInfo = PackageInfo { libDir :: FilePath
, cabalName :: String
, cabalVersion :: String
, devDeb :: Maybe (String, DebianVersion)
, profDeb :: Maybe (String, DebianVersion)
, docDeb :: Maybe (String, DebianVersion) }
substvars :: PackageDescription
-> Compiler
-> DebMap
-> Control
-> Map.Map String PackageInfo
-> DebType
-> IO ()
substvars pkgDesc _compiler _debVersions control cabalPackages debType =
case (missingBuildDeps, path) of
([], Just path') ->
do old <- try (readFile path') >>= return . either (\ (_ :: SomeException) -> "") id
let new = addDeps old
hPutStrLn stderr (if new /= old
then ("cabal-debian - Updated " ++ show path' ++ ":\n " ++ old ++ "\n ->\n " ++ new)
else ("cabal-debian - No updates found for " ++ show path'))
maybe (return ()) (\ _x -> replaceFile path' new) name
([], Nothing) -> return ()
(missing, _) ->
die ("These debian packages need to be added to the build dependency list so the required cabal packages are available:\n " ++ intercalate "\n " (map fst missing) ++
"\nIf this is an obsolete package you may need to withdraw the old versions from the\n" ++
"upstream repository, and uninstall and purge it from your local system.")
where
addDeps old =
case partition (isPrefixOf "haskell:Depends=") (lines old) of
([], other) -> unlines (("haskell:Depends=" ++ showDeps deps) : other)
(hdeps, more) ->
case deps of
[] -> unlines (hdeps ++ more)
_ -> unlines (map (++ (", " ++ showDeps deps)) hdeps ++ more)
path = maybe Nothing (\ x -> Just ("debian/" ++ x ++ ".substvars")) name
name = case debType of Dev -> devDebName; Prof -> profDebName; Doc -> docDebName
deps = case debType of Dev -> devDeps; Prof -> profDeps; Doc -> docDeps
missingBuildDeps =
let requiredDebs =
concat (map (\ (Dependency (PackageName name) _) ->
case Map.lookup name cabalPackages :: Maybe PackageInfo of
Just info ->
let prof = maybe (devDeb info) Just (profDeb info) in
let doc = docDeb info in
catMaybes [prof, doc]
Nothing -> []) cabalDeps) in
filter (not . (`elem` buildDepNames) . fst) requiredDebs
devDeps :: D.Relations
devDeps =
catMaybes (map (\ (Dependency (PackageName name) _) ->
case Map.lookup name cabalPackages :: Maybe PackageInfo of
Just package -> maybe Nothing (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing]) (devDeb package)
Nothing -> Nothing) cabalDeps)
profDeps :: D.Relations
profDeps =
maybe [] (\ name -> [[D.Rel name Nothing Nothing]]) devDebName ++
catMaybes (map (\ (Dependency (PackageName name) _) ->
case Map.lookup name cabalPackages :: Maybe PackageInfo of
Just package -> maybe Nothing (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing]) (profDeb package)
Nothing -> Nothing) cabalDeps)
docDeps :: D.Relations
docDeps =
catMaybes (map (\ (Dependency (PackageName name) _) ->
case Map.lookup name cabalPackages :: Maybe PackageInfo of
Just package -> maybe Nothing (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing]) (docDeb package)
Nothing -> Nothing) cabalDeps)
cabalDeps :: [Dependency]
cabalDeps = allBuildDepends pkgDesc
buildDepNames :: [String]
buildDepNames = concat (map (map (\ (D.Rel s _ _) -> s)) buildDeps)
buildDeps :: D.Relations
buildDeps = (either (error . show) id . D.parseRelations $ bd) ++ (either (error . show) id . D.parseRelations $ bdi)
devDebName = listToMaybe (filter (isSuffixOf "-dev") debNames)
profDebName = listToMaybe (filter (isSuffixOf "-prof") debNames)
docDebName = listToMaybe (filter (isSuffixOf "-doc") debNames)
debNames = map (\ (Field (_, s)) -> stripWS s) (catMaybes (map (lookupP "Package") (tail (unControl control))))
bd = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends" . head . unControl $ control
bdi = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends-Indep" . head . unControl $ control
replaceFile :: FilePath -> String -> IO ()
replaceFile path text =
try (removeFile back >>
renameFile path back >>
writeFile path text) >>=
either (\ (e :: SomeException) -> error ("writeFile " ++ show path ++ ": " ++ show e)) return
where
back = path ++ "~"
libPaths :: Compiler -> DebMap -> IO [PackageInfo]
libPaths compiler debVersions
| compilerFlavor compiler == GHC =
do a <- getDirPaths "/usr/lib"
b <- getDirPaths "/usr/lib/haskell-packages/ghc6/lib"
mapM (packageInfo compiler debVersions) (a ++ b) >>= return . catMaybes
| True = error $ "Can't handle compiler flavor: " ++ show (compilerFlavor compiler)
where
getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (\ (_ :: SomeException) -> []) id
packageInfo :: Compiler -> DebMap -> (FilePath, String) -> IO (Maybe PackageInfo)
packageInfo compiler debVersions (d, f) =
case parseNameVersion f of
Nothing -> return Nothing
Just (p, v) -> doesDirectoryExist (d </> f </> cdir) >>= cond (return Nothing) (info (d, p, v))
where
cdir = display (compilerId compiler)
info (d, p, v) =
do dev <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ ".a$")
prof <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ "_p.a$")
doc <- debOfFile ("/" ++ p ++ ".haddock$")
return (Just (PackageInfo { libDir = d
, cabalName = p
, cabalVersion = v
, devDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) dev
, profDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) prof
, docDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) doc }))
parseNameVersion s =
case (break (== '-') (reverse s)) of
(_a, "") -> Nothing
(a, b) -> Just (reverse (tail b), reverse a)
debOfFile :: FilePath -> IO (Maybe String)
debOfFile s =
do (out, _err, code) <- lazyCommand cmd L.empty >>= return . collectOutputUnpacked
case code of
[ExitSuccess] -> return (takePackageName out)
_ -> return Nothing
where
cmd = "cd /var/lib/dpkg/info && grep '" ++ s ++ "' *.list"
takePackageName :: String -> Maybe String
takePackageName s =
f "" s
where
f name ('.':'l':'i':'s':'t':':':_) = Just (reverse name)
f name (x : xs) = f (x : name) xs
f _ [] = Nothing
cond ifF _ifT False = ifF
cond _ifF ifT True = ifT
debianize force pkgDesc flags compiler tgtPfx =
mapM_ removeIfExists ["debian/control", "debian/changelog"] >>
updateDebianization force pkgDesc flags compiler tgtPfx
removeFileIfExists x = doesFileExist x >>= (`when` (removeFile x))
removeDirectoryIfExists x = doesDirectoryExist x >>= (`when` (removeDirectory x))
removeIfExists x = removeFileIfExists x >> removeDirectoryIfExists x
updateDebianization :: Bool
-> PackageDescription
-> Flags
-> Compiler
-> FilePath
-> IO ()
updateDebianization _force pkgDesc flags compiler tgtPfx =
do createDirectoryIfMissing True "debian"
date <- getCurrentLocalRFC822Time
copyright <- try (readFile (licenseFile pkgDesc)) >>=
return . either (\ (_ :: SomeException) -> showLicense . license $ pkgDesc) id
debianMaintainer <- getDebianMaintainer flags >>= maybe (error "Missing value for --maintainer") return
controlUpdate (tgtPfx </> "control") flags compiler debianMaintainer pkgDesc
changelogUpdate (tgtPfx </> "changelog") debianMaintainer pkgDesc date
writeFile (tgtPfx </> "rules") (cdbsRules pkgDesc)
getPermissions "debian/rules" >>= setPermissions "debian/rules" . (\ p -> p {executable = True})
writeFile (tgtPfx </> "compat") "7"
writeFile (tgtPfx </> "copyright") copyright
return ()
getDebianMaintainer :: Flags -> IO (Maybe String)
getDebianMaintainer flags =
case debMaintainer flags of
Nothing -> envMaintainer
maint -> return maint
where
envMaintainer :: IO (Maybe String)
envMaintainer =
do env <- getEnvironment
return $ do fullname <- lookup "DEBFULLNAME" env `mplus` lookup "NAME" env
email <- lookup "DEBEMAIL" env `mplus` lookup "EMAIL" env
return (fullname ++ " <" ++ email ++ ">")
cdbsRules :: PackageDescription -> String
cdbsRules pkgDesc =
unlines (intercalate [""] ([header] ++ [comments] ))
where
header =
["#!/usr/bin/make -f",
"include /usr/share/cdbs/1/rules/debhelper.mk",
"include /usr/share/cdbs/1/class/hlibrary.mk"]
comments =
["# How to install an extra file into the documentation package",
"#binary-fixup/libghc6-" ++ libName ++ "-doc::",
"#\techo \"Some informative text\" > debian/libghc6-" ++ libName ++ "-doc/usr/share/doc/libghc6-" ++ libName ++ "-doc/AnExtraDocFile"]
libName = unPackageName . pkgName . package $ pkgDesc
list :: b -> ([a] -> b) -> [a] -> b
list d f l = case l of [] -> d; _ -> f l
controlUpdate :: FilePath -> Flags -> Compiler -> String -> PackageDescription -> IO ()
controlUpdate path flags compiler debianMaintainer pkgDesc =
builtIns compiler >>= \bundled ->
try (readFile path) >>=
either (\ (_ :: SomeException) -> writeFile path (show (newCtl bundled))) (\ s -> writeFile (path ++ ".new") $! show (merge (newCtl bundled) (oldCtl s)))
where
newCtl bundled = control flags bundled compiler debianMaintainer pkgDesc
oldCtl s = either (const (Control [])) id (parseControl "debian/control" s)
merge (Control new) (Control old) =
case (new, old) of
(_newSource : _new', []) -> Control new
(newSource : new', oldSource : old') ->
Control (mergeParagraphs newSource oldSource : mergeOther new' old')
mergeOther new old =
map mergePackages allNames
where
mergePackages name =
case (findPackage name new, findPackage name old) of
(Just x, Nothing) -> x
(Nothing, Just x) -> x
(Just x, Just y) -> mergeParagraphs x y
findPackage name paras = listToMaybe (filter (hasName name) paras)
where hasName name para = lookupP "Package" para == Just name
allNames = newNames ++ (oldNames \\ newNames)
newNames = catMaybes $ map (lookupP "Package") new
oldNames = catMaybes $ map (lookupP "Package") old
mergeParagraphs new@(Paragraph newFields) old@(Paragraph oldFields) =
Paragraph (map mergeField fieldNames)
where
fieldNames = map fieldName oldFields ++ (map fieldName newFields \\ map fieldName oldFields)
fieldName (Field (name, _)) = name
mergeField :: String -> Field
mergeField name =
case (lookupP name new, lookupP name old) of
(Just (Field (_, x)), Nothing) -> Field (name, x)
(Nothing, Just (Field (_, x))) -> Field (name, x)
(Just (Field (_, x)), Just (Field (_, y))) -> Field (name, mergeValues name x y)
_ -> error $ "Internal error"
mergeValues :: String -> String -> String -> String
mergeValues "Build-Depends" x y =
" " ++ (showDeps' "Build-Depends:" $ mergeDeps (parseDeps x) (parseDeps y))
mergeValues "Depends" x y =
" " ++ (showDeps' "Depends:" $ mergeDeps (parseDeps x) (parseDeps y))
mergeValues _ x _ = x
parseDeps s = either (error . show) id (D.parseRelations s)
mergeDeps :: D.Relations -> D.Relations -> D.Relations
mergeDeps x y =
nub $ foldr insertDep x y
where
insertDep :: [D.Relation] -> D.Relations -> D.Relations
insertDep ys xss =
case depPackageNames ys of
[name] -> case break (\ xs -> depPackageNames xs == [name]) xss of
(a, b : c) -> a ++ [b, ys] ++ c
(a, []) -> a ++ [ys]
_ -> xss ++ [ys]
depPackageNames xs = nub (map depPackageName xs)
depPackageName (D.Rel x _ _) = x
control :: Flags -> [Bundled] -> Compiler -> String -> PackageDescription -> Control
control flags bundled compiler debianMaintainer pkgDesc =
Control {unControl =
([sourceSpec] ++
develLibrarySpecs ++
profileLibrarySpecs ++
docLibrarySpecs ++
map executableSpec (executables pkgDesc))}
where
sourceSpec =
Paragraph
([Field ("Source", " " ++ debianSourcePackageName pkgDesc),
Field ("Priority", " " ++ "optional"),
Field ("Section", " " ++ "misc"),
Field ("Maintainer", " " ++ debianMaintainer),
Field ("Build-Depends", " " ++ showDeps' "Build-Depends:" debianBuildDeps),
Field ("Build-Depends-Indep", " " ++ showDeps' "Build-Depends-Indep:" debianBuildDepsIndep),
Field ("Standards-Version", " " ++ "3.8.1")] ++
list [] (\ s -> [Field ("Homepage", " " ++ s)]) (homepage pkgDesc))
executableSpec executable =
Paragraph
[Field ("Package", " " ++ map toLower (exeName executable)),
Field ("Architecture", " " ++ "any"),
Field ("Section", " " ++ "misc"),
Field ("Depends", " " ++ showDeps [[D.Rel "${shlibs:Depends}" Nothing Nothing],
[D.Rel "${haskell:Depends}" Nothing Nothing],
[D.Rel "${misc:Depends}" Nothing Nothing]]),
Field ("Description", " " ++ maybe debianDescription (const executableDescription) (library pkgDesc))]
develLibrarySpecs = if isJust (library pkgDesc) then [librarySpec "any" "-dev"] else []
profileLibrarySpecs = if debLibProf flags && isJust (library pkgDesc) then [librarySpec "any" "-prof"] else []
docLibrarySpecs = if isJust (library pkgDesc) then [docSpecsParagraph] else []
docSpecsParagraph =
Paragraph
[Field ("Package", " " ++ debianDocumentationPackageName (unPackageName . pkgName . package $ pkgDesc)),
Field ("Architecture", " " ++ "all"),
Field ("Section", " " ++ "doc"),
Field ("Depends", " " ++ showDeps' "Depends:" ([[D.Rel "${haskell:Depends}" Nothing Nothing],
[D.Rel "${misc:Depends}" Nothing Nothing]] ++ libraryDependencies "-doc")),
Field ("Description", " " ++ libraryDescription "-doc")]
librarySpec arch suffix =
Paragraph
[Field ("Package", " " ++ prefix ++ map toLower (unPackageName . pkgName . package $ pkgDesc) ++ suffix),
Field ("Architecture", " " ++ arch),
Field ("Section", " " ++ "haskell"),
Field ("Depends", " " ++ showDeps' "Depends:" ([[D.Rel "${haskell:Depends}" Nothing Nothing],
[D.Rel "${misc:Depends}" Nothing Nothing]] ++ libraryDependencies suffix)),
Field ("Description", " " ++ libraryDescription suffix)]
where prefix = case suffix of
"-dev" -> "libghc6-"
"-prof" -> "libghc6-"
_ -> error $ "Unknown suffix: " ++ suffix
libraryDependencies :: String -> D.Relations
libraryDependencies "-dev" = []
libraryDependencies "-prof" = [[D.Rel (debianDevelPackageName (unPackageName . pkgName . package $ pkgDesc)) Nothing Nothing]]
libraryDependencies "-doc" = [[D.Rel "ghc6-doc" Nothing Nothing]]
libraryDependencies suffix = error $ "Unexpected library package name suffix: " ++ show suffix
debianBuildDeps :: D.Relations
debianBuildDeps =
nub $
[[D.Rel "debhelper" (Just (D.GRE (parseDebianVersion "7.0"))) Nothing],
[D.Rel "haskell-devscripts" (Just (D.GRE (parseDebianVersion "0.6.15+nmu7"))) Nothing],
[D.Rel "hscolour" Nothing Nothing],
[D.Rel "cdbs" Nothing Nothing],
[D.Rel "ghc6" (Just (D.GRE (parseDebianVersion "6.8"))) Nothing]] ++
(if debLibProf flags then [[D.Rel "ghc6-prof" Nothing Nothing]] else []) ++
(concat . map (debianDependencies bundled compiler buildDependencies) . allBuildDepends $ pkgDesc)
debianBuildDepsIndep :: D.Relations
debianBuildDepsIndep =
nub $
[[D.Rel "ghc6-doc" Nothing Nothing],
[D.Rel "haddock" Nothing Nothing]] ++
(concat . map (debianDependencies bundled compiler docDependencies) . allBuildDepends $ pkgDesc)
debianDescription =
(synopsis pkgDesc) ++
case description pkgDesc of
"" -> ""
text ->
let text' = text ++ "\n" ++
list "" ("\n Author: " ++) (author pkgDesc) ++
list "" ("\n Upstream-Maintainer: " ++) (maintainer pkgDesc) ++
list "" ("\n Url: " ++) (pkgUrl pkgDesc) in
"\n " ++ (trim . intercalate "\n " . map addDot . lines $ text')
addDot line = if all (flip elem " \t") line then "." else line
executableDescription = " " ++ "An executable built with the " ++ display (package pkgDesc) ++ " library."
libraryDescription "-prof" = debianDescription ++ "\n .\n This package contains the libraries compiled with profiling enabled."
libraryDescription "-dev" = debianDescription ++ "\n .\n This package contains the normal library files."
libraryDescription "-doc" = debianDescription ++ "\n .\n This package contains the documentation files."
libraryDescription x = error $ "Unexpected library package name suffix: " ++ show x
showDeps xss = intercalate ", " (map (intercalate " | " . map show) xss)
showDeps' prefix xss =
intercalate (",\n " ++ prefix') (map (intercalate " | " . map show) xss)
where prefix' = map (\ _ -> ' ') prefix
allBuildDepends pkgDesc =
nub $ buildDepends pkgDesc ++
concat (map buildTools (allBuildInfo pkgDesc) ++
map pkgconfigDepends (allBuildInfo pkgDesc))
debianDependencies :: [Bundled] -> Compiler -> (Compiler -> Dependency -> D.Relations) -> Dependency -> D.Relations
debianDependencies bundled compiler toDebRels dep | isBundled bundled compiler dep = []
debianDependencies _ compiler toDebRels dep = toDebRels compiler dep
changelogUpdate :: FilePath -> String -> PackageDescription -> String -> IO ()
changelogUpdate path debianMaintainer pkgDesc date =
try (readFile path) >>= either (\ (_ :: SomeException) -> writeFile path log) (const (writeFile (path ++ ".new") log))
where
log = changelog debianMaintainer pkgDesc date
changelog :: String -> PackageDescription -> String -> String
changelog debianMaintainer pkgDesc date =
render (prettyEntry
(Entry { logPackage = debianSourcePackageName pkgDesc
, logVersion = debianVersionNumber pkgDesc
, logDists = [parseReleaseName "unstable"]
, logUrgency = "low"
, logComments = " * Debianization generated by cabal-debian\n\n"
, logWho = debianMaintainer
, logDate = date }))
unPackageName :: PackageName -> String
unPackageName (PackageName s) = s
debianSourcePackageName :: PackageDescription -> String
debianSourcePackageName pkgDesc = "haskell-" ++ map toLower (unPackageName . pkgName . package $ pkgDesc)
debianProfilingPackageName :: String -> String
debianProfilingPackageName x = "libghc6-" ++ map toLower x ++ "-prof"
debianDevelPackageName :: String -> String
debianDevelPackageName x = "libghc6-" ++ map toLower x ++ "-dev"
debianVersionNumber :: PackageDescription -> DebianVersion
debianVersionNumber pkgDesc = parseDebianVersion . showVersion . pkgVersion . package $ pkgDesc
profilingDependencies :: Compiler -> Dependency -> D.Relations
profilingDependencies compiler dep@(Dependency (PackageName name) ranges) =
concat (map (\ x -> debianRelations x ranges) names)
where names = if isLibrary compiler dep then [debianProfilingPackageName name] else []
develDependencies :: Compiler -> Dependency -> D.Relations
develDependencies compiler dep@(Dependency (PackageName name) ranges) =
concat (map (\ x -> debianRelations x ranges) names)
where names = if isLibrary compiler dep then [debianDevelPackageName name] else []
buildDependencies :: Compiler -> Dependency -> D.Relations
buildDependencies compiler dep@(Dependency (PackageName name) ranges) =
concat (map (\ x -> debianRelations x ranges) names)
where names = if isLibrary compiler dep
then [ debianProfilingPackageName name
] else [name]
docDependencies :: Compiler -> Dependency -> D.Relations
docDependencies compiler dep@(Dependency (PackageName name) ranges) =
concat (map (\ x -> debianRelations x ranges) names)
where names = if isLibrary compiler dep then [debianDocumentationPackageName name] else []
debianRelations :: String -> VersionRange -> D.Relations
debianRelations name range =
map (merge . map (relation name)) (canon range)
where
canon :: VersionRange -> [[VersionRange]]
canon (IntersectVersionRanges a b) = canon a ++ canon b
canon (UnionVersionRanges a b) = map concat (cartesianProduct [canon a, canon b])
canon x = [[x]]
relation name AnyVersion = D.Rel name Nothing Nothing
relation name (ThisVersion version) = D.Rel name (Just (D.EEQ (parseDebianVersion (showVersion version)))) Nothing
relation name (EarlierVersion version) = D.Rel name (Just (D.SLT (parseDebianVersion (showVersion version)))) Nothing
relation name (LaterVersion version) = D.Rel name (Just (D.SGR (parseDebianVersion (showVersion version)))) Nothing
relation _ _ = error $ "Invalid argument to debianRelations: " ++ show range
merge (D.Rel name1 (Just (D.EEQ ver1)) arch1 : D.Rel name2 (Just (D.SLT ver2)) arch2 : xs)
| name1 == name2 && ver1 == ver2 && arch1 == arch2
= merge (D.Rel name1 (Just (D.LTE ver1)) arch1 : xs)
merge (D.Rel name1 (Just (D.EEQ ver1)) arch1 : D.Rel name2 (Just (D.SGR ver2)) arch2 : xs)
| name1 == name2 && ver1 == ver2 && arch1 == arch2
= merge (D.Rel name1 (Just (D.GRE ver1)) arch1 : xs)
merge (x : xs) = x : merge xs
merge [] = []
debianDocumentationPackageName :: String -> String
debianDocumentationPackageName x =
docPrefix (map toLower x) ++ map toLower x ++ "-doc"
cartesianProduct :: [[a]] -> [[a]]
cartesianProduct = sequence
showLicense :: License -> String
showLicense (GPL _) = "GPL"
showLicense (LGPL _) = "LGPL"
showLicense BSD3 = "BSD"
showLicense BSD4 = "BSD-like"
showLicense PublicDomain = "Public Domain"
showLicense AllRightsReserved = "Proprietary"
showLicense OtherLicense = "Non-distributable"