cabal-debian 1.3 → 1.5
raw patch · 14 files changed
+1/−2108 lines, 14 files
Files
- Distribution/Package/Debian.hs +0/−715
- Distribution/Package/Debian/Bundled.hs +0/−463
- Distribution/Package/Debian/DebianRelations.hs +0/−102
- Distribution/Package/Debian/Main.hs +0/−28
- Distribution/Package/Debian/Relations.hs +0/−360
- Distribution/Package/Debian/Setup.hs +0/−199
- cabal-debian.cabal +1/−1
- cabal-debian.cabal~ +0/−29
- debian/cabal-debian.1 +0/−120
- debian/cabal-debian.manpages +0/−1
- debian/changelog +0/−32
- debian/compat +0/−1
- debian/control +0/−43
- debian/rules +0/−14
− Distribution/Package/Debian.hs
@@ -1,715 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables, TupleSections, TypeSynonymInstances #-}-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}---- |--- 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 Codec.Binary.UTF8.String (decodeString)-import Control.Arrow (second)-import Control.Exception (SomeException, try, bracket, IOException)-import Control.Monad (when,mplus)-import Control.Monad.Reader (ReaderT(runReaderT), ask)-import Control.Monad.Trans (lift)-import Data.Char (isSpace)-import Data.List-import qualified Data.Map as Map-import Data.Maybe-import qualified Data.Set as Set-import Data.Version (showVersion)-import Debian.Control-import qualified Debian.Relation as D-import Debian.Release (parseReleaseName)-import Debian.Changes (ChangeLogEntry(..), prettyEntry)-import Debian.Time (getCurrentLocalRFC822Time)-import Debian.Version (DebianVersion, prettyDebianVersion)-import Debian.Version.String-import System.Cmd (system)-import System.Directory-import System.FilePath ((</>), dropExtension)-import System.IO (IOMode (ReadMode), hGetContents, hPutStrLn, hSetBinaryMode, openFile, stderr, withFile)-import System.IO.Error (ioeGetFileName, isDoesNotExistError)-import System.Posix.Files (setFileCreationMask)-import System.Unix.Process-import System.Environment--import Distribution.Text (display)-import Distribution.Simple.Compiler (CompilerFlavor(..), compilerFlavor, Compiler(..), CompilerId(..))-import Distribution.System (Platform(..), buildOS, buildArch)-import Distribution.License (License(..))-import Distribution.Package (Package(..), PackageIdentifier(..), PackageName(..), Dependency(..))-import Distribution.Simple.Program (defaultProgramConfiguration)-import Distribution.Simple.Configure (configCompiler)-import Distribution.Simple.Utils (die, setupMessage)-import Distribution.PackageDescription (GenericPackageDescription(..), PackageDescription(..), exeName)-import Distribution.PackageDescription.Configuration (finalizePackageDescription)---import Distribution.ParseUtils (parseQuoted)-import Distribution.Verbosity (Verbosity)-import Distribution.Package.Debian.Setup (Flags(..), DebAction(..), DebType(..))-import Distribution.Package.Debian.Bundled (Bundled, PackageType(..), debianName, ghcBuiltIns {-, builtIns, ghc6BuiltIns-})-import Distribution.Version (VersionRange(..))---import qualified Distribution.Compat.ReadP as ReadP---import Distribution.Text ( Text(parse) )-import Text.PrettyPrint.HughesPJ--import Distribution.Package.Debian.Relations (buildDependencies, docDependencies, allBuildDepends, debianDependencies, cabalDependencies)--{--_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--(!) :: DebMap -> String -> DebianVersion-m ! k = maybe (error ("No version number for " ++ show k ++ " in " ++ show (Map.map (maybe Nothing (Just . prettyDebianVersion)) m))) id (Map.findWithDefault Nothing k m)--trim :: String -> String-trim = dropWhile isSpace--simplePackageDescription :: GenericPackageDescription -> Flags- -> IO (Compiler, PackageDescription)-simplePackageDescription genPkgDesc flags = do- (compiler', _) <- {- fchroot (buildRoot flags) -} (configCompiler (Just (rpmCompiler flags)) Nothing Nothing- defaultProgramConfiguration- (rpmVerbosity flags))- let compiler = case (rpmCompilerVersion flags, rpmCompiler flags) of- (Just v, ghc) -> compiler' {compilerId = CompilerId ghc v}- _ -> compiler'- --installed <- installedPackages- case finalizePackageDescription (rpmConfigurationsFlags flags)- (const True) (Platform buildArch buildOS) (compilerId compiler)- {- (Nothing :: Maybe PackageIndex) -}- [] 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)--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/ghc/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:- -- libghc-cabal-debian-prof.substvars:- -- haskell:Depends=ghc-prof (<< 6.8.2-999), ghc-prof (>= 6.8.2), libghc-cabal-debian-dev (= 0.4)- -- libghc-cabal-debian-dev.substvars:- -- haskell:Depends=ghc (<< 6.8.2-999), ghc (>= 6.8.2)- -- haskell-cabal-debian-doc.substvars:- -- haskell:Depends=ghc-doc, haddock (>= 2.1.0), haddock (<< 2.1.0-999)- ([], Just path') ->- do old <- try (readFile path') >>= return . either (\ (_ :: SomeException) -> "") id- let new = addDeps old- hPutStrLn stderr (if new /= old- then ("cabal-debian - Updated " ++ show path' ++ ":\n " ++ old ++ "\n ->\n " ++ new)- else ("cabal-debian - No updates found for " ++ show path'))- maybe (return ()) (\ _x -> replaceFile path' new) name- ([], Nothing) -> return ()- (missing, _) -> - die ("These debian packages need to be added to the build dependency list so the required cabal packages are available:\n " ++ intercalate "\n " (map fst missing) ++- "\nIf this is an obsolete package you may need to withdraw the old versions from the\n" ++- "upstream repository, and uninstall and purge it from your local system.")- where- addDeps old =- case partition (isPrefixOf "haskell:Depends=") (lines old) of- ([], other) -> unlines (("haskell:Depends=" ++ showDeps deps) : other)- (hdeps, more) ->- case deps of- [] -> unlines (hdeps ++ more)- _ -> unlines (map (++ (", " ++ showDeps deps)) hdeps ++ more)- path = maybe Nothing (\ x -> Just ("debian/" ++ x ++ ".substvars")) name- name = case debType of Dev -> devDebName; Prof -> profDebName; Doc -> docDebName- deps = case debType of Dev -> devDeps; Prof -> profDeps; Doc -> docDeps- -- 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 -> []) (cabalDependencies pkgDesc)) 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 (\ (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) (cabalDependencies pkgDesc))- profDeps :: D.Relations- profDeps =- maybe [] (\ name -> [[D.Rel name Nothing Nothing]]) devDebName ++- catMaybes (map (\ (Dependency (PackageName name) _) ->- case Map.lookup name cabalPackages :: Maybe PackageInfo of- Just package -> maybe Nothing (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing]) (profDeb package)- Nothing -> Nothing) (cabalDependencies pkgDesc))- docDeps :: D.Relations- docDeps =- catMaybes (map (\ (Dependency (PackageName name) _) ->- case Map.lookup name cabalPackages :: Maybe PackageInfo of- Just package -> maybe Nothing (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing]) (docDeb package)- Nothing -> Nothing) (cabalDependencies 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) >>= either chk1 return >> -- This may not exist- try (renameFile path back) >>= either chk2 return >> -- This may not exist- writeFile path text -- This must succeed- where- back = path ++ "~"- chk1 :: IOException -> IO ()- chk1 e =- if ioeGetFileName e == Just back && isDoesNotExistError e- then return ()- else ioError e- chk2 :: IOException -> IO ()- chk2 e =- if ioeGetFileName e == Just path && isDoesNotExistError e- then return ()- else ioError e--libPaths :: Compiler -> DebMap -> IO [PackageInfo]-libPaths compiler debVersions- | compilerFlavor compiler == GHC =- do a <- getDirPaths "/usr/lib"- b <- getDirPaths "/usr/lib/haskell-packages/ghc/lib"- -- Build a map from names of installed debs to version numbers- dpkgFileMap >>= runReaderT (mapM (packageInfo compiler debVersions) (a ++ b)) >>= return . catMaybes- | True = error $ "Can't handle compiler flavor: " ++ show (compilerFlavor compiler)- where- getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (\ (_ :: SomeException) -> []) id--packageInfo :: Compiler -> DebMap -> (FilePath, String) -> ReaderT (Map.Map FilePath (Set.Set String)) IO (Maybe PackageInfo)-packageInfo compiler debVersions (d, f) =- case parseNameVersion f of- Nothing -> return Nothing- Just (p, v) -> lift (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) ---- |Create a map from pathname to the names of the packages that contains that pathname.--- We need to make sure we consume all the files, so -dpkgFileMap :: IO (Map.Map FilePath (Set.Set String))-dpkgFileMap =- do- let fp = "/var/lib/dpkg/info"- names <- getDirectoryContents fp >>= return . filter (isSuffixOf ".list")- let paths = map (fp </>) names- files <- mapM (strictReadF lines) paths- return $ Map.fromList $ zip (map dropExtension names) (map Set.fromList files)--strictReadF :: (String -> r) -> FilePath -> IO r-strictReadF f path = withFile path ReadMode (\h -> hGetContents h >>= (\x -> return $! f x))--- strictRead = strictReadF id---- |Given a path, return the name of the package that owns it.-debOfFile :: FilePath -> ReaderT (Map.Map FilePath (Set.Set String)) IO (Maybe String)-debOfFile path =- do mp <- ask- return $ testPath (Map.lookup path mp)- where- testPath :: Maybe (Set.Set FilePath) -> Maybe FilePath- testPath Nothing = Nothing- testPath (Just s) =- case Set.size s of- 1 -> Just (Set.findMin s)- _ -> Nothing--cond :: t -> t -> Bool -> t-cond ifF _ifT False = ifF-cond _ifF ifT True = ifT--debianize :: Bool -> PackageDescription -> Flags -> Compiler -> FilePath -> IO ()-debianize force pkgDesc flags compiler tgtPfx =- mapM_ removeIfExists ["debian/control", "debian/changelog"] >>- updateDebianization force pkgDesc flags compiler tgtPfx--removeFileIfExists :: FilePath -> IO ()-removeFileIfExists x = doesFileExist x >>= (`when` (removeFile x))--removeDirectoryIfExists :: FilePath -> IO ()-removeDirectoryIfExists x = doesDirectoryExist x >>= (`when` (removeDirectory x))--removeIfExists :: FilePath -> IO ()-removeIfExists x = removeFileIfExists x >> removeDirectoryIfExists x--updateDebianization :: Bool -- ^whether to forcibly create file- -> PackageDescription -- ^info from the .cabal file- -> Flags -- ^command line flags- -> 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 (\ (_ :: SomeException) -> showLicense . license $ pkgDesc) id- debianMaintainer <- getDebianMaintainer flags >>= maybe (error "Missing value for --maintainer") return- controlUpdate (tgtPfx </> "control") flags compiler debianMaintainer pkgDesc- changelogUpdate flags (tgtPfx </> "changelog") debianMaintainer pkgDesc date- replaceFile (tgtPfx </> "rules") (cdbsRules pkgDesc)- getPermissions "debian/rules" >>= setPermissions "debian/rules" . (\ p -> p {executable = True})- replaceFile (tgtPfx </> "compat") "7" -- should this be hardcoded, or automatically read from /var/lib/dpkg/status?- replaceFile (tgtPfx </> "copyright") copyright- -- The dev postinst and prerm files are generated by haskell-devscripts via cdbs.- return ()--readFile' :: FilePath -> IO String-readFile' path- = do- file <- openFile path ReadMode- hSetBinaryMode file True- hGetContents file--{--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 <- map (second decodeString) `fmap` 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, execs, comments] {- ++ devrules ++ profrules -} ))- where- header =- ["#!/usr/bin/make -f",- "",- "DEB_CABAL_PACKAGE = " ++ debianName Extra (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc))),- "",- "include /usr/share/cdbs/1/rules/debhelper.mk",- "include /usr/share/cdbs/1/class/hlibrary.mk"]- execs =- case executables pkgDesc of- [] -> []- [e] ->- let exe = exeName e- src = "dist-ghc/build/" ++ exe ++ "/" ++ exe- dst = "debian/" ++ exeDeb e ++ "/usr/bin/" ++ exe in- [ -- Magic rule required to get binaries to build in packages that have no libraries- "build/" ++ exeDeb e ++ ":: build-ghc-stamp"- , "binary-fixup/" ++ exeDeb e ++ "::"- , "\tinstall -m 755 -s -D " ++ src ++ " " ++ dst ++ " || true"]- _ ->- [ -- Magic rule required to get binaries to build in packages that have no libraries- "build/" ++ utilsDeb ++ ":: build-ghc-stamp"- , "binary-fixup/" ++ utilsDeb ++ "::" ] ++- map (\ executable ->- let exe = exeName executable- src = "dist-ghc/build/" ++ exe ++ "/" ++ exe- dst = "debian/" ++ utilsDeb ++ "/usr/bin/" ++ exe in- "\tinstall -m 755 -s -D " ++ src ++ " " ++ dst ++ " || true") (executables pkgDesc)- comments =- ["# How to install an extra file into the documentation package",- "#binary-fixup/" ++ docDeb ++ "::",- "#\techo \"Some informative text\" > debian/" ++ docDeb ++ "/usr/share/doc/" ++ docDeb ++ "/AnExtraDocFile"]- _p = pkgName . package $ pkgDesc- _libName = unPackageName _p- docDeb = debianName Documentation (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc)))- utilsDeb = debianName Utilities (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc)))- exeDeb e = debianName Extra (PackageName (exeName e)) AnyVersion--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 =- return (ghcBuiltIns compiler) >>= \bundled ->- try (readFile path) >>=- either (\ (_ :: SomeException) -> writeFile path (show (newCtl bundled))) (\ s -> writeFile (path ++ ".new") $! show (merge (newCtl bundled) (oldCtl s)))- where- newCtl bundled = control flags bundled compiler debianMaintainer pkgDesc- oldCtl s = either (const (Control [])) id (parseControl "debian/control" s)- merge (Control new) (Control old) =- case (new, old) of- (_newSource : _new', []) -> Control new- (newSource : new', oldSource : old') ->- Control (mergeParagraphs newSource oldSource : mergeOther new' old')- -- 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 :: Paragraph' String -> Paragraph' String -> Paragraph' String-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 -> Bundled -> Compiler -> String -> PackageDescription -> Control-control flags bundled compiler debianMaintainer pkgDesc =- Control {unControl =- ([sourceSpec] ++- develLibrarySpecs ++- profileLibrarySpecs ++ - docLibrarySpecs ++- (case executables pkgDesc of- [] -> []- [e] -> [utilsSpec (debianName Extra (PackageName (exeName e)) AnyVersion)]- _ -> [utilsSpec (debianName Utilities (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc))))]))}- where- --buildDepsIndep = ""- sourceSpec =- Paragraph- ([Field ("Source", " " ++ debianName Source (pkgName . package $ pkgDesc) (ThisVersion (pkgVersion (package pkgDesc)))),- Field ("Priority", " " ++ "extra"),- Field ("Section", " " ++ "haskell"),- Field ("Maintainer", " " ++ debianMaintainer),- Field ("Build-Depends", " " ++ showDeps' "Build-Depends:" (debianBuildDeps ++ map rel (buildDeps flags))),- Field ("Build-Depends-Indep", " " ++ showDeps' "Build-Depends-Indep:" debianBuildDepsIndep),- --Field ("Build-Depends-Indep", " " ++ buildDepsIndep),- Field ("Standards-Version", " " ++ "3.9.1"),- Field ("Homepage",- " " ++- if homepage pkgDesc == ""- then "http://hackage.haskell.org/package/" ++- unPackageName (pkgName $ package pkgDesc)- else homepage pkgDesc)])- rel x = [D.Rel x Nothing Nothing]- utilsSpec p =- Paragraph- [Field ("Package", " " ++ p),- 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],- [D.Rel "${misc:Depends}" Nothing Nothing]]),- Field ("Description", " " ++ maybe debianDescription (const executableDescription) (library pkgDesc))]- develLibrarySpecs = if isJust (library pkgDesc) then [librarySpec "any" Development] else []- profileLibrarySpecs = if debLibProf flags && isJust (library pkgDesc) then [librarySpec "any" Profiling] else []- docLibrarySpecs = if isJust (library pkgDesc) then [docSpecsParagraph] else []- docSpecsParagraph =- Paragraph- [Field ("Package", " " ++ debianName Documentation (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc)))),- Field ("Architecture", " " ++ "all"),- Field ("Section", " " ++ "doc"),- Field ("Depends", " " ++ showDeps' "Depends:" [[D.Rel "${haskell:Depends}" Nothing Nothing],- [D.Rel "${misc:Depends}" Nothing Nothing]]),- Field ("Recommends", " " ++ "${haskell:Recommends}"),- Field ("Suggests", " " ++ "${haskell:Suggests}"),- Field ("Description", " " ++ libraryDescription Documentation)]- librarySpec arch typ =- Paragraph- [Field ("Package", " " ++ debianName typ (pkgName (package pkgDesc)) (ThisVersion (pkgVersion (package pkgDesc)))),- Field ("Architecture", " " ++ arch),- Field ("Depends", " " ++ showDeps' "Depends:" (- (if typ == Development- then [[D.Rel "${shlibs:Depends}" Nothing Nothing]]- else []) ++- [[D.Rel "${haskell:Depends}" Nothing Nothing],- [D.Rel "${misc:Depends}" Nothing Nothing]])),- Field ("Recommends", " " ++ "${haskell:Recommends}"),- Field ("Suggests", " " ++ "${haskell:Suggests}"),- Field ("Provides", " " ++ "${haskell:Provides}"),- Field ("Description", " " ++ libraryDescription typ)]- -- The haskell-cdbs package contains the hlibrary.mk file with- -- the rules for building haskell packages.- debianBuildDeps :: D.Relations- debianBuildDeps = - nub $- [[D.Rel "debhelper" (Just (D.GRE (parseDebianVersion "7.0"))) Nothing],- [D.Rel "haskell-devscripts" (Just (D.GRE (parseDebianVersion "0.8"))) Nothing],- [D.Rel "cdbs" Nothing Nothing],- [D.Rel "ghc" Nothing Nothing]] ++- (if debLibProf flags then [[D.Rel "ghc-prof" Nothing Nothing]] else []) ++- (concat . map (debianDependencies flags bundled compiler buildDependencies) . allBuildDepends $ pkgDesc)- debianBuildDepsIndep :: D.Relations- debianBuildDepsIndep =- nub $- [[D.Rel "ghc-doc" Nothing Nothing]] ++- (concat . map (debianDependencies flags bundled compiler docDependencies) . allBuildDepends $ pkgDesc)- debianDescription = - (unwords . words . synopsis $ pkgDesc) ++- case description pkgDesc of- "" -> ""- text ->- let text' = text ++ "\n" ++- list "" ("\n Author: " ++) (author pkgDesc) ++- list "" ("\n Upstream-Maintainer: " ++) (maintainer pkgDesc) ++- list "" ("\n Url: " ++) (pkgUrl pkgDesc) in- "\n " ++ (trim . intercalate "\n " . map addDot . lines $ text')- addDot line = if all (flip elem " \t") line then "." else line- executableDescription = " " ++ "An executable built with the " ++ display (package pkgDesc) ++ " library."- libraryDescription Profiling = debianDescription ++ "\n .\n This package contains the libraries compiled with profiling enabled."- libraryDescription Development = debianDescription ++ "\n .\n This package contains the normal library files."- libraryDescription Documentation = debianDescription ++ "\n .\n This package contains the documentation files."- libraryDescription x = error $ "Unexpected library package name suffix: " ++ show x--showDeps :: [[D.Relation]] -> String-showDeps xss = intercalate ", " (map (intercalate " | " . map (show . D.prettyRelation)) xss)--showDeps' :: [a] -> [[D.Relation]] -> String-showDeps' prefix xss =- intercalate (",\n " ++ prefix') (map (intercalate " | " . map (show . D.prettyRelation)) xss)- where prefix' = map (\ _ -> ' ') prefix--changelogUpdate :: Flags -> FilePath -> String -> PackageDescription -> String -> IO ()-changelogUpdate flags path debianMaintainer pkgDesc date =- try (readFile path) >>= either (\ (_ :: SomeException) -> writeFile path log) (const (writeFile (path ++ ".new") log))- where- log = changelog flags debianMaintainer pkgDesc date--changelog :: Flags -> String -> PackageDescription -> String -> String-changelog flags debianMaintainer pkgDesc date =- render (prettyEntry- (Entry { logPackage = debianName Source (pkgName . package $ pkgDesc) (ThisVersion (pkgVersion (package pkgDesc)))- , logVersion = updateOriginal f $ debianVersionNumber pkgDesc- , logDists = [parseReleaseName "unstable"]- , logUrgency = "low"- , logComments = " * Debianization generated by cabal-debian\n\n"- , logWho = debianMaintainer- , logDate = date }))- where- f s = maybe (g s) id (debVersion flags)- g s = maybe "" (\ n -> show n ++ ":") (epoch flags) ++ s ++ "-1~hackage1"--updateOriginal :: (String -> String) -> DebianVersion -> DebianVersion---updateOriginal f (DebianVersion str dv) = DebianVersion (f str) dv-updateOriginal f v = parseDebianVersion . f . show . prettyDebianVersion $ v--unPackageName :: PackageName -> String-unPackageName (PackageName s) = s----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---- generated with:--- apt-cache show ghc \--- | grep ^Provides: \--- | cut -d\ -f2---- | sed 's/, /\n/g' \--- | grep libghc- \--- | cut -d- -f2- \--- | grep dev$ \--- | sed 's/-dev//;s/$/",/;s/^/"/'--{--base :: Set String-base- = Data.Set.fromList- ["array",- "base",- "bin-package-db",- "bytestring",- "cabal",- "containers",- "directory",- "extensible-exceptions",- "filepath",- "ghc-binary",- "ghc-prim",- "haskell2010",- "haskell98",- "hpc",- "integer-gmp",- "old-locale",- "old-time",- "pretty",- "process",- "random",- "rts",- "template-haskell",- "time",- "unix"]--}---- | 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
@@ -1,463 +0,0 @@--- |--- 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- (- Bundled - , bundledWith- , isBundled- , isLibrary- -- , builtIns- -- , ghc6BuiltIns- , PackageType(..)- , debianName- , versionSplits- , ghcBuiltIns- ) where--import qualified Data.ByteString.Char8 as B-import Data.Char (toLower)-import Data.Function (on)-import Data.List (find, isPrefixOf, sortBy)-import qualified Data.Map as Map-import Data.Maybe (maybeToList, fromJust)-import Data.Version (Version(..))-import Debian.Control(Control'(Control), fieldValue, parseControlFromFile)-import Debian.Relation.ByteString()-import Debian.Relation(Relation(Rel),parseRelations)-import Distribution.InstalledPackageInfo(libraryDirs, sourcePackageId)-import Distribution.Simple.Compiler (Compiler(..), CompilerId(..), CompilerFlavor(..), PackageDB(GlobalPackageDB), compilerFlavor)-import Distribution.Simple.Configure (getInstalledPackages)--- import Distribution.Simple.GHC (getInstalledPackages)-import Distribution.Simple.PackageIndex (PackageIndex, SearchResult(None, Unambiguous), allPackages, searchByName)-import Distribution.Simple.Program (configureAllKnownPrograms, defaultProgramConfiguration)-import Distribution.Package (PackageIdentifier(..), PackageName(..), Dependency(..))-import Distribution.Verbosity(normal)-import Distribution.Version (withinRange, VersionRange(..))---import System.Unix.Chroot (fchroot)---import System.Unix.Process (lazyProcess, collectStdout)---import Data.ByteString.Lazy.Char8 (empty, unpack)-import Text.ParserCombinators.Parsec(ParseError)-import Text.Regex.TDFA ((=~))---- | List the packages bundled with this version of the given--- compiler. If the answer is not known, return the empty list.-bundledWith :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Maybe [PackageIdentifier]-bundledWith builtIns 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 :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Dependency -> Bool-isBundled builtIns c (Dependency pkg version) =- let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) (compilerId c))- in- case find (\(n, k, _) -> (n,k) == cv) builtIns of- Nothing -> False- (Just (_, _, cb)) ->- any checkVersion $ pkgVersion `fmap` filter ((== pkg) . pkgName) cb- where checkVersion = flip withinRange version--type Bundled = (CompilerFlavor, Version, [PackageIdentifier])---- |Return a list of built in packages for the compiler in an environment.--- ghcBuiltIns :: FilePath -> IO [PackageIdentifier]--- ghcBuiltIns root =--- fchroot root (lazyProcess "ghc-pkg" ["list", "--simple-output"] Nothing Nothing empty) >>=--- return . map parsePackageIdentifier . words . unpack . fst . collectStdout--- where--- parsePackageIdentifier s =--- let (v', n') = break (== '-') (reverse s)--- (v, n) = (reverse (tail n'), reverse v') in--- PackageIdentifier (PackageName n) (Version (map read (filter (/= ".") (groupBy (\ a b -> (a == '.') == (b == '.')) v))) [])--ghcBuiltIns :: Compiler -> Bundled-ghcBuiltIns (Compiler {compilerId = CompilerId GHC compilerVersion}) =- case Map.lookup compilerVersion- (Map.fromList [ (Version [7,2,1] [], (GHC, Version [7,2,1] [], ghc721BuiltIns))- , (Version [7,0,4] [], (GHC, Version [7,0,4] [], ghc701BuiltIns))- , (Version [7,0,3] [], (GHC, Version [7,0,3] [], ghc701BuiltIns))- , (Version [7,0,1] [], (GHC, Version [7,0,1] [], ghc701BuiltIns))- , (Version [6,8,3] [], (GHC, Version [6,8,3] [], ghc683BuiltIns))- , (Version [6,8,2] [], (GHC, Version [6,8,2] [], ghc682BuiltIns))- , (Version [6,8,1] [], (GHC, Version [6,8,1] [], ghc681BuiltIns))- , (Version [6,6,1] [], (GHC, Version [6,6,1] [], ghc661BuiltIns))- , (Version [6,6] [], (GHC, Version [6,6] [], ghc66BuiltIns)) ]) of- Nothing -> error $ "cabal-debian: No bundled package list for ghc " ++ show compilerVersion- Just x -> x--_builtIns :: Compiler -> IO [Bundled]-_builtIns compiler = - do ghc6 <- fmap maybeToList $ ghc6BuiltIns compiler- return $ ghc6 ++ [ (GHC, Version [7,2,1] [], ghc721BuiltIns)- , (GHC, Version [7,0,3] [], ghc701BuiltIns)- , (GHC, Version [7,0,1] [], ghc701BuiltIns)- , (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)- ]--_ghc6BuiltIns :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))-_ghc6BuiltIns compiler@(Compiler {compilerId = CompilerId GHC compilerVersion}) =-#ifdef CABAL19- do installedPackages <- _getInstalledPackageIndex compiler- ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc.list"- let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)- return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))-#else- do mInstalledPackages <- getInstalledPackageIndex compiler- case mInstalledPackages of- Nothing -> error "Could not find the installed package database."- (Just installedPackages) ->- do ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc.list"- let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)- return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))-#endif-ghc6BuiltIns _ = return Nothing--_ghc6BuiltIns' :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))-_ghc6BuiltIns' compiler@(Compiler {compilerId = CompilerId GHC compilerVersion}) =- do eDebs <- _ghc6Provides- case eDebs of- Left e -> error e- Right debNames ->-#ifdef CABAL19- do installedPackages <- _getInstalledPackageIndex compiler- let packages = concatMap (\n -> fromRight $ _installedVersions (fromRight $ _extractBaseName n) installedPackages) debNames- return $ Just (GHC, compilerVersion, packages)-#else- do mInstalledPackages <- getInstalledPackageIndex compiler- case mInstalledPackages of- Nothing -> error "Could not find the installed package database."- (Just installedPackages) ->- let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ _extractBaseName n) installedPackages) debNames- in- return $ Just (GHC, compilerVersion, packages)-#endif- where- fromRight (Right r) = r- fromRight (Left e) = error e-_ghc6BuiltIns' (Compiler {}) = return Nothing--_ghc6Provides :: IO (Either String [String])-_ghc6Provides = - do eC <- parseControlFromFile "/var/lib/dpkg/status" :: IO (Either ParseError (Control' B.ByteString))- case eC of- Left e -> return $ Left (show e)- Right (Control c) ->- case find (\p -> fieldValue "Package" p == Just (B.pack "ghc")) c of- Nothing -> return $ Left "You do not seem to have ghc installed."- (Just p) ->- case fieldValue "Provides" p of- Nothing -> return $ Left "Your ghc package does not seem to Provide anything."- (Just p) -> - case parseRelations p of- (Left e) -> return (Left (show e))- (Right relations) ->- return $ Right $ filter (isPrefixOf "libghc-") $ map (\ (Rel pkgName _ _) -> pkgName) (concat relations)---_extractBaseName :: String -> Either String String-_extractBaseName name =- let (_,_,_,subs) = (name =~ "^libghc-(.*)-.*$") :: (String, String, String, [String])- in case subs of- [base] -> Right base- _ -> Left ("When attempt to extract the base name of " ++ name ++ " I found the following matches: " ++ show subs)- ---getInstalledPackageIndex :: Compiler -> IO (Maybe PackageIndex)-_getInstalledPackageIndex compiler =- do pc <- configureAllKnownPrograms normal defaultProgramConfiguration- getInstalledPackages normal compiler [GlobalPackageDB] pc--_installedVersions :: String -> PackageIndex -> Either String [PackageIdentifier]-_installedVersions name packageIndex = - case searchByName packageIndex name of- None -> Left $ "The package " ++ name ++ " does not seem to be installed."- Unambiguous pkgs -> - case sortBy (compare `on` (pkgVersion . sourcePackageId)) pkgs of- [] -> Left $ "Odd. searchByName returned an empty Unambiguous match for " ++ name- ps -> Right (map sourcePackageId ps)- -v :: String -> [Int] -> PackageIdentifier-v n x = PackageIdentifier (PackageName n) (Version x [])--ghc721BuiltIns :: [PackageIdentifier]-ghc721BuiltIns = [- v "Cabal" [1,12,0],- v "array" [0,3,0,3],- v "base" [4,4,0,0],- v "bin-package-db" [0,0,0,0],- v "binary" [0,5,0,2],- v "bytestring" [0,9,2,0],- v "containers" [0,4,1,0],- v "directory" [1,1,0,1],- v "extensible-exceptions" [0,1,1,3],- v "filepath" [1,2,0,1],- v "ghc" [7,2,1],- -- ghc-binary renamed to binary- v "ghc-prim" [0,2,0,0],- v "haskell2010" [1,1,0,0],- v "haskell98" [2,0,0,0],- v "hoopl" [3,8,7,1], -- new- v "hpc" [0,5,1,0],- v "integer-gmp" [0,3,0,0],- v "old-locale" [1,0,0,3],- v "old-time" [1,0,0,7],- v "pretty" [1,1,0,0],- v "process" [1,1,0,0], - -- random removed- v "rts" [1,0],- v "template-haskell" [2,6,0,0],- v "time" [1,2,0,5],- v "unix" [2,5,0,0] ]--ghc701BuiltIns :: [PackageIdentifier]-ghc701BuiltIns = [- v "Cabal" [1,10,0,0],- v "array" [0,3,0,2],- v "base" [4,3,0,0],- v "bin-package-db" [0,0,0,0],- v "bytestring" [0,9,1,8],- v "containers" [0,4,0,0],- v "directory" [1,1,0,0],- v "extensible-exceptions" [0,1,1,2],- v "filepath" [1,2,0,0],- v "ghc" [7,0,1],- v "ghc-binary" [0,5,0,2],- v "ghc-prim" [0,2,0,0],- v "haskell2010" [1,0,0,0],- v "haskell98" [1,1,0,0],- v "hpc" [0,5,0,6],- v "integer-gmp" [0,2,0,2],- v "old-locale" [1,0,0,2],- v "old-time" [1,0,0,6],- v "pretty" [1,0,1,2],- v "process" [1,0,1,4],- v "random" [1,0,0,3],- v "rts" [1,0],- v "template-haskell" [2,5,0,0],- v "time" [1,2,0,3],- v "unix" [2,4,1,0]- ]--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--data PackageType = Source | Development | Profiling | Documentation | Utilities | Extra deriving (Eq, Show)--{--debianName :: PackageType -> PackageName -> Maybe Version -> String-debianName typ (PackageName name) version =- prefix typ ++ foldr f def versionSplits ++ suffix typ- where- f (PackageName n, v, ltName, geName) debName =- if n == name- -- For unversioned dependencies (when version is Nothing),- -- use the name corresponding to the newest version number.- then if maybe True (>= v) version- then geName- else ltName- else debName- -- No splits apply, make the name safe for Debian- def = map fixChar name--}--debianName :: PackageType -> PackageName -> VersionRange -> String-debianName typ (PackageName name) version =- prefix typ ++ foldr f def versionSplits ++ suffix typ- where- f (PackageName n, v, ltName, geName) debName =- if n == name- -- For unversioned dependencies (when version is Nothing),- -- use the name corresponding to the newest version number.- then case version of- AnyVersion -> geName- ThisVersion v' | v' >= v -> geName- ThisVersion _ -> ltName- LaterVersion v' -> geName- EarlierVersion v' | v' >= v -> ltName- EarlierVersion v' -> geName- _ -> error $ "debianName - unexpected version range: " ++ show version- else debName- -- make the name safe for Debian- def = case name of- -- The debian package haskell-src-exts should have been- -- called haskell-haskell-src-exts. Consequently, the- -- binary packages are missing a "haskell-" prefix, so we- -- need to generated dependencies to match.- "haskell-src-exts" -> "src-exts"- _ -> map fixChar name--versionSplits = [(PackageName "parsec", Version [3] [], "parsec2", "parsec3"),- (PackageName "QuickCheck", Version [2] [], "quickcheck1", "quickcheck2")]--suffix Source = ""-suffix Documentation = "-doc"-suffix Development = "-dev"-suffix Profiling = "-prof"-suffix Utilities = "-utils"-suffix Extra = ""--prefix Source = "haskell-"-prefix Documentation = "libghc-"-prefix Development = "libghc-"-prefix Profiling = "libghc-"-prefix Utilities = "haskell-"-prefix Extra = ""--fixChar :: Char -> Char-fixChar '_' = '-'-fixChar c = toLower c
− Distribution/Package/Debian/DebianRelations.hs
@@ -1,102 +0,0 @@--- |This could be made into an instance of PropositionalFormula, but--- it isn't yet.-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PackageImports, StandaloneDeriving, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Distribution.Package.Debian.DebianRelations- ( toFormula- , ofFormula- ) where--import Debian.Relation-import Data.Logic.Logic-import Data.Logic.Propositional.Formula-import Data.Logic.Propositional.Instances.Native---- |There is no such thing as the True or False DebianRelation, so we--- return something meaningless here - the relation is invalid because--- capitalized package names "True" and "False" are invalid. Having--- to implement this is evidence of a weakness in the class structure.-instance Boolean Relation where- fromBool flag = Rel (show flag) Nothing Nothing--toFormula :: Relations -> Formula Relation-toFormula xs =- toFormula' xs- where- toFormula' :: [[Relation]] -> Formula Relation- toFormula' [] = fromBool True- toFormula' [x] = toFormula'' x- toFormula' (x : xs') = toFormula'' x .&. toFormula' xs'-- toFormula'' :: [Relation] -> Formula Relation- toFormula'' [] = fromBool False- toFormula'' [x] = atomic x- toFormula'' (x : xs') = atomic x .|. toFormula'' xs'--ofFormula :: Formula Relation -> [[Relation]]-ofFormula form =- foldF0 c a form- where- -- Turn all the ands into a list- c :: Combine (Formula Relation) -> [[Relation]]- c (BinOp p (:&:) q) = foldF0 c a p ++ foldF0 c a q- c (BinOp p (:|:) q) = [foldF0 c' a' p ++ foldF0 c' a' q]- c ((:~:) p) = [[foldF0 c'' a'' p]]- c _ = error $ "Unexpected c"- a :: Relation -> [[Relation]]- a x = [[x]]-- c' :: Combine (Formula Relation) -> [Relation]- c' (BinOp p (:|:) q) = foldF0 c' a' p ++ foldF0 c' a' q- c' ((:~:) p) = [foldF0 c'' a'' p]- c' _ = error $ "Unexpected c'"- a' :: Relation -> [Relation]- a' x = [x]-- c'' :: Combine (Formula Relation) -> Relation- c'' ((:~:) p) = foldF0 nc na p- c'' _ = error $ "Unexpected c''"- a'' :: Relation -> Relation- a'' x = x-- nc :: Combine (Formula Relation) -> Relation- nc _ = error $ "Unexpected nc"- na :: Relation -> Relation- na (Rel name (Just (SLT v)) arch) = Rel name (Just (GRE v)) arch- na (Rel name (Just (SGR v)) arch) = Rel name (Just (LTE v)) arch- na (Rel name (Just (GRE v)) arch) = Rel name (Just (SLT v)) arch- na (Rel name (Just (LTE v)) arch) = Rel name (Just (SGR v)) arch- na _ = error $ "Unexepected na"--{--instance Negatable Relations where- (.~.) x = ofFormula ((.~.) (toFormula x :: Formula Relation))- negated _ = False--instance PropositionalFormula Relations Relation where- atomic x = [[x]]- foldF0 c a form = foldF0 c a (toFormula form)- asBool x = Nothing--instance Boolean Relations where- fromBool x = error "fromBool Relations"--instance Logic Relations where- x .<=>. y = Combine (BinOp x (:<=>:) y)- x .=>. y = Combine (BinOp x (:=>:) y)- x .|. y = [[x, y]]- x .&. y = [[x], [y]]--prettyPropForm :: (a -> Doc) -> PropForm a -> Doc-prettyPropForm p (A a) = cat [text "(A ", p a, text ")"]-prettyPropForm _ F = text "F"-prettyPropForm _ T = text "T"-prettyPropForm p (N x') = cat [text "(N ", prettyPropForm p x', text ")"]-prettyPropForm p (CJ xs) = cat ([text "(CJ "] ++ map (prettyPropForm p) xs ++ [text ")"])-prettyPropForm p (DJ xs) = cat ([text "(DJ "] ++ map (prettyPropForm p) xs ++ [text ")"])-prettyPropForm p (SJ xs) = cat ([text "(SJ "] ++ map (prettyPropForm p) xs ++ [text ")"])-prettyPropForm p (EJ xs) = cat ([text "(EJ "] ++ map (prettyPropForm p) xs ++ [text ")"])--pretty :: PropForm Relation -> Doc-pretty = prettyPropForm prettyRelation--}
− Distribution/Package/Debian/Main.hs
@@ -1,28 +0,0 @@--- |--- 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/Relations.hs
@@ -1,360 +0,0 @@-{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, PackageImports, ScopedTypeVariables, StandaloneDeriving, TupleSections, TypeSynonymInstances #-}-{-# OPTIONS -Wall -fno-warn-orphans #-}---- |--- 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.Relations- ( allBuildDepends- , debianDependencies- , buildDependencies- , docDependencies- , cabalDependencies- , noVersion- -- , debianRelation- ) where--import Data.Char (isSpace)-import Data.Either (partitionEithers)-import Data.List-import Data.Logic (Logic(..), Boolean(..), Negatable(..), Combine(..), BinOp(..), PropositionalFormula(..))-import Data.Logic.Types.Propositional (Formula(..))---import Distribution.Package.Debian.DebianRelations (toFormula, ofFormula)-import Data.Logic.Classes.Propositional (clauseNormalFormAlt')-import qualified Data.Map as Map-import Data.Maybe-import qualified Data.Set as Set-import Data.Set (Set, member, fromList)-import Data.Version (showVersion)-import qualified Debian.Relation as D-import Debian.Version (DebianVersion, prettyDebianVersion)-import Debian.Version.String-import System.IO.Unsafe (unsafePerformIO)-import System.Process (readProcessWithExitCode)-import System.Unix.Process--import Distribution.Simple.Compiler (Compiler(..))-import Distribution.Package (PackageIdentifier(..), PackageName(..), Dependency(..))-import Distribution.PackageDescription (PackageDescription(..),- allBuildInfo, buildTools, pkgconfigDepends,- extraLibs)-import Distribution.Version (Version(..),VersionRange(..))-import Distribution.Package.Debian.Setup (Flags(..))-import Distribution.Package.Debian.Bundled (Bundled, isBundled, PackageType(..), debianName, versionSplits, ghcBuiltIns {-, builtIns, ghc6BuiltIns-})--instance Show DebianVersion where- show = show . prettyDebianVersion--{--deriving instance Show D.VersionReq-deriving instance Show D.ArchitectureReq-deriving instance Show D.Relation--}--cabalDependencies :: PackageDescription -> [Dependency]-cabalDependencies pkgDesc = map unboxDependency $ allBuildDepends pkgDesc---- |Debian packages don't have per binary package build dependencies,--- so we just gather them all up here.-allBuildDepends :: PackageDescription -> [Dependency_]-allBuildDepends pkgDesc =- nub $ map BuildDepends (buildDepends pkgDesc) ++- concat (map (map BuildTools . buildTools) (allBuildInfo pkgDesc) ++- map- (map PkgConfigDepends . pkgconfigDepends)- (allBuildInfo pkgDesc) ++- map (map ExtraLibs . extraLibs) (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 :: Flags -> Bundled -> Compiler -> (Flags -> Compiler -> Dependency_ -> D.Relations) -> Dependency_ -> D.Relations-debianDependencies _ bundled compiler _toDebRels dep- | isBundled [bundled] compiler $ unboxDependency dep = []-debianDependencies flags _ compiler toDebRels dep = toDebRels flags compiler dep---- The build dependencies for a package include the profiling--- libraries and the documentation packages, used for creating cross--- references.-buildDependencies :: Flags -> Compiler -> Dependency_ -> D.Relations-buildDependencies _ compiler (BuildDepends (Dependency name _ranges)) | member name (base compiler) = []-buildDependencies flags _ (BuildDepends (Dependency name ranges)) =- debianRelations flags Development name ranges ++ debianRelations flags Profiling name ranges-buildDependencies flags _ dep@(ExtraLibs _) =- concat (map (\ x -> debianRelations flags Extra x AnyVersion) $ adapt flags dep)-buildDependencies flags _ dep =- concat (map (\ x -> debianRelations flags Extra x ranges) $ adapt flags dep)- where (Dependency _name ranges) = unboxDependency dep--adapt :: Flags -> Dependency_ -> [PackageName]-adapt flags (PkgConfigDepends (Dependency (PackageName pkg) _)) =- maybe (aptFile pkg) (\ x -> [PackageName x]) (Map.lookup pkg (execMap flags))-adapt flags (BuildTools (Dependency (PackageName pkg) _)) =- maybe (aptFile pkg) (\ x -> [PackageName x]) (Map.lookup pkg (execMap flags))-adapt flags (ExtraLibs x) =- [PackageName (fromMaybe ("lib" ++ x ++ "-dev") (Map.lookup x (libMap flags)))]--- adapt _ dep = [name] where (Dependency name _) = unboxDependency dep-adapt _flags (BuildDepends (Dependency pkg _)) = [pkg]---- |There are two reasons this may not work, or may work--- incorrectly: (1) the build environment may be a different--- distribution than the parent environment (the environment the--- autobuilder was run from), so the packages in that--- environment might have different names, and (2) the package--- we are looking for may not be installed in the parent--- environment.-aptFile :: String -> [PackageName]-aptFile pkg =- unsafePerformIO $- do ret <- readProcessWithExitCode "apt-file" ["-l", "search", pkg ++ ".pc"] ""- return $ case ret of- (ExitSuccess, out, _) -> [PackageName (takeWhile (not . isSpace) out)]- _ -> []-{--adapt (ExtraLibs "gcrypt") = [PackageName "libgcrypt11-dev"]--}---- 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 :: Flags -> Compiler -> Dependency_ -> D.Relations-docDependencies- flags- compiler- (BuildDepends (Dependency name ranges))- = concat- (map- (\ x -> debianRelations flags Documentation x ranges)- $ filter (not . flip member (base compiler)) [name])-docDependencies _ _ _ = []--base :: Compiler -> Set PackageName-base compiler =- Data.Set.fromList (let {- (Just (_, _, xs)) = unsafePerformIO (ghc6BuiltIns compiler) -} (_, _, xs) = ghcBuiltIns compiler in map pkgName xs)--{--instance Show DebianVersion where- show = show . show . prettyDebianVersion-deriving instance Show D.ArchitectureReq-deriving instance Show D.VersionReq-deriving instance Show D.Relation--deriving instance Show (Formula D.Relation)-deriving instance Show (Combine (Formula D.Relation))--}--{---- |Improper subset function for VersionRange - just covering some simple cases for now.-subset :: VersionRange -> VersionRange -> Bool-subset _ AnyVersion = True-subset (ThisVersion v1) (LaterVersion v2) = v1 > v2-subset (ThisVersion v1) (EarlierVersion v2) = v1 < v2-subset (LaterVersion v1) (LaterVersion v2) = v1 >= v2-subset (EarlierVersion v1) (EarlierVersion v2) = v1 <= v2-subset _ _ = False--}---- FIXME: we don't run split-debianRelations :: Flags -> PackageType -> PackageName -> VersionRange -> D.Relations-debianRelations _flags typ name range =- convert'' . simplify . map Set.toList . Set.toList . clauseNormalFormAlt' . expand $ range- -- map (map convert) . t4 . simplify . t3 . flatten . clauseNormalForm . t2 . split . t1 . expand $ range- -- t3 $ debianRelation typ name range- where- -- Split up relations where the versionSplits list tells us.- -- Doesn't handle the package names, only the version numbers- split :: VersionRange -> VersionRange- split range' = foldr split' range' versionSplits- split' (n, v, _, _) range' =- split'' range'- where- split'' x | n /= name = x- split'' (ThisVersion v') = ThisVersion v'- split'' AnyVersion = UnionVersionRanges (EarlierVersion v) AnyVersion- split'' (EarlierVersion version) | v <= version = EarlierVersion v- split'' (EarlierVersion version) | v > version = UnionVersionRanges (EarlierVersion v) (EarlierVersion version)- split'' (LaterVersion version) | v <= version = (LaterVersion version)- split'' (LaterVersion version) | v >= version = UnionVersionRanges (LaterVersion v) (LaterVersion version)- split'' (UnionVersionRanges range1 range2) = UnionVersionRanges (split'' range1) (split'' range2)- split'' (IntersectVersionRanges range1 range2) = IntersectVersionRanges (split'' range1) (split'' range2)- split'' x = error $ "split'' " ++ show x- convert'' :: [[VersionRange]] -> [[D.Relation]]- -- Because fromBool True returns AnyVersion, we will get an empty list- -- in the result where there was an AnyVersion by itself.- convert'' ([] : xss) = convert'' $ [AnyVersion] : xss- convert'' (xs : xss) = convert' xs : convert'' xss- convert'' [] = []-- convert' :: [VersionRange] -> [D.Relation]- convert' [] = []- convert' (ThisVersion v1 : LaterVersion v2 : xs) | v1 == v2 = D.Rel (debianName typ name (ThisVersion v1)) (Just (D.GRE (parseDebianVersion (showVersion v1)))) Nothing : convert' xs- convert' (AnyVersion : EarlierVersion v : xs) = D.Rel (debianName typ name (EarlierVersion v)) (Just (D.SLT (parseDebianVersion (showVersion v)))) Nothing : convert' xs- convert' (x : xs) = convert x : convert' xs-- convert :: VersionRange -> D.Relation- convert AnyVersion = D.Rel (debianName typ name AnyVersion) Nothing Nothing- convert (ThisVersion version) = D.Rel (debianName typ name (ThisVersion version)) (Just (D.EEQ (parseDebianVersion (showVersion version)))) Nothing- convert (EarlierVersion version) = D.Rel (debianName typ name (EarlierVersion version)) (Just (D.SLT (parseDebianVersion (showVersion version)))) Nothing- convert (LaterVersion version) = D.Rel (debianName typ name (LaterVersion version)) (Just (D.SGR (parseDebianVersion (showVersion version)))) Nothing- convert x = error $ "convert'' " ++ show x--- -- This still doesn't work correctly. But we may be able to build with it.- simplify :: [[VersionRange]] -> [[VersionRange]]- simplify xss = simplifyAnds (map simplifyOrs xss)- -- Try to merge every pair- simplifyOrs :: [VersionRange] -> [VersionRange]- simplifyOrs [] = []- simplifyOrs (x : xs) =- case partitionEithers (map (mergeOrs x) (map Left (simplifyOrs xs))) of- -- Nothing to merge with- ([], []) -> [x]- -- If x merged with anything re-run with newly merged results- ([], merged) -> simplifyOrs merged- -- If x does not merge just return- (_, _) -> x : xs-- simplifyAnds :: [[VersionRange]] -> [[VersionRange]]- simplifyAnds [] = []- simplifyAnds (x : xs) =- case partitionEithers (map (mergeAnds x) (map Left (simplifyAnds xs))) of- ([], []) -> [x]- ([], merged) -> simplifyAnds merged- (_, _) -> x : xs---- |Replace ThisVersion with WildcardVersion so we can safely add--- suffixes to generate debian version numbers.-expand (ThisVersion version) = expand (WildcardVersion version)-expand (WildcardVersion version) =- (IntersectVersionRanges- (UnionVersionRanges (ThisVersion version) (LaterVersion version))- (EarlierVersion (upperBound version)))--- Some obvious simplifications-expand (UnionVersionRanges range1 range2) | range1 == range2 = expand range1-expand (UnionVersionRanges AnyVersion _) = AnyVersion-expand (UnionVersionRanges _ AnyVersion) = AnyVersion-expand (UnionVersionRanges range1 range2) = UnionVersionRanges (expand range1) (expand range2)-expand (IntersectVersionRanges range1 range2) | range1 == range2 = expand range1-expand (IntersectVersionRanges range1 AnyVersion) = expand range1-expand (IntersectVersionRanges AnyVersion range2) = expand range2-expand (IntersectVersionRanges range1 range2) = IntersectVersionRanges (expand range1) (expand range2)-expand (VersionRangeParens range) = expand range-expand x = x---- Assumes we are in CNF-flatten :: VersionRange -> [[VersionRange]]-flatten (IntersectVersionRanges a b) = flatten a ++ flatten b-flatten x = [flatten' x]-flatten' :: VersionRange -> [VersionRange]-flatten' (UnionVersionRanges a b) = flatten' a ++ flatten' b-flatten' x = [x]--{--mergeOrs :: [VersionRange] -> VersionRange-mergeOrs rs = foldr mergeOrs map rs--}--mergeAnds :: [VersionRange] -> Either [VersionRange] [VersionRange] -> Either [VersionRange] [VersionRange]-mergeAnds [AnyVersion] (Left x) = Right x-mergeAnds x (Left [AnyVersion]) = Right x-mergeAnds x y = y--mergeOrs :: VersionRange -> Either VersionRange VersionRange -> Either VersionRange VersionRange-mergeOrs AnyVersion _ = Right AnyVersion-mergeOrs x (Left y) | x == noVersion = Right x-mergeOrs x (Left y) | y == noVersion = Right y-mergeOrs _ (Left AnyVersion) = Right AnyVersion-mergeOrs (ThisVersion v1) (Left x@(ThisVersion v2)) = if v1 == v2 then Right (ThisVersion v1) else Left x-mergeOrs (ThisVersion v1) (Left x@(EarlierVersion v2)) = if v1 < v2 then Right (EarlierVersion v2) else Left x-mergeOrs (ThisVersion v1) (Left x@(LaterVersion v2)) = if v1 > v2 then Right (LaterVersion v2) else Left x-mergeOrs (ThisVersion v1) (Left x@(EarlierVersion v2)) = if v1 < v2 then Right (EarlierVersion v2) else Left x-mergeOrs (ThisVersion v1) (Left x@(LaterVersion v2)) = if v1 > v2 then Right (LaterVersion v2) else Left x-mergeOrs (EarlierVersion v1) (Left x@(LaterVersion v2)) = if v1 > v2 then Right AnyVersion else Left x-mergeOrs (LaterVersion v2) (Left x@(EarlierVersion v1)) = if v1 > v2 then Right AnyVersion else Left x-mergeOrs (EarlierVersion v1) (Left (EarlierVersion v2)) = Right (EarlierVersion (max v1 v2))-mergeOrs (LaterVersion v1) (Left (LaterVersion v2)) = Right (LaterVersion (min v1 v2))-mergeOrs (EarlierVersion v1) (Left x@(ThisVersion v2)) = if v2 < v1 then Right (EarlierVersion v1) else Left x-mergeOrs (LaterVersion v1) (Left x@(ThisVersion v2)) = if v1 < v2 then Right (LaterVersion v1) else Left x-mergeOrs x y = error $ "merge2 " ++ show x ++ " " ++ show y--data Dependency_- = BuildDepends Dependency- | BuildTools Dependency- | PkgConfigDepends Dependency- | ExtraLibs String- deriving (Eq, Show)--unboxDependency :: Dependency_ -> Dependency-unboxDependency (BuildDepends d) = d-unboxDependency (BuildTools d) = d-unboxDependency (PkgConfigDepends d) = d-unboxDependency (ExtraLibs d) = Dependency (PackageName d) AnyVersion--{---- | 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--}--deriving instance Ord VersionRange--instance Logic VersionRange where- a .|. b = UnionVersionRanges a b--instance Negatable VersionRange where- (.~.) (VersionRangeParens r) = (.~.) r- (.~.) AnyVersion = fromBool False- (.~.) (ThisVersion v) = UnionVersionRanges (EarlierVersion v) (LaterVersion v)- (.~.) (EarlierVersion v) = UnionVersionRanges (ThisVersion v) (LaterVersion v)- (.~.) (LaterVersion v) = UnionVersionRanges (EarlierVersion v) (ThisVersion v)- (.~.) (WildcardVersion v) = (.~.) (IntersectVersionRanges (UnionVersionRanges (ThisVersion v) (LaterVersion v)) (EarlierVersion (upperBound v)))- -- These three are not necessary, but may keep thing neater.- (.~.) (UnionVersionRanges (EarlierVersion v1) (LaterVersion v2)) | v1 == v2 = ThisVersion v1- (.~.) (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) | v1 == v2 = EarlierVersion v1- (.~.) (UnionVersionRanges (EarlierVersion v1) (ThisVersion v2)) | v1 == v2 = LaterVersion v1-{- (.~.) (IntersectVersionRanges (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) (EarlierVersion v3))- | v1 == v2 && v3 == upperBound v1 = WildcardVersion v1 -}- -- Inversion of & and |- (.~.) (UnionVersionRanges r1 r2) = IntersectVersionRanges ((.~.) r1) ((.~.) r2)- (.~.) (IntersectVersionRanges r1 r2) = UnionVersionRanges ((.~.) r1) ((.~.) r2)- negated _ = False---- FIXME: the noVersion value, if present in the final set of--- dependencies, leads to empty version numbers. We need a better way--- to simplify the relations than the simplify function in--- debianRelations.-instance Boolean VersionRange where- fromBool True = AnyVersion- fromBool False = noVersion--instance PropositionalFormula VersionRange VersionRange where- atomic x = x- foldPropositional c _ (IntersectVersionRanges r1 r2) = c (BinOp r1 (:&:) r2)- foldPropositional c _ (UnionVersionRanges r1 r2) = c (BinOp r1 (:|:) r2)- foldPropositional _ a x = a x--noVersion = ThisVersion (Version {versionBranch = [], versionTags = []})--{-- asBool f =- foldF0 (const Nothing) (\ x -> case x of- AnyVersion -> Just True- ThisVersion (Version {versionBranch = [], versionTags = []}) -> Just False- _ -> Nothing) f--}--upperBound :: Version -> Version-upperBound v =- v { versionBranch = bump (versionBranch v) }- where bump = reverse . (zipWith (+) (1:(repeat 0))) . reverse
− Distribution/Package/Debian/Setup.hs
@@ -1,199 +0,0 @@--- |--- 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.Arrow (second)-import Control.Monad (when)-import Data.Char (toLower)-import qualified Data.Map as Map-import Data.Version (Version, parseVersion)-import Distribution.Compiler (CompilerFlavor(..))-import Distribution.ReadE (readEOrFail)-import Distribution.PackageDescription (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)-import Text.ParserCombinators.ReadP (readP_to_S)--data Flags = Flags- {- rpmPrefix :: FilePath- , rpmCompiler :: CompilerFlavor- , rpmCompilerVersion :: Maybe Version- , rpmConfigurationsFlags :: [(FlagName, Bool)]- , rpmHaddock :: Bool- , rpmHelp :: Bool- , debLibProf :: Bool- , rpmName :: Maybe String- , rpmOptimisation :: Bool- , rpmRelease :: Maybe String- , rpmSplitObjs :: Bool- , debOutputDir :: FilePath- , buildRoot :: FilePath- , rpmVerbosity :: Verbosity- , rpmVersion :: Maybe String- , debMaintainer :: Maybe String- , debAction :: DebAction- , buildDeps :: [String]- -- , debName :: Maybe String- , debVersion :: Maybe String- , epoch :: Maybe Int- , execMap :: Map.Map String String- , libMap :: Map.Map String String- , omitLTDeps :: Bool- }- 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- , rpmCompilerVersion = Nothing- , rpmConfigurationsFlags = []- , rpmHaddock = True- , rpmHelp = False- , debLibProf = True- , rpmName = Nothing- , rpmOptimisation = True- , rpmRelease = Nothing- , rpmSplitObjs = True- , debOutputDir = "./debian"- , buildRoot = "/"- , rpmVerbosity = normal- , rpmVersion = Nothing- , debMaintainer = Nothing- , debAction = Usage- , buildDeps = []- -- , debName = Nothing- , debVersion = Nothing- , epoch = Nothing- , execMap = Map.empty- , libMap = Map.empty- , omitLTDeps = False- }--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 "" ["ghc-version"] (ReqArg (\ ver x -> x { rpmCompilerVersion = Just (last (map fst (readP_to_S parseVersion ver)))}) "VERSION")- "Version of GHC in build environment",- 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 "" ["root"] (ReqArg (\ path x -> x { buildRoot = path }) "BUILDROOT")- "Use the compiler information in the given build environment.",- 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 "" ["build-dep"] (ReqArg (\ name x -> x {buildDeps = name : (buildDeps x)}) "Debian binary package name")- "Specify a package to add to the build dependency list in debian/control, e.g. '--build-dep libglib2.0-dev'.",- -- Option "" ["deb-name"] (ReqArg (\ name x -> x {debName = Just name}) "NAME")- -- "Specify the base name of the debian package, the part between 'libghc-' and '-dev'. Normally this is the downcased cabal name.",- Option "" ["deb-version"] (ReqArg (\ version x -> x {debVersion = Just version}) "VERSION")- "Specify the version number for the debian package. This will pin the version and should be considered dangerous.",- Option "" ["epoch"] (ReqArg (\ n x -> x {epoch = Just (read n)}) "DIGIT")- "Specify the an epoch number for the package version number.",- 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.",- Option "" ["exec-map"] (ReqArg (\ s x -> x {execMap = (uncurry Map.insert) (second tail (span (/= '=') s)) (execMap x)}) "EXECNAME=DEBIANNAME")- "When we see the given executable name in the cabal file, add a build dependency on the associated debian package name. E.g. --exec-map gtk2hsC2hs=gtk2hs-buildtools",- Option "" ["lib-map"] (ReqArg (\ s x -> x {libMap = (uncurry Map.insert) (second tail (span (/= '=') s)) (libMap x)}) "LIBNAME=DEBIANNAME")- "When we see the given library name in the cabal file, add a build dependency on the associated debian package name. E.g. --lib-map crypto=libcrypto++-dev",- Option "" ["omit-lt-deps"] (NoArg (\x -> x { omitLTDeps = True }))- "Don't generate the << dependency when we see a cabal equals dependency."- ]---- 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
cabal-debian.cabal view
@@ -1,5 +1,5 @@ Name: cabal-debian-Version: 1.3+Version: 1.5 License: BSD3 License-File: debian/copyright Author: David Fox <dsf@seereason.com>
− cabal-debian.cabal~
@@ -1,29 +0,0 @@-Name: cabal-debian-Version: 1.3-License: BSD3-License-File: debian/copyright-Author: David Fox <dsf@seereason.com>-Category: System-Maintainer: David Fox <dsf@seereason.com>-Homepage: http://src.seereason.com/cabal-debian-Build-Type: Simple-Synopsis: Create a debianization for a cabal package-Cabal-Version: >= 1.6-Description:- A program which creates a debian subdirectory containing the required- files to build a deb.--Flag cabal19- Description: True if Cabal >= 1.9 is available--Executable cabal-debian- Main-is: CabalDebian.hs- ghc-options: -threaded -W- Build-Depends: base, bytestring, Cabal >= 1.6.0.1, containers, debian >= 3.60, directory, filepath, logic-classes >= 0.44, mtl, parsec >= 3, pretty, process, regex-tdfa, unix, Unixutils, utf8-string- Extensions: ExistentialQuantification CPP- if flag(cabal19)- build-depends: Cabal >= 1.9- cpp-options: -DCABAL19- else- build-depends: Cabal >= 1.8- cpp-options: -DCABAL18
− debian/cabal-debian.1
@@ -1,120 +0,0 @@-.\"Original page generated by txt2man and then hacked extensively.-.TH CABAL-DEBIAN 1 "May 10, 2010"--.SH NAME-cabal-debian \- create Debian package meta data from a Haskell cabal file.--.SH SYNOPSIS-.B cabal-debian-.RI [flags]--.SH DESCRIPTION-cabal-debian will generated the Debian meta data for a Debian package from the-cabal file of a Haskell package. The program expects to find the package's-<pkgname>.cabal file in the directory from which it was run.--.TP-.B-\fB--prefix=PATH\fP-Pass this prefix if we need to configure the package--.TP-.B-\fB--ghc\fP-Compile with GHC.--.TP-.B-\fB--hugs\fP-Compile with HUGS.--.TP-.B-\fB--jhc\fP-Compile with JHC.--.TP-.B-\fB--nhc\fP-Compile with NHC.--.TP-.B-\fB-h, -?, \-\-help\fP-Show this help text.--.TP-.B-\fB--name\fP=NAME-Override the default package name.-.TP-.B-\fB--disable-haddock\fP-Don't generate API docs.-.TP-.B-\fB--disable-library-profiling\fP-Don't generate profiling libraries.-.TP-.B-\fB--disable-optimization\fP-Don't generate optimised code.--.TP-.B-\fB--disable-split-objs\fP-Don't split object files to save space.--.TP-.B-\fB-f\fP FLAGS, \fB--flags\fP=FLAGS-Set given flags in Cabal conditionals.--.TP-.B-\fB--release\fP=RELEASE-Override the default package release.--.TP-.B-\fB--debdir\fP=DEBDIR-Override the default output directory ("./debian").--.TP-.B-\fB-v n,q \fB--verbose=n\fP-Change build verbosity.--.TP-.B-\fB--version\fP=VERSION-Override the default package version.--.TP-.B-\fB--maintainer\fP=Maintainer Name <email addr>-Override the Maintainer name and email in $DEBEMAIL/$EMAIL/$DEBFULLNAME/$FULLNAME.--.TP-.B-\fB--debianize\fP-Generate a new debianization, replacing any existing one. One of-\fB--debianize\fP, \fB--substvar\fP, or \fB--update-debianization\fP is-required.--.TP-.B-\fB--substvar\fP=Doc, Prof, or Dev-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.--.TP-.B-\fB--update-debianization\fP-Update an existing debianization.--.SH AUTHOR-This manual page was originally written by Erik de Castro Lopo -<erikd@mega-nerd.com> for the Debian GNU/Linux system (but may be used by -others).
− debian/cabal-debian.manpages
@@ -1,1 +0,0 @@-debian/*.1
− debian/changelog
@@ -1,32 +0,0 @@-haskell-cabal-debian (1.3) unstable; urgency=low-- * Fix error message when compiler version is not in bundled package list.- * Add bundled package list for compiler 7.0.4 (same as 7.0.3.)-- -- David Fox <dsf@seereason.com> Sat, 08 Oct 2011 07:58:19 -0700--haskell-cabal-debian (1.2) unstable; urgency=low-- * When computing the debian name from a package's cabal name, if we- have no particular version number we are comparing to, use the name- from the version split that corresponds to newer version numbers.- * Add code to make the cabal package haskell-src-exts map to the debian- packages libghc-src-exts-dev etc. Normally it would map to- libghc-haskell-src-exts-dev.-- -- David Fox <dsf@seereason.com> Thu, 06 Oct 2011 09:27:02 -0700--haskell-cabal-debian (1.1) unstable; urgency=low-- * Use propositional logic package to compute normal form for dependencies- * Make sure to correct format of cabal package synopsis before using as debian- package description.-- -- David Fox <dsf@seereason.com> Fri, 30 Sep 2011 06:16:34 -0700--haskell-cabal-debian (1.0) unstable; urgency=low-- * Debianization generated by cabal-debian-- -- David Fox <dsf@seereason.com> Sun, 18 Sep 2011 06:40:21 -0700-
− debian/compat
@@ -1,1 +0,0 @@-7
− debian/control
@@ -1,43 +0,0 @@-Source: haskell-cabal-debian-Priority: extra-Section: haskell-Maintainer: David Fox <dsf@seereason.com>-Build-Depends: debhelper (>= 7.0),- haskell-devscripts (>= 0.8),- cdbs,- ghc,- ghc-prof,- libghc-unixutils-dev,- libghc-unixutils-prof,- libghc-debian-dev (>= 3.59),- libghc-debian-prof (>= 3.59),- libghc-mtl-dev,- libghc-mtl-prof,- libghc-parsec3-dev (<< 4) | libghc-parsec3-dev (>= 3) | libghc-parsec3-dev (>= 3),- libghc-parsec3-prof (<< 4) | libghc-parsec3-prof (>= 3) | libghc-parsec3-prof (>= 3),- libghc-logic-classes-dev (>= 0.44),- libghc-logic-classes-prof (>= 0.44),- libghc-regex-tdfa-dev,- libghc-regex-tdfa-prof,- libghc-utf8-string-dev,- libghc-utf8-string-prof-Build-Depends-Indep: ghc-doc,- libghc-unixutils-doc,- libghc-debian-doc (>= 3.59),- libghc-mtl-doc,- libghc-parsec3-doc (<< 4) | libghc-parsec3-doc (>= 3) | libghc-parsec3-doc (>= 3),- libghc-logic-classes-doc,- libghc-regex-tdfa-doc,- libghc-utf8-string-doc-Standards-Version: 3.9.1-Homepage: http://src.seereason.com/cabal-debian--Package: cabal-debian-Architecture: any-Section: misc-Depends: ${shlibs:Depends}, ${haskell:Depends}, ${misc:Depends}, apt-file-Conflicts: haskell-debian-utils (<< 3.59)-Description: Create a debianization for a cabal package- Tool for creating debianizations of Haskell packages based on the .cabal- file. If apt-file is installed it will use it to discover what is the- debian package name of a C library.
− debian/rules
@@ -1,14 +0,0 @@-#!/usr/bin/make -f--DEB_CABAL_PACKAGE = cabal-debian--include /usr/share/cdbs/1/rules/debhelper.mk-include /usr/share/cdbs/1/class/hlibrary.mk--build/cabal-debian:: build-ghc-stamp-binary-fixup/cabal-debian::- install -m 755 -s -D dist-ghc/build/cabal-debian/cabal-debian debian/cabal-debian/usr/bin/cabal-debian || true--# How to install an extra file into the documentation package-#binary-fixup/libghc-cabal-debian-doc::-# echo "Some informative text" > debian/libghc-cabal-debian-doc/usr/share/doc/libghc-cabal-debian-doc/AnExtraDocFile