diff --git a/Distribution/Package/Debian.hs b/Distribution/Package/Debian.hs deleted file mode 100644 --- a/Distribution/Package/Debian.hs +++ /dev/null @@ -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 --- 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 -, --- 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-.a and libHS-_p.a. We can --- determine the debian package names by running dpkg -S on these --- names, or examining the /var/lib/dpkg/info/\*.list files. From --- these we can determine the source package name, and from that --- the documentation package name. -substvars :: PackageDescription -- ^info from the .cabal file - -> Compiler -- ^compiler details - -> DebMap - -> Control -- ^The debian/control file - -> Map.Map String PackageInfo -- ^The list of installed cabal packages - -> DebType -- ^The type of deb we want to write substvars for - -> IO () -substvars pkgDesc _compiler _debVersions control cabalPackages debType = - case (missingBuildDeps, path) of - -- There should already be a .substvars file produced by dh_haskell_prep, - -- keep the relations listed there. They will contain something like this: - -- 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 ", 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" diff --git a/Distribution/Package/Debian/Bundled.hs b/Distribution/Package/Debian/Bundled.hs deleted file mode 100644 --- a/Distribution/Package/Debian/Bundled.hs +++ /dev/null @@ -1,463 +0,0 @@ --- | --- Module : Distribution.Package.Debian.Bundled --- Copyright : David Fox 2008 --- --- Maintainer : David Fox --- Stability : alpha --- Portability : portable --- --- Determine whether a specific version of a Haskell package is --- bundled with into this particular version of the given compiler. - --- This software may be used and distributed according to the terms of --- the GNU General Public License, incorporated herein by reference. - -module Distribution.Package.Debian.Bundled - ( - 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 diff --git a/Distribution/Package/Debian/DebianRelations.hs b/Distribution/Package/Debian/DebianRelations.hs deleted file mode 100644 --- a/Distribution/Package/Debian/DebianRelations.hs +++ /dev/null @@ -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 --} diff --git a/Distribution/Package/Debian/Main.hs b/Distribution/Package/Debian/Main.hs deleted file mode 100644 --- a/Distribution/Package/Debian/Main.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | --- Module : Distribution.Package.Debian.Main --- Copyright : David Fox 2008 --- --- Maintainer : David Fox --- Stability : alpha --- Portability : portable --- --- Explanation: Main entry point for Debianizer of Cabal packages. - --- This software may be used and distributed according to the terms of --- the GNU General Public License, incorporated herein by reference. - -module Distribution.Package.Debian.Main where - -import Distribution.PackageDescription.Parse (readPackageDescription) -import Distribution.Package.Debian (debian) -import Distribution.Package.Debian.Setup (Flags (..), parseArgs) -import Distribution.Simple.Utils (defaultPackageDesc) -import System.Environment (getArgs) - -main :: IO () - -main = do opts <- getArgs >>= parseArgs - let verbosity = rpmVerbosity opts - descPath <- defaultPackageDesc verbosity - pkgDesc <- readPackageDescription verbosity descPath - debian pkgDesc opts diff --git a/Distribution/Package/Debian/Relations.hs b/Distribution/Package/Debian/Relations.hs deleted file mode 100644 --- a/Distribution/Package/Debian/Relations.hs +++ /dev/null @@ -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 --- 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 diff --git a/Distribution/Package/Debian/Setup.hs b/Distribution/Package/Debian/Setup.hs deleted file mode 100644 --- a/Distribution/Package/Debian/Setup.hs +++ /dev/null @@ -1,199 +0,0 @@ --- | --- Module : Distribution.Package.Debian.Setup --- Copyright : David Fox 2008 --- --- Maintainer : David Fox --- Stability : alpha --- Portability : portable --- --- Explanation: Command line option processing for building RPM --- packages. - --- This software may be used and distributed according to the terms of --- the GNU General Public License, incorporated herein by reference. - -module Distribution.Package.Debian.Setup ( - Flags(..) - , DebAction(..) - , DebType(..) - , parseArgs - ) where - -import Control.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 ") - "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 diff --git a/cabal-debian.cabal b/cabal-debian.cabal --- a/cabal-debian.cabal +++ b/cabal-debian.cabal @@ -1,5 +1,5 @@ Name: cabal-debian -Version: 1.3 +Version: 1.5 License: BSD3 License-File: debian/copyright Author: David Fox diff --git a/cabal-debian.cabal~ b/cabal-debian.cabal~ deleted file mode 100644 --- a/cabal-debian.cabal~ +++ /dev/null @@ -1,29 +0,0 @@ -Name: cabal-debian -Version: 1.3 -License: BSD3 -License-File: debian/copyright -Author: David Fox -Category: System -Maintainer: David Fox -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 diff --git a/debian/cabal-debian.1 b/debian/cabal-debian.1 deleted file mode 100644 --- a/debian/cabal-debian.1 +++ /dev/null @@ -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 -.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 -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 - for the Debian GNU/Linux system (but may be used by -others). diff --git a/debian/cabal-debian.manpages b/debian/cabal-debian.manpages deleted file mode 100644 --- a/debian/cabal-debian.manpages +++ /dev/null @@ -1,1 +0,0 @@ -debian/*.1 diff --git a/debian/changelog b/debian/changelog deleted file mode 100644 --- a/debian/changelog +++ /dev/null @@ -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 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 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 Fri, 30 Sep 2011 06:16:34 -0700 - -haskell-cabal-debian (1.0) unstable; urgency=low - - * Debianization generated by cabal-debian - - -- David Fox Sun, 18 Sep 2011 06:40:21 -0700 - diff --git a/debian/compat b/debian/compat deleted file mode 100644 --- a/debian/compat +++ /dev/null @@ -1,1 +0,0 @@ -7 diff --git a/debian/control b/debian/control deleted file mode 100644 --- a/debian/control +++ /dev/null @@ -1,43 +0,0 @@ -Source: haskell-cabal-debian -Priority: extra -Section: haskell -Maintainer: David Fox -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. diff --git a/debian/rules b/debian/rules deleted file mode 100644 --- a/debian/rules +++ /dev/null @@ -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