diff --git a/COPYING b/COPYING deleted file mode 100644 --- a/COPYING +++ /dev/null @@ -1,35 +0,0 @@ -This package was debianized by David Fox - on September 18, 2007. - -Copyright (c) 2007, David Fox -Copyright (c) 2007, Jeremy Shaw - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * The names of contributors may not be used to endorse or promote - products derived from this software without specific prior - written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Debian/GenBuildDeps.hs b/Debian/GenBuildDeps.hs --- a/Debian/GenBuildDeps.hs +++ b/Debian/GenBuildDeps.hs @@ -10,6 +10,7 @@ , RelaxInfo(..) , relaxDeps -- * Using dependency info + , BuildableInfo(..) , buildable , compareSource {- @@ -95,10 +96,63 @@ map fst . filter (maybe True (== source) . snd) $ pairs -- concat . map binaries . catMaybes . map snd . filter (\ (_, x) -> maybe True (== source) x) $ pairs +data BuildableInfo a + = BuildableInfo + { readyTriples :: [(a, [a], [a])] + , allBlocked :: [a] + } + | CycleInfo + { depPairs :: [(a, a)] } + -- |Given an ordering function representing the dependencies on a -- list of packages, return a triple: One ready package, the packages -- that depend on the ready package directly or indirectly, and all -- the other packages. +buildable :: Show a => (a -> a -> Ordering) -> [a] -> BuildableInfo a +buildable cmp packages = + -- Find all packages which can't reach any other packages in the + -- graph of the "has build dependency" relation. + case partition (\ x -> reachable hasDep x == [x]) verts of + -- None of the packages are buildable, return information + -- about how to break this build dependency cycle. + ([], _) -> CycleInfo {depPairs = map ofEdge (cycleEdges hasDep)} + -- We have some buildable packages, return them along with + -- the list of packages each one directly blocks + (allReady@(oneReady : moreReady), blocked) -> + let (deps, other) = partition (\ x -> elem x (reachable isDep oneReady)) blocked in + BuildableInfo + { readyTriples = map (makeTriple blocked allReady) allReady, + allBlocked = map ofVertex blocked } + where + makeTriple blocked ready thisReady = + let otherReady = filter (/= thisReady) ready + (directlyBlocked, otherBlocked) = partition (\ x -> elem x (reachable isDep thisReady)) blocked in + (ofVertex thisReady, map ofVertex directlyBlocked, map ofVertex (otherReady ++ otherBlocked)) + allDeps x = (ofVertex x, map ofVertex (filter (/= x) (reachable hasDep x))) + isDep = buildG (0, length packages - 1) edges' + edges' = map (\ (a, b) -> (b, a)) edges + hasDep = buildG (0, length packages - 1) edges + edges :: [(Int, Int)] + edges = + nub (foldr f [] (tails vertPairs)) + where f [] edges = edges + f (x : xs) edges = catMaybes (map (toEdge x) xs) ++ edges + toEdge (xv, xa) (yv, ya) = + case cmp xa ya of + EQ -> Nothing + LT -> Just (yv, xv) + GT -> Just (xv, yv) + ofEdge (a, b) = (ofVertex a, ofVertex b) + ofVertex n = fromJust (Map.findWithDefault Nothing n (Map.fromList (zip [0..] (map Just packages)))) + verts :: [Int] + verts = map fst vertPairs + vertPairs = zip [0..] packages + +{- +-- |Given an ordering function representing the dependencies on a +-- list of packages, return a triple: One ready package, the packages +-- that depend on the ready package directly or indirectly, and all +-- the other packages. buildable :: Show a => (a -> a -> Ordering) -> [a] -> Either [(a, a)] (a, [a], [a]) buildable cmp packages = case partition (\ x -> reachable hasDep x == [x]) verts of @@ -126,6 +180,7 @@ verts :: [Int] verts = map fst vertPairs vertPairs = zip [0..] packages +-} cycleEdges g = filter (`elem` (edges g)) diff --git a/Debian/Repo/Dependencies.hs b/Debian/Repo/Dependencies.hs --- a/Debian/Repo/Dependencies.hs +++ b/Debian/Repo/Dependencies.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, PatternSignatures #-} +{-# LANGUAGE ScopedTypeVariables, ScopedTypeVariables #-} -- |This dependency solver determines which binary packages to install -- in order to satisfy a set of dependency relations. It uses a brute -- force method, but tweaked to the point where it is usually able to diff --git a/Distribution/Package/Debian.hs b/Distribution/Package/Debian.hs new file mode 100644 --- /dev/null +++ b/Distribution/Package/Debian.hs @@ -0,0 +1,743 @@ +{-# LANGUAGE CPP, TypeSynonymInstances #-} + +-- | +-- Module : Distribution.Package.Debian +-- Copyright : David Fox 2008 +-- +-- Maintainer : David Fox +-- Stability : alpha +-- Portability : portable +-- +-- Explanation: Support for generating Debianization from Cabal data. + +-- This software may be used and distributed according to the terms of +-- the GNU General Public License, incorporated herein by reference. + +module Distribution.Package.Debian + ( debian + ) where + +import Control.Exception (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 (Version(..), showVersion) +import Debian.Control +import qualified Debian.Relation as D +import qualified Debian.Repo as D +import Debian.Time +import Debian.Version +import Debian.Version.String +import qualified Debian.Version as D +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 Text.ParserCombinators.ReadP + +import Distribution.Text (display) +import Distribution.Simple.Compiler (CompilerFlavor(..), compilerFlavor, Compiler(..)) +import Distribution.Simple.Configure (localBuildInfoFile) +import Distribution.System (buildOS, buildArch) +import Distribution.License (License(..)) +import Distribution.Package (Package(..), PackageIdentifier(..), PackageName(..), Dependency(..)) +import Distribution.Simple.Program (defaultProgramConfiguration) +import Distribution.Simple.Configure (configCompiler, configure, maybeGetPersistBuildConfig) +import Distribution.Simple.InstallDirs (InstallDirs(..), InstallDirTemplates(..), toPathTemplate) +import Distribution.Simple.Register (writeInstalledConfig) +import Distribution.Simple.Setup (defaultRegisterFlags) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) +import Distribution.Simple.PackageIndex (PackageIndex(..), fromList) +import Distribution.Simple.Utils (die, setupMessage) +import Distribution.PackageDescription (GenericPackageDescription(..), + PackageDescription(..), + emptyHookedBuildInfo, + allBuildInfo, buildTools, pkgconfigDepends, + exeName, BuildType(..)) +import Distribution.PackageDescription.Configuration (finalizePackageDescription) +import Distribution.ParseUtils (parseQuoted) +import Distribution.Verbosity (Verbosity) +import Distribution.Version (VersionRange(..)) +import Distribution.Simple.Setup (ConfigFlags (..), toFlag, defaultConfigFlags, 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) ) + +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 s = + case matchRegex re s of + Just [x, _, _] -> x + _ -> error $ "Internal error: trim " ++ show s + where + re = mkRegex ("^[ \t\n]*(" ++ trimmed ++ ")[ \t\n]*") + trimmed = "([^ \t\n](.*[^ \t\n])?)?" +-} + +trim = dropWhile isSpace + +-- installedPackages :: Package pkg => IO [PackageIndex pkg] +installedPackages = + do (out, err, code) <- lazyCommand cmd L.empty >>= return . collectOutputUnpacked + case code of + [ExitSuccess] -> return . fromList $ map (last . map fst . ReadP.readP_to_S parsePackageId') (words out) + result -> error $ "Failure: " ++ cmd ++ " -> " ++ show result ++ " (" ++ err ++ ")" + where + cmd = "ghc-pkg list --simple-output" + +simplePackageDescription :: GenericPackageDescription -> Flags + -> IO (Compiler, PackageDescription) +simplePackageDescription genPkgDesc flags = do + (compiler, _) <- configCompiler (Just (rpmCompiler flags)) Nothing Nothing + defaultProgramConfiguration + (rpmVerbosity flags) + installed <- installedPackages + case finalizePackageDescription (rpmConfigurationsFlags flags) + (Just installed) buildOS buildArch (compilerId compiler) [] genPkgDesc of + Left e -> die $ "finalize failed: " ++ show e + Right (pd, _) -> return (compiler, pd) + +debian :: GenericPackageDescription -- ^ info from the .cabal file + -> Flags -- ^ command line flags + -> IO () + +debian genPkgDesc flags = + case rpmCompiler flags of + GHC -> + do (compiler, pkgDesc) <- simplePackageDescription genPkgDesc flags + let verbose = rpmVerbosity flags + createDirectoryIfMissing True (debOutputDir flags) + lbi <- localBuildInfo pkgDesc 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) + +localBuildInfo :: PackageDescription -> Flags -> IO LocalBuildInfo +localBuildInfo pkgDesc flags = + maybeGetPersistBuildConfig defaultDistPref >>= + maybe setup return >>= + writeInstalledConfig' + where + -- Warning - passing the --ghc flag explicitly here probably + -- disables support for other compilers. + setup = system ("runhaskell Setup configure --ghc --prefix " ++ rpmPrefix flags) >> + maybeGetPersistBuildConfig defaultDistPref >>= + return . maybe (error ("Failed to create " ++ defaultDistPref)) id + writeInstalledConfig' lbi = + if isNothing (library pkgDesc) + then error "cabal-debian - Unsupported: package without a library section" + else writeInstalledConfig defaultDistPref pkgDesc lbi False Nothing >> return lbi + +data PackageInfo = PackageInfo { libDir :: FilePath + , cabalName :: String + , cabalVersion :: String + , devDeb :: Maybe (String, DebianVersion) + , profDeb :: Maybe (String, DebianVersion) + , docDeb :: Maybe (String, DebianVersion) } + +-- |Each cabal package corresponds to a directory -, +-- either in /usr/lib or in /usr/lib/haskell-packages/ghc6/lib. +-- In that directory is a compiler subdirectory such as ghc-6.8.2. +-- In the ghc subdirectory is one or two library files of the form +-- libHS-.a and libHS-_p.a. We can +-- determine the debian package names by running dpkg -S on these +-- names, or examining the /var/lib/dpkg/info/\*.list files. From +-- these we can determine the source package name, and from that +-- the documentation package name. +substvars :: PackageDescription -- ^info from the .cabal file + -> Compiler -- ^compiler details + -> DebMap + -> Control -- ^The debian/control file + -> Map.Map String PackageInfo -- ^The list of installed cabal packages + -> DebType -- ^The type of deb we want to write substvars for + -> IO () +substvars pkgDesc compiler debVersions control cabalPackages debType = + case (missingBuildDeps, path) of + -- There should already be a .substvars file produced by dh_haskell_prep, + -- keep the relations listed there. They will contain something like this: + -- libghc6-cabal-debian-prof.substvars: + -- haskell:Depends=ghc6-prof (<< 6.8.2-999), ghc6-prof (>= 6.8.2), libghc6-cabal-debian-dev (= 0.4) + -- libghc6-cabal-debian-dev.substvars: + -- haskell:Depends=ghc6 (<< 6.8.2-999), ghc6 (>= 6.8.2) + -- haskell-cabal-debian-doc.substvars: + -- haskell:Depends=ghc6-doc, haddock (>= 2.1.0), haddock (<< 2.1.0-999) + ([], Just path') -> + do old <- try (readFile path') >>= return . either (const "") 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) + 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 + -- We must have build dependencies on the profiling and documentation packages + -- of all the cabal packages. + 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 + -- Make a list of the debian devel packages corresponding to cabal packages + -- which are build dependencies + devDeps :: D.Relations + devDeps = + catMaybes (map (\ dep@(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 (\ dep@(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 (\ dep@(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) + sourceName = maybe (error "Invalid control file") (\ (Field (_, s)) -> stripWS s) (lookupP "Source" (head (unControl control))) + 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 + +-- |Write a file which we might still be reading from in +-- order to compute the text argument. +replaceFile :: FilePath -> String -> IO () +replaceFile path text = + try (removeFile back) >> -- This may not exist + try (renameFile path back) >> -- This may not exist + try (writeFile path text) >>= -- This must succeed + either (\ e -> 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" + -- Build a map from names of installed debs to version numbers + 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 (const []) 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) + +-- |Given a path, return the name of the package that owns it. +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" + -- We already know here that suff actually is a suffix of s + dropSuffix suff s = take (length s - length suff) s + +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 name [] = Nothing + +-- Determine the documentation package name. Look for .haddock +devToDoc :: Compiler -> String -> IO (Maybe String) +devToDoc compiler name + | compilerFlavor compiler == GHC = + case maybe Nothing (dropSuffix "-dev") (dropPrefix "libghc6-" name) of + Just base -> + do let name1 = "libghc6-" ++ base ++ "-doc" + let name2 = "libghc6-" ++ base ++ "-doc" + exists1 <- doesFileExist ("/var/lib/dpkg/info/" ++ name1 ++ ".list") + case exists1 of + True -> return (Just name1) + False -> + do exists2 <- doesFileExist ("/var/lib/dpkg/info/" ++ name2 ++ ".list") + case exists2 of + True -> return (Just name2) + False -> return Nothing + where + dropSuffix :: String -> String -> Maybe String + dropSuffix suff s = case isSuffixOf suff s of + True -> Just (take (length s - length suff) s) + False -> Nothing + dropPrefix :: String -> String -> Maybe String + dropPrefix pref s = case isPrefixOf pref s of + True -> Just (drop (length pref) s) + False -> 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 -- ^whether to forcibly create file + -> PackageDescription -- ^info from the .cabal file + -> Flags -- ^command line yflags + -> Compiler -- ^compiler details + -> FilePath -- ^directory in which to create files + -> IO () +updateDebianization force pkgDesc flags compiler tgtPfx = + do createDirectoryIfMissing True "debian" + date <- getCurrentLocalRFC822Time + copyright <- try (readFile (licenseFile pkgDesc)) >>= + return . either (const . 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}) + readFile "/usr/lib/haskell-utils/scripts/current/compat" >>= writeFile (tgtPfx "compat") + writeFile (tgtPfx "copyright") copyright + -- The dev postinst and prerm files are generated by haskell-devscripts via cdbs. + return () + +{- +Create a debian maintainer field from the environment variables: + + DEBFULLNAME (preferred) or NAME + DEBEMAIL (preferred) or EMAIL + +More work could be done to match dch, but this is sufficient for +now. Here is what the man page for dch has to say: + + If the environment variable DEBFULLNAME is set, this will be used for + the maintainer full name; if not, then NAME will be checked. If the + environment variable DEBEMAIL is set, this will be used for the email + address. If this variable has the form "name ", then the + maintainer name will also be taken from here if neither DEBFULLNAME + nor NAME is set. If this variable is not set, the same test is + performed on the environment variable EMAIL. Next, if the full name + has still not been determined, then use getpwuid(3) to determine the + name from the pass‐word file. If this fails, use the previous + changelog entry. For the email address, if it has not been set from + DEBEMAIL or EMAIL, then look in /etc/mailname, then attempt to build + it from the username and FQDN, otherwise use the email address in the + previous changelog entry. In other words, it’s a good idea to set + DEBEMAIL and DEBFULLNAME when using this script. + +-} +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] {- ++ devrules ++ profrules -} )) + where + header = + ["#!/usr/bin/make -f", + "include /usr/share/cdbs/1/rules/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"] + devrules = + case (library pkgDesc, executables pkgDesc) of + (_, []) -> [] + (_, execs) -> + [["binary-fixup/" ++ (debianDevelPackageName libName) ++ "::"] ++ + concat (map (\ exec -> ["\tmkdir -p debian/" ++ exeName exec ++ "/usr/bin", + "\tmv debian/" ++ (debianDevelPackageName libName) ++ + "/usr/lib/haskell-packages/ghc6/bin/" ++ exeName exec ++ + " debian/" ++ exeName exec ++ "/usr/bin"]) (executables pkgDesc))] + profrules = + case (library pkgDesc, executables pkgDesc) of + (_, []) -> [] + (_, execs) -> + [["binary-fixup/" ++ (debianProfilingPackageName libName) ++ "::"] ++ + map (\ exec -> "\trm debian/" ++ (debianProfilingPackageName libName) ++ + "/usr/lib/haskell-packages/ghc6/bin/" ++ exeName exec) (executables pkgDesc)] + 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 = + try (readFile path) >>= + either (\ _ -> writeFile path (show newCtl)) (\ s -> writeFile (path ++ ".new") $! show (merge newCtl (oldCtl s))) + where + newCtl = control flags 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') + -- Merge a list of binary package paragraphs + 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 = + -- foldr :: (a -> b -> b) -> b -> [a] -> b + 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 -> Compiler -> String -> PackageDescription -> Control +control flags compiler debianMaintainer pkgDesc = + Control {unControl = + ([sourceSpec] ++ + develLibrarySpecs ++ + profileLibrarySpecs ++ + docLibrarySpecs ++ + map executableSpec (executables pkgDesc))} + where + buildDepsIndep = "" + 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", " " ++ buildDepsIndep), + Field ("Standards-Version", " " ++ "3.7.2.2")] ++ + list [] (\ s -> [Field ("Homepage", " " ++ s)]) (homepage pkgDesc)) + executableSpec executable = + Paragraph + [Field ("Package", " " ++ map toLower (exeName executable)), + Field ("Architecture", " " ++ "any"), + Field ("Section", " " ++ "misc"), + -- No telling what the dependencies of an executable might + -- be. The developer will have to fill them in + Field ("Depends", " " ++ showDeps [[D.Rel "${shlibs:Depends}" Nothing Nothing], [D.Rel "${haskell: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 [librarySpec "any" "-doc"] else [] + librarySpec arch suffix = + Paragraph + [Field ("Package", " " ++ prefix ++ map toLower (unPackageName . pkgName . package $ pkgDesc) ++ suffix), + Field ("Architecture", " " ++ arch), + Field ("Section", " " ++ "libdevel"), + Field ("Depends", " " ++ showDeps' "Depends:" ([[D.Rel "${haskell:Depends}" Nothing Nothing]] {- ++ libraryDependencies suffix -} )), + Field ("Description", " " ++ libraryDescription suffix)] + where prefix = case suffix of + "-dev" -> "libghc6-" + "-prof" -> "libghc6-" + "-doc" -> docPrefix (unPackageName . pkgName . package $ pkgDesc) + _ -> error $ "Unknown suffix: " ++ suffix + libraryDependencies :: String -> D.Relations + libraryDependencies "-dev" = concat . map (debianDependencies compiler develDependencies) . allBuildDepends $ pkgDesc + libraryDependencies "-prof" = [[D.Rel (debianDevelPackageName (unPackageName . pkgName . package $ pkgDesc)) Nothing Nothing]] ++ + (concat . map (debianDependencies compiler profilingDependencies) . allBuildDepends $ pkgDesc) + libraryDependencies "-doc" = [D.Rel "ghc6-doc" Nothing Nothing] : (concat . map (debianDependencies compiler docDependencies) . allBuildDepends $ pkgDesc) + libraryDependencies suffix = error $ "Unexpected library package name suffix: " ++ show suffix + -- The haskell-cdbs package contains the hlibrary.mk file with + -- the rules for building haskell packages. + debianBuildDeps :: D.Relations + debianBuildDeps = + [[D.Rel "debhelper" (Just (D.GRE (parseDebianVersion "5.0"))) Nothing], + [D.Rel "haskell-cdbs" Nothing Nothing], + [D.Rel "ghc6" (Just (D.GRE (parseDebianVersion "6.8"))) Nothing], + [D.Rel "ghc6-doc" Nothing Nothing], + [D.Rel "haddock" Nothing Nothing]] ++ + (if debLibProf flags then [[D.Rel "ghc6-prof" Nothing Nothing]] else []) ++ + (concat . map (debianDependencies compiler buildDependencies) . allBuildDepends $ pkgDesc) + debianDescription = + (synopsis pkgDesc) ++ + case description pkgDesc of + "" -> "" + text -> + let text' = text ++ "\n" ++ + list "" ("\nAuthor: " ++) (author pkgDesc) ++ + list "" ("\nUpstream-Maintainer: " ++) (maintainer pkgDesc) ++ + list "" ("\nUrl: " ++) (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 + +-- |Debian packages don't have per binary package build dependencies, +-- so we just gather them all up here. +allBuildDepends pkgDesc = + nub $ buildDepends pkgDesc ++ + concat (map buildTools (allBuildInfo pkgDesc) ++ + map pkgconfigDepends (allBuildInfo pkgDesc)) + +-- Turn a cabal dependency into a list of debian relations. If a +-- library is required as a build dependency we need the profiling +-- version, which pulls in the regular version, and we need the +-- documentation so the cross references can be resolved. +debianDependencies :: Compiler -> (Compiler -> Dependency -> D.Relations) -> Dependency -> D.Relations +debianDependencies compiler toDebRels dep | isBundled compiler dep = [] +debianDependencies compiler toDebRels dep = toDebRels compiler dep + +changelogUpdate :: FilePath -> String -> PackageDescription -> String -> IO () +changelogUpdate path debianMaintainer pkgDesc date = + try (readFile path) >>= either (const (writeFile path log)) (const (writeFile (path ++ ".new") log)) + where + log = changelog debianMaintainer pkgDesc date + +changelog :: String -> PackageDescription -> String -> String +changelog debianMaintainer pkgDesc date = + show (D.Entry { D.logPackage = debianSourcePackageName pkgDesc + , D.logVersion = debianVersionNumber pkgDesc + , D.logDists = [D.parseReleaseName "unstable"] + , D.logUrgency = "low" + , D.logComments = " * Debianization generated by cabal-debian\n\n" + , D.logWho = debianMaintainer + , D.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" + +debianDevelPackageName' (Dependency (PackageName name) _) = debianDevelPackageName name + +-- debianPackageName prefix name suffix = prefix ++ (map toLower name) ++ suffix + +debianVersionNumber :: PackageDescription -> DebianVersion +debianVersionNumber pkgDesc = parseDebianVersion . showVersion . pkgVersion . package $ pkgDesc + +-- The profiling packages depend on the other profiling packages. +-- FIXME: These should have version dependencies. +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 [] + +-- The development packages depend on the other development packages, +-- the ones they were built with. FIXME: These should have version +-- dependencies. +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 [] + +-- The build dependencies for a package include the profiling +-- libraries and the documentation packages, used for creating cross +-- references. +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 + , debianDocumentationPackageName name ] else [name] + +-- The documentation dependencies for a package include the documentation +-- package for any libraries which are build dependencies, so we have access +-- to all the cross references. +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 + -- A debian dependency list is always a list of or-relations + -- which are anded. This function turns the more freeform cabal + -- relations into that format. + 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]] + -- Turn simple Cabal relations into Debian relations + 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 some combinations that frequently show up. + 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 [[1,2,3], [4,5],[6]] -> [[1,4,6],[1,5,6],[2,4,6],[2,5,6],[3,4,6],[3,5,6]] +cartesianProduct :: [[a]] -> [[a]] +cartesianProduct = sequence + +-- | Convert from license to RPM-friendly description. The strings are +-- taken from TagsCheck.py in the rpmlint distribution. + +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" diff --git a/Distribution/Package/Debian/Bundled.hs b/Distribution/Package/Debian/Bundled.hs new file mode 100644 --- /dev/null +++ b/Distribution/Package/Debian/Bundled.hs @@ -0,0 +1,225 @@ +-- | +-- Module : Distribution.Package.Debian.Bundled +-- Copyright : David Fox 2008 +-- +-- Maintainer : David Fox +-- Stability : alpha +-- Portability : portable +-- +-- Determine whether a specific version of a Haskell package is +-- bundled with into this particular version of the given compiler. + +-- This software may be used and distributed according to the terms of +-- the GNU General Public License, incorporated herein by reference. + +module Distribution.Package.Debian.Bundled + ( + bundledWith + , isBundled + , isLibrary + , docPrefix + ) where + +import Data.List (find) +import Data.Version (Version(..)) +import Distribution.Simple.Compiler (Compiler(..), CompilerId(..), CompilerFlavor(..), compilerFlavor) +import Distribution.Package (PackageIdentifier(..), PackageName(..), Dependency(..)) +import Distribution.Version (withinRange) + +-- | List the packages bundled with this version of the given +-- compiler. If the answer is not known, return the empty list. +bundledWith :: Compiler -> Maybe [PackageIdentifier] +bundledWith c = + let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) $ compilerId c) + in thd `fmap` find (\(n,v,_) -> (n,v) == cv) builtIns + where thd (_,_,x) = x + +-- | Determine whether a specific version of a Haskell package is +-- bundled with into this particular version of the given compiler. +isBundled :: Compiler -> Dependency -> Bool +isBundled c (Dependency pkg version) = maybe False checkVersion $ do + let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) (compilerId c)) + (_, _, cb) <- find (\(n, k, _) -> (n,k) == cv) builtIns + pkgVersion `fmap` find ((== pkg) . pkgName) cb + where checkVersion = flip withinRange version + +builtIns :: [(CompilerFlavor, Version, [PackageIdentifier])] +builtIns = [ + (GHC, Version [6,8,3] [], ghc683BuiltIns) + , (GHC, Version [6,8,2] [], ghc682BuiltIns) + , (GHC, Version [6,8,1] [], ghc681BuiltIns) + , (GHC, Version [6,6,1] [], ghc661BuiltIns) + , (GHC, Version [6,6] [], ghc66BuiltIns) + ] + +v :: String -> [Int] -> PackageIdentifier +v n x = PackageIdentifier (PackageName n) (Version x []) + +ghc683BuiltIns :: [PackageIdentifier] +ghc683BuiltIns = ghc682BuiltIns + +ghc682BuiltIns :: [PackageIdentifier] +ghc682BuiltIns = [ + v "Cabal" [1,2,3,0], + v "array" [0,1,0,0], + v "base" [3,0,1,0], + v "bytestring" [0,9,0,1], + v "containers" [0,1,0,1], + v "directory" [1,0,0,0], + v "filepath" [1,1,0,0], + v "ghc" [6,8,2,0], + v "haskell98" [1,0,1,0], + v "hpc" [0,5,0,0], + v "old-locale" [1,0,0,0], + v "old-time" [1,0,0,0], + v "packedstring" [0,1,0,0], + v "pretty" [1,0,0,0], + v "process" [1,0,0,0], + v "random" [1,0,0,0], + v "readline" [1,0,1,0], + v "template-haskell" [2,2,0,0], + v "unix" [2,3,0,0] + ] + +ghc681BuiltIns :: [PackageIdentifier] +ghc681BuiltIns = [ + v "base" [3,0,0,0], + v "Cabal" [1,2,2,0], + v "GLUT" [2,1,1,1], + v "HGL" [3,2,0,0], + v "HUnit" [1,2,0,0], + v "OpenAL" [1,3,1,1], + v "OpenGL" [2,2,1,1], + v "QuickCheck" [1,1,0,0], + v "X11" [1,2,3,1], + v "array" [0,1,0,0], + v "bytestring" [0,9,0,1], + v "cgi" [3001,1,5,1], + v "containers" [0,1,0,0], + v "directory" [1,0,0,0], + v "fgl" [5,4,1,1], + v "filepatch" [1,1,0,0], + v "ghc" [6,8,1,0], + v "haskell-src" [1,0,1,1], + v "haskell98" [1,0,1,0], + v "hpc" [0,5,0,0], + v "html" [1,0,1,1], + v "mtl" [1,1,0,0], + v "network" [2,1,0,0], + v "old-locale" [1,0,0,0], + v "old-time" [1,0,0,0], + v "packedstring" [0,1,0,0], + v "parallel" [1,0,0,0], + v "parsec" [2,1,0,0], + v "pretty" [1,0,0,0], + v "process" [1,0,0,0], + v "random" [1,0,0,0], + v "readline" [1,0,1,0], + v "regex-base" [0,72,0,1], + v "regex-compat" [0,71,0,1], + v "regex-posix" [0,72,0,1], + v "stm" [2,1,1,0], + v "template-haskell" [2,2,0,0], + v "time" [1,1,2,0], + v "unix" [2,2,0,0], + v "xhtml" [3000,0,2,1] + ] + +ghc661BuiltIns :: [PackageIdentifier] +ghc661BuiltIns = [ + v "base" [2,1,1], + v "Cabal" [1,1,6,2], + v "cgi" [3001,1,1], + v "fgl" [5,4,1], + v "filepath" [1,0], + v "ghc" [6,6,1], + v "GLUT" [2,1,1], + v "haskell98" [1,0], + v "haskell-src" [1,0,1], + v "HGL" [3,1,1], + v "html" [1,0,1], + v "HUnit" [1,1,1], + v "mtl" [1,0,1], + v "network" [2,0,1], + v "OpenAL" [1,3,1], + v "OpenGL" [2,2,1], + v "parsec" [2,0], + v "QuickCheck" [1,0,1], + v "readline" [1,0], + v "regex-base" [0,72], + v "regex-compat" [0,71], + v "regex-posix" [0,71], + v "rts" [1,0], + v "stm" [2,0], + v "template-haskell" [2,1], + v "time" [1,1,1], + v "unix" [2,1], + v "X11" [1,2,1], + v "xhtml" [3000,0,2] + ] + +ghc66BuiltIns :: [PackageIdentifier] +ghc66BuiltIns = [ + v "base" [2,0], + v "Cabal" [1,1,6], + v "cgi" [2006,9,6], + v "fgl" [5,2], + v "ghc" [6,6], + v "GLUT" [2,0], + v "haskell98" [1,0], + v "haskell-src" [1,0], + v "HGL" [3,1], + v "html" [1,0], + v "HTTP" [2006,7,7], + v "HUnit" [1,1], + v "mtl" [1,0], + v "network" [2,0], + v "OpenAL" [1,3], + v "OpenGL" [2,1], + v "parsec" [2,0], + v "QuickCheck" [1,0], + v "readline" [1,0], + v "regex-base" [0,71], + v "regex-compat" [0,71], + v "regex-posix" [0,71], + v "rts" [1,0], + v "stm" [2,0], + v "template-haskell" [2,0], + v "time" [1,0], + v "unix" [1,0], + v "X11" [1,1], + v "xhtml" [2006,9,13] + ] + +-- |Some dependencies are libraries, some are executables. +isLibrary :: Compiler -> Dependency -> Bool +isLibrary _ (Dependency (PackageName "happy") _ ) = False +isLibrary _ _ = True + +docPrefix :: String -> String +{- +docPrefix "alut" = "libghc6-" +docPrefix "arrows" = "libghc6-" +docPrefix "binary" = "libghc6-" +docPrefix "cgi" = "libghc6-" +docPrefix "fgl" = "libghc6-" +docPrefix "glut" = "libghc6-" +docPrefix "haskell-src" = "libghc6-" +docPrefix "hgl" = "libghc6-" +docPrefix "html" = "libghc6-" +docPrefix "hunit" = "libghc6-" +docPrefix "mtl" = "libghc6-" +docPrefix "network" = "libghc6-" +docPrefix "openal" = "libghc6-" +docPrefix "opengl" = "libghc6-" +docPrefix "parallel" = "libghc6-" +docPrefix "parsec" = "libghc6-" +docPrefix "quickcheck" = "libghc6-" +docPrefix "stm" = "libghc6-" +docPrefix "stream" = "libghc6-" +docPrefix "time" = "libghc6-" +docPrefix "x11" = "libghc6-" +docPrefix "xhtml" = "libghc6-" +docPrefix "xmonad" = "libghc6-" +-} +docPrefix _ = "libghc6-" diff --git a/Distribution/Package/Debian/Main.hs b/Distribution/Package/Debian/Main.hs new file mode 100644 --- /dev/null +++ b/Distribution/Package/Debian/Main.hs @@ -0,0 +1,28 @@ +-- | +-- Module : Distribution.Package.Debian.Main +-- Copyright : David Fox 2008 +-- +-- Maintainer : David Fox +-- Stability : alpha +-- Portability : portable +-- +-- Explanation: Main entry point for Debianizer of Cabal packages. + +-- This software may be used and distributed according to the terms of +-- the GNU General Public License, incorporated herein by reference. + +module Distribution.Package.Debian.Main where + +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.Package.Debian (debian) +import Distribution.Package.Debian.Setup (Flags (..), parseArgs) +import Distribution.Simple.Utils (defaultPackageDesc) +import System.Environment (getArgs) + +main :: IO () + +main = do opts <- getArgs >>= parseArgs + let verbosity = rpmVerbosity opts + descPath <- defaultPackageDesc verbosity + pkgDesc <- readPackageDescription verbosity descPath + debian pkgDesc opts diff --git a/Distribution/Package/Debian/Setup.hs b/Distribution/Package/Debian/Setup.hs new file mode 100644 --- /dev/null +++ b/Distribution/Package/Debian/Setup.hs @@ -0,0 +1,159 @@ +-- | +-- Module : Distribution.Package.Debian.Setup +-- Copyright : David Fox 2008 +-- +-- Maintainer : David Fox +-- Stability : alpha +-- Portability : portable +-- +-- Explanation: Command line option processing for building RPM +-- packages. + +-- This software may be used and distributed according to the terms of +-- the GNU General Public License, incorporated herein by reference. + +module Distribution.Package.Debian.Setup ( + Flags(..) + , DebAction(..) + , DebType(..) + , parseArgs + ) where + +import Control.Monad (when) +import Data.Char (toLower) +import Distribution.Compiler (CompilerFlavor(..), defaultCompilerFlavor) +import Distribution.ReadE (readEOrFail) +import Distribution.PackageDescription (FlagAssignment(..), FlagName(..)) +import Distribution.Verbosity (Verbosity, flagToVerbosity, normal) +import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), + usageInfo, getOpt') +import System.Environment (getProgName) +import System.Exit (exitWith, ExitCode (..)) +import System.IO (Handle, hPutStrLn, stderr, stdout) + +data Flags = Flags + { + rpmPrefix :: FilePath + , rpmCompiler :: CompilerFlavor + , rpmConfigurationsFlags :: [(FlagName, Bool)] + , rpmHaddock :: Bool + , rpmHelp :: Bool + , debLibProf :: Bool + , rpmName :: Maybe String + , rpmOptimisation :: Bool + , rpmRelease :: Maybe String + , rpmSplitObjs :: Bool + , debOutputDir :: FilePath + , rpmVerbosity :: Verbosity + , rpmVersion :: Maybe String + , debMaintainer :: Maybe String + , debAction :: DebAction + } + deriving (Eq, Show) + +data DebType = Dev| Prof | Doc deriving (Eq, Read, Show) + +data DebAction = Usage | Debianize | SubstVar DebType | UpdateDebianization deriving (Eq, Show) + +emptyFlags :: Flags + +emptyFlags = Flags + { + rpmPrefix = "/usr/lib/haskell-packages/ghc6" + , rpmCompiler = GHC + , rpmConfigurationsFlags = [] + , rpmHaddock = True + , rpmHelp = False + , debLibProf = True + , rpmName = Nothing + , rpmOptimisation = True + , rpmRelease = Nothing + , rpmSplitObjs = True + , debOutputDir = "./debian" + , rpmVerbosity = normal + , rpmVersion = Nothing + , debMaintainer = Nothing + , debAction = Usage + } + +options :: [OptDescr (Flags -> Flags)] + +options = + [ + Option "" ["prefix"] (ReqArg (\ path x -> x { rpmPrefix = path }) "PATH") + "Pass this prefix if we need to configure the package", + Option "" ["ghc"] (NoArg (\x -> x { rpmCompiler = GHC })) + "Compile with GHC", + Option "" ["hugs"] (NoArg (\x -> x { rpmCompiler = Hugs })) + "Compile with Hugs", + Option "" ["jhc"] (NoArg (\x -> x { rpmCompiler = JHC })) + "Compile with JHC", + Option "" ["nhc"] (NoArg (\x -> x { rpmCompiler = NHC })) + "Compile with NHC", + Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True })) + "Show this help text", + Option "" ["name"] (ReqArg (\name x -> x { rpmName = Just name }) "NAME") + "Override the default package name", + Option "" ["disable-haddock"] (NoArg (\x -> x { rpmHaddock = False })) + "Don't generate API docs", + Option "" ["disable-library-profiling"] (NoArg (\x -> x { debLibProf = False })) + "Don't generate profiling libraries", + Option "" ["disable-optimization"] (NoArg (\x -> x { rpmOptimisation = False })) + "Don't generate optimised code", + Option "" ["disable-split-objs"] (NoArg (\x -> x { rpmSplitObjs = False })) + "Don't split object files to save space", + Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS") + "Set given flags in Cabal conditionals", + Option "" ["release"] (ReqArg (\rel x -> x { rpmRelease = Just rel }) "RELEASE") + "Override the default package release", + Option "" ["debdir"] (ReqArg (\path x -> x { debOutputDir = path }) "DEBDIR") + ("Override the default output directory (" ++ show (debOutputDir emptyFlags) ++ ")"), + Option "v" ["verbose"] (ReqArg (\verb x -> x { rpmVerbosity = readEOrFail flagToVerbosity verb }) "n") + "Change build verbosity", + Option "" ["version"] (ReqArg (\vers x -> x { rpmVersion = Just vers }) "VERSION") + "Override the default package version", + Option "" ["maintainer"] (ReqArg (\maint x -> x { debMaintainer = Just maint }) "Maintainer Name ") + "Override the Maintainer name and email in $DEBEMAIL/$EMAIL/$DEBFULLNAME/$FULLNAME", + Option "" ["debianize"] (NoArg (\x -> x {debAction = Debianize})) + "Generate a new debianization, replacing any existing one. One of --debianize, --substvar, or --update-debianization is required.", + Option "" ["substvar"] (ReqArg (\ name x -> x {debAction = SubstVar (read name)}) "Doc, Prof, or Dev") + (unlines ["Write out the list of dependencies required for the dev, prof or doc package depending", + "on the argument. This value can be added to the appropriate substvars file."]), + Option "" ["update-debianization"] (NoArg (\x -> x {debAction = UpdateDebianization})) + "Update an existing debianization, or generate a new one." + ] + +-- Lifted from Distribution.Simple.Setup, since it's not exported. +flagList :: String -> [(FlagName, Bool)] +flagList = map tagWithValue . words + where tagWithValue ('-':name) = (FlagName (map toLower name), False) + tagWithValue name = (FlagName (map toLower name), True) + +printHelp :: Handle -> IO () + +printHelp h = do + progName <- getProgName + let info = "Usage: " ++ progName ++ " [FLAGS]\n" + hPutStrLn h (usageInfo info options) + +parseArgs :: [String] -> IO Flags + +parseArgs args = do + let (os, args', unknown, errs) = getOpt' RequireOrder options args + opts = foldl (flip ($)) emptyFlags os + when (rpmHelp opts || debAction opts == Usage) $ do + printHelp stdout + exitWith ExitSuccess + when (not (null errs)) $ do + hPutStrLn stderr "Errors:" + mapM_ (hPutStrLn stderr) errs + exitWith (ExitFailure 1) + when (not (null unknown)) $ do + hPutStrLn stderr "Unrecognised options:" + mapM_ (hPutStrLn stderr) unknown + exitWith (ExitFailure 1) + when (not (null args')) $ do + hPutStrLn stderr "Unrecognised arguments:" + mapM_ (hPutStrLn stderr) args' + exitWith (ExitFailure 1) + return opts diff --git a/debian.cabal b/debian.cabal --- a/debian.cabal +++ b/debian.cabal @@ -1,7 +1,7 @@ Name: debian -Version: 3.18.1 +Version: 3.21 License: BSD3 -License-File: COPYING +License-File: debian/copyright Author: David Fox Category: System Maintainer: david@seereason.com @@ -66,7 +66,11 @@ Debian.Util.FakeChanges, Text.Format other-modules: - Debian.Version.Internal + Debian.Version.Internal, + Distribution.Package.Debian.Bundled, + Distribution.Package.Debian.Setup, + Distribution.Package.Debian.Main, + Distribution.Package.Debian extra-source-files: tests/Main.hs demos/Versions.hs debian/changelog debian/compat debian/control debian/copyright @@ -87,7 +91,7 @@ Executable: cabal-debian Main-is: utils/CabalDebian.hs ghc-options: -O2 -threaded -W -Build-Depends: Cabal +Build-Depends: Cabal >= 1.6.0.1 -- For more complex build options see: -- http://www.haskell.org/ghc/docs/latest/html/Cabal/ diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,23 @@ +haskell-debian (3.21) unstable; urgency=low + + * Don't write out postinst and postrm for the doc package, they are + now automatically added by haskell-cdbs. + + -- David Fox Tue, 27 Jan 2009 10:14:20 -0800 + +haskell-debian (3.20) unstable; urgency=low + + * Modify the buildable function in GenBuildDeps so it returns more + info about the ready packages and what packages each one blocks. + + -- David Fox Tue, 27 Jan 2009 06:55:39 -0800 + +haskell-debian (3.19) unstable; urgency=low + + * Make cabal-debian depend on haskell-cdbs, it used to be the opposite. + + -- David Fox Sun, 25 Jan 2009 15:22:41 -0800 + haskell-debian (3.18) unstable; urgency=low * Modify cabal-debian to it creates debianizations that use the new diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -3,7 +3,7 @@ Section: misc Maintainer: David Fox Build-Depends: debhelper (>= 5.0), - haskell-cdbs, + haskell-cdbs, haskell-devscripts (>= 0.6.15), ghc6 (>= 6.10), ghc6-doc, haddock (>= 2.1.0), @@ -25,11 +25,12 @@ Architecture: any Section: libdevel Depends: ${haskell:Depends}, - libghc6-unixutils-dev, - libghc6-extra-dev, + ghc6, libghc6-bzlib-dev, - libghc6-zlib-dev, - libghc6-haxml-dev + libghc6-extra-dev, + libghc6-haxml-dev, + libghc6-unixutils-dev, + libghc6-zlib-dev Conflicts: libghc6-debian-dev Provides: libghc6-debian-dev Replaces: libghc6-debian-dev @@ -44,6 +45,27 @@ . This package contains the normal library files. +Package: libghc6-debian-prof +Architecture: any +Section: libdevel +Depends: ${haskell:Depends}, + libghc6-debian-dev, + libghc6-extra-prof, + libghc6-haxml-dev, + libghc6-unixutils-prof, + libghc6-bzlib-prof, + libghc6-zlib-prof +Description: Modules for working with the Debian package system + This library includes modules covering almost every aspect of the Debian + packaging system, including low level data types such as version numbers + and dependency relations, on up to the types necessary for computing and + installing build dependencies, building source and binary packages, + and inserting them into a repository. + . + Author: David Fox + . + This package contains the profiling library files. + Package: libghc6-debian-doc Architecture: any Section: libdevel @@ -85,5 +107,5 @@ Package: cabal-debian Architecture: any Section: devel -Depends: ${shlibs:Depends}, ${haskell:Depends}, haskell-utils, haskell-devscripts, libghc6-cabal-prof +Depends: ${shlibs:Depends}, ${haskell:Depends}, haskell-utils, haskell-cdbs, haskell-devscripts (>= 0.6.15), libghc6-cabal-prof Description: Tool for creating debianizations of Haskell packages based on the .cabal file.