[Pkg-haskell-commits] darcs: cabal-debian: Initial Check-In
Clint Adams
clint at debian.org
Fri May 18 02:28:51 UTC 2012
Fri May 18 02:28:56 UTC 2012 Clint Adams <clint at debian.org>
* Initial Check-In
Ignore-this: 463c0f0ea1b768e35f6df3b103dd32ee
A ./changelog
A ./control
A ./copyright
A ./patches/
A ./patches/missing-distribution-package-debian.diff
A ./patches/series
A ./rules
A ./source/
A ./source/format
Fri May 18 02:28:56 UTC 2012 Clint Adams <clint at debian.org>
* Initial Check-In
Ignore-this: 463c0f0ea1b768e35f6df3b103dd32ee
diff -rN -u old-cabal-debian//changelog new-cabal-debian//changelog
--- old-cabal-debian//changelog 1970-01-01 00:00:00.000000000 +0000
+++ new-cabal-debian//changelog 2012-05-18 02:28:51.157326618 +0000
@@ -0,0 +1,5 @@
+cabal-debian (1.21-1) unstable; urgency=low
+
+ * Initial release.
+
+ -- Clint Adams <clint at debian.org> Thu, 17 May 2012 22:07:00 -0400
diff -rN -u old-cabal-debian//control new-cabal-debian//control
--- old-cabal-debian//control 1970-01-01 00:00:00.000000000 +0000
+++ new-cabal-debian//control 2012-05-18 02:28:51.157326618 +0000
@@ -0,0 +1,34 @@
+Source: cabal-debian
+Priority: extra
+Section: haskell
+Maintainer: Debian Haskell Group <pkg-haskell-maintainers at lists.alioth.debian.org>
+Uploaders: Clint Adams <clint at debian.org>
+Build-Depends: debhelper (>= 7.0)
+ , haskell-devscripts (>= 0.8)
+ , ghc
+ , ghc-prof
+ , libghc-unixutils-dev (>> 1.50)
+ , libghc-unixutils-prof
+ , libghc-debian-dev (>> 3.63)
+ , libghc-debian-prof
+ , libghc-mtl-dev
+ , libghc-mtl-prof
+ , libghc-parsec3-dev
+ , libghc-parsec3-prof
+ , libghc-regex-tdfa-dev
+ , libghc-regex-tdfa-prof
+ , libghc-utf8-string-dev
+ , libghc-utf8-string-prof
+Standards-Version: 3.9.3
+Homepage: http://src.seereason.com/cabal-debian
+
+Package: cabal-debian
+Architecture: any
+Section: utils
+Depends: ${shlibs:Depends}, ${haskell:Depends}, ${misc:Depends}
+Recommends: 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 -rN -u old-cabal-debian//copyright new-cabal-debian//copyright
--- old-cabal-debian//copyright 1970-01-01 00:00:00.000000000 +0000
+++ new-cabal-debian//copyright 2012-05-18 02:28:51.157326618 +0000
@@ -0,0 +1,40 @@
+This package was debianized by David Fox
+<dsf at seereason.com> on September 18, 2007.
+
+The packageing was adjusted to Debian conventions by Joachim Breitner
+<nomeata at debian.org> on Sat, 01 May 2010 21:16:18 +0200, and is licenced under
+the same terms as the package itself..
+
+
+Copyright (c) 2007, David Fox
+Copyright (c) 2007, Jeremy Shaw
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * The names of contributors may not be used to endorse or promote
+ products derived from this software without specific prior
+ written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -rN -u old-cabal-debian//patches/missing-distribution-package-debian.diff new-cabal-debian//patches/missing-distribution-package-debian.diff
--- old-cabal-debian//patches/missing-distribution-package-debian.diff 1970-01-01 00:00:00.000000000 +0000
+++ new-cabal-debian//patches/missing-distribution-package-debian.diff 2012-05-18 02:28:51.161328756 +0000
@@ -0,0 +1,1856 @@
+Description: files from http://src.seereason.com/cabal-debian/
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ cabal-debian (1.21-1) unstable; urgency=low
+ .
+ * Initial release.
+Author: Clint Adams <clint at debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: http://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- /dev/null
++++ cabal-debian-1.21/Distribution/Package/Debian.hs
+@@ -0,0 +1,727 @@
++{-# LANGUAGE CPP, ScopedTypeVariables, TupleSections, TypeSynonymInstances #-}
++{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
++
++-- |
++-- Module : Distribution.Package.Debian
++-- Copyright : David Fox 2008
++--
++-- Maintainer : David Fox <dsf at 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 Debug.Trace
++
++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.Exit (ExitCode(..))
++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.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.Dependencies (PackageType(..), debianExtraPackageName, debianUtilsPackageName, debianSourcePackageName, debianDocPackageName,
++ {-DebianBinPackageName,-} debianDevPackageName, debianProfPackageName)
++import Distribution.Package.Debian.Relations (versionSplits)
++import Distribution.Package.Debian.Setup (Flags(..), DebAction(..), DebType(..))
++--import qualified Distribution.Compat.ReadP as ReadP
++--import Distribution.Text ( Text(parse) )
++import Text.PrettyPrint.HughesPJ
++
++import Distribution.Package.Debian.Relations (buildDependencies, docDependencies, allBuildDepends, cabalDependencies)
++
++{-
++_parsePackageId' :: ReadP.ReadP PackageIdentifier PackageIdentifier
++_parsePackageId' = parseQuoted parse ReadP.<++ parse
++-}
++
++type DebMap = Map.Map D.BinPkgName (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 (D.BinPkgName (D.PkgName (stripWS name)), Just (parseDebianVersion (stripWS version))))
++ _ -> return Nothing) >>=
++ return . Map.fromList . catMaybes
++
++(!) :: DebMap -> D.BinPkgName -> DebianVersion
++m ! k = maybe (error ("No version number for " ++ (show . D.prettyBinPkgName $ 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 flags pkgDesc compiler debVersions control cabalPackages name
++ Debianize ->
++ debianize True pkgDesc flags compiler (debOutputDir flags)
++ UpdateDebianization ->
++ updateDebianization True pkgDesc flags compiler (debOutputDir flags)
++ Usage ->
++ error "Unexpected debAction: usage"
++ 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 (D.BinPkgName, DebianVersion)
++ , profDeb :: Maybe (D.BinPkgName, DebianVersion)
++ , docDeb :: Maybe (D.BinPkgName, 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 :: Flags
++ -> 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 flags 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 (show . D.prettyBinPkgName . 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 = fmap (\ (D.BinPkgName (D.PkgName x)) -> "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 flags 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 flags 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 flags 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 flags pkgDesc))
++ buildDepNames :: [D.BinPkgName]
++ 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 = fmap (D.BinPkgName . D.PkgName) $ listToMaybe (filter (isSuffixOf "-dev") debNames)
++ profDebName = fmap (D.BinPkgName . D.PkgName) $ listToMaybe (filter (isSuffixOf "-prof") debNames)
++ docDebName = fmap (D.BinPkgName . D.PkgName) $ 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 compu[...incomplete...]
More information about the Pkg-haskell-commits
mailing list