debian 3.14 → 3.17.1
raw patch · 6 files changed
+1193/−1 lines, 6 files
Files
- Distribution/Package/Debian.hs +751/−0
- Distribution/Package/Debian/Bundled.hs +225/−0
- Distribution/Package/Debian/Main.hs +28/−0
- Distribution/Package/Debian/Setup.hs +159/−0
- debian.cabal +5/−1
- debian/changelog +25/−0
+ Distribution/Package/Debian.hs view
@@ -0,0 +1,751 @@+{-# LANGUAGE CPP, TypeSynonymInstances #-}++-- |+-- Module : Distribution.Package.Debian+-- Copyright : David Fox 2008+--+-- Maintainer : David Fox <dsf@seereason.com>+-- 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 <name>-<version>,+-- 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<name>-<version>.a and libHS<name>-<version>_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 new+ 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 <cabalname>.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+ readFile "/usr/lib/haskell-utils/scripts/current/libghc6-PACKAGE-doc.postinst" >>=+ writeFile (tgtPfx </> debianDocumentationPackageName ((unPackageName . pkgName) (package pkgDesc)) ++ ".postinst")+ readFile "/usr/lib/haskell-utils/scripts/current/libghc6-PACKAGE-doc.postrm" >>=+ writeFile (tgtPfx </> debianDocumentationPackageName ((unPackageName . pkgName) (package pkgDesc)) ++ ".postrm")+ -- 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 <email>", 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/haskell-devscripts/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+ -- Our haskell-devscripts contains the hlibrary.mk file with+ -- the rules for building haskell packages. Cabal-debian is+ -- used to compute the binary dependencies during the build, and+ -- decide whether any build dependencies are missing. This+ -- would include any dev, prof, or doc packages associated with+ -- the cabal packages listed as build dependencies in the .cabal+ -- file.+ debianBuildDeps :: D.Relations+ debianBuildDeps =+ [[D.Rel "debhelper" (Just (D.GRE (parseDebianVersion "5.0"))) Nothing],+ [D.Rel "haskell-devscripts" Nothing Nothing],+ [D.Rel "cabal-debian" (Just (D.GRE (parseDebianVersion "0.7"))) 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"
+ Distribution/Package/Debian/Bundled.hs view
@@ -0,0 +1,225 @@+-- |+-- Module : Distribution.Package.Debian.Bundled+-- Copyright : David Fox 2008+--+-- Maintainer : David Fox <dsf@seereason.com>+-- 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-"
+ Distribution/Package/Debian/Main.hs view
@@ -0,0 +1,28 @@+-- |+-- Module : Distribution.Package.Debian.Main+-- Copyright : David Fox 2008+--+-- Maintainer : David Fox <dsf@seereason.com>+-- 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
+ Distribution/Package/Debian/Setup.hs view
@@ -0,0 +1,159 @@+-- |+-- Module : Distribution.Package.Debian.Setup+-- Copyright : David Fox 2008+--+-- Maintainer : David Fox <dsf@seereason.com>+-- 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 <email addr>")+ "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
debian.cabal view
@@ -1,5 +1,5 @@ Name: debian-Version: 3.14+Version: 3.17.1 License: BSD3 License-File: COPYING Author: David Fox@@ -67,6 +67,10 @@ Text.Format other-modules: Debian.Version.Internal+ Distribution.Package.Debian+ Distribution.Package.Debian.Main+ Distribution.Package.Debian.Setup+ Distribution.Package.Debian.Bundled extra-source-files: tests/Main.hs demos/Versions.hs debian/changelog debian/compat debian/control debian/copyright
debian/changelog view
@@ -1,3 +1,28 @@+haskell-debian (3.17.1) unstable; urgency=low++ * Attempt to fix .cabal so that tarball generated by sdist works++ -- Jeremy Shaw <jeremy@seereason.com> Fri, 23 Jan 2009 19:08:47 -0600++haskell-debian (3.17) unstable; urgency=low++ * Have cabal-debian --substvar print its result to stderr.++ -- David Fox <dsf@seereason.com> Fri, 23 Jan 2009 10:33:48 -0800++haskell-debian (3.16) unstable; urgency=low++ * Back out register/unregister stuff, just have cabal-debian die if the+ package doesn't have a library section.++ -- David Fox <dsf@seereason.com> Thu, 22 Jan 2009 15:33:43 -0800++haskell-debian (3.15) unstable; urgency=low++ * Don't leave package registered after computing lbi.++ -- David Fox <dsf@seereason.com> Thu, 22 Jan 2009 14:19:23 -0800+ haskell-debian (3.14) unstable; urgency=low * Fix a bug that resulted in a fromJust Nothing error.