diff --git a/CabalDebian.hs b/CabalDebian.hs new file mode 100644 --- /dev/null +++ b/CabalDebian.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- | This is the main function of the cabal-debian executable. This +-- is generally run by the autobuilder to debianize packages that +-- don't have any custom debianization code in Setup.hs. This is a +-- less flexible and powerful method than calling the debianize +-- function directly, many sophisticated configuration options cannot +-- be accessed using the command line interface. + +import Control.Monad.State (get) +import Control.Monad.Trans (MonadIO, liftIO) +import Data.Lens.Lazy (getL) +import Data.List as List (unlines) +import Debian.Debianize.Details (debianDefaultAtoms) +import Debian.Debianize.Finalize (debianization) +import Debian.Debianize.Monad (DebT, evalDebT) +import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs, options) +import Debian.Debianize.Output (doDebianizeAction) +import Debian.Debianize.SubstVars (substvars) +import Debian.Debianize.Types (Top(Top)) +import Debian.Debianize.Types.Atoms (DebAction(Debianize, SubstVar, Usage), EnvSet(EnvSet), debAction, newAtoms) +import Distribution.Compiler (CompilerFlavor(GHC)) +import Prelude hiding (unlines, writeFile, init) +import System.Console.GetOpt (OptDescr, usageInfo) +import System.Environment (getProgName) + +top :: Top +top = Top "." + +main :: IO () +main = cabalDebianMain GHC debianDefaultAtoms + +-- | The main function for the cabal-debian executable. +cabalDebianMain :: (MonadIO m, Functor m) => CompilerFlavor -> DebT m () -> m () +cabalDebianMain hc init = + -- This picks up the options required to decide what action we are + -- taking. Much of this will be repeated in the call to debianize. + newAtoms hc >>= \ atoms -> + evalDebT (init >> compileEnvironmentArgs >> compileCommandlineArgs >> + get >>= return . getL debAction >>= finish) atoms + where + envset = EnvSet "/" "/" "/" + finish :: forall m. (MonadIO m, Functor m) => DebAction -> DebT m () + finish (SubstVar debType) = substvars top debType + finish Debianize = debianization top (return ()) (return ()) >> doDebianizeAction top envset + finish Usage = do + progName <- liftIO getProgName + let info = unlines [ "Typical usage is to cd to the top directory of the package's unpacked source and run: " + , "" + , " " ++ progName ++ " --maintainer 'Maintainer Name '." + , "" + , "This will read the package's cabal file and any existing debian/changelog file and" + , "deduce what it can about the debianization, then it will create or modify files in" + , "the debian subdirectory. Note that it will not remove any files in debian, and" + , "these could affect the operation of the debianization in unknown ways. For this" + , "reason I recommend either using a pristine unpacked directory each time, or else" + , "using a revision control system to revert the package to a known state before running." + , "The following additional options are available:" ] + liftIO $ putStrLn (usageInfo info (options :: [OptDescr (DebT m ())])) diff --git a/Tests.hs b/Tests.hs new file mode 100644 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,720 @@ +{-# LANGUAGE CPP, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +module Main + ( tests + , main + ) where + +import Control.Applicative ((<$>)) +import Data.Algorithm.Diff.Context (contextDiff) +import Data.Algorithm.Diff.Pretty (prettyDiff) +import Data.Function (on) +import Data.Lens.Lazy (access, getL) +import Data.List (sortBy) +import Data.Map as Map (differenceWithKey, intersectionWithKey) +import qualified Data.Map as Map (elems, Map, toList) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>), mconcat, mempty) +import Data.Set as Set (fromList, singleton, union) +import Data.Text as Text (intercalate, lines, split, Text, unlines) +import Data.Version (Version(Version, versionBranch)) +import Debian.Changes (ChangeLog(..), ChangeLogEntry(..), parseEntry) +import Debian.Debianize.DebianName (mapCabal, splitCabal) +import Debian.Debianize.Files (debianizationFileMap) +import Debian.Debianize.Finalize (debianization, finalizeDebianization') +import Debian.Debianize.Goodies (doBackups, doExecutable, doServer, doWebsite, makeRulesHead, tightDependencyFixup) +import Debian.Debianize.Input (inputChangeLog, inputDebianization) +import Debian.Debianize.Monad (DebT, evalDebT, execDebM, execDebT) +import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), (~=)) +import Debian.Debianize.Types as T +import Debian.Debianize.Types.Atoms as T +import qualified Debian.Debianize.Types.BinaryDebDescription as B +import qualified Debian.Debianize.Types.SourceDebDescription as S +import Debian.Debianize.VersionSplits (DebBase(DebBase)) +import Debian.Policy (databaseDirectory, PackageArchitectures(All), PackagePriority(Extra), parseMaintainer, Section(MainSection), SourceFormat(Native3), StandardsVersion(..), getDebhelperCompatLevel, getDebianStandardsVersion) +import Debian.Pretty (pretty, text, Doc) +import Debian.Relation (BinPkgName(..), Relation(..), SrcPkgName(..), VersionReq(..)) +import Debian.Release (ReleaseName(ReleaseName, relName)) +import Debian.Version (parseDebianVersion, buildDebianVersion) +import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC)) +import Distribution.License (License(..)) +import Distribution.Package (PackageName(PackageName)) +import Prelude hiding (log) +import System.Exit (ExitCode(ExitSuccess)) +import System.FilePath (()) +import System.Process (readProcessWithExitCode) +import Test.HUnit hiding ((~?=)) +import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) + +-- | A suitable defaultAtoms value for the debian repository. +defaultAtoms :: Monad m => DebT m () +defaultAtoms = + do T.epochMap ++= (PackageName "HaXml", 1) + T.epochMap ++= (PackageName "HTTP", 1) + mapCabal (PackageName "parsec") (DebBase "parsec3") + splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] []) + mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2") + splitCabal (PackageName "QuickCheck") (DebBase "quickcheck1") (Version [2] []) + mapCabal (PackageName "gtk2hs-buildtools") (DebBase "gtk2hs-buildtools") + +-- | Force the compiler version to 7.6 to get predictable outputs +testAtoms :: IO Atoms +testAtoms = ghc763 <$> T.newAtoms GHC + where + ghc763 :: Atoms -> Atoms + ghc763 atoms = atoms +{- +#if MIN_VERSION_Cabal(1,21,0) + let CompilerId flavor version _ = getL ghcVersion_ atoms in + atoms {ghcVersion_ = CompilerId flavor (version {versionBranch = [7, 6, 3]}) Nothing} +#else + let CompilerId flavor version = ghcVersion_ atoms in + atoms {ghcVersion_ = CompilerId flavor (version {versionBranch = [7, 6, 3]})} +#endif +-} + +-- | Create a Debianization based on a changelog entry and a license +-- value. Uses the currently installed versions of debhelper and +-- debian-policy to set the compatibility levels. +newDebianization :: Monad m => ChangeLog -> Maybe Int -> Maybe StandardsVersion -> DebT m () +newDebianization (ChangeLog (WhiteSpace {} : _)) _ _ = error "defaultDebianization: Invalid changelog entry" +newDebianization (log@(ChangeLog (entry : _))) level standards = + do T.changelog ~= Just log + T.compat ~= level + T.source ~= Just (SrcPkgName (logPackage entry)) + T.maintainer ~= either error Just (parseMaintainer (logWho entry)) + T.standardsVersion ~= standards +newDebianization _ _ _ = error "Invalid changelog" + +newDebianization' :: Monad m => Maybe Int -> Maybe StandardsVersion -> DebT m () +newDebianization' level standards = + do T.compat ~= level + T.standardsVersion ~= standards + +tests :: Test +tests = TestLabel "Debianization Tests" (TestList [-- 1 and 2 do not input a cabal package - we're not ready to + -- debianize without a cabal package. + {- test1 "test1", + test2 "test2", -} + test3 "test3", + test4 "test4 - test-data/clckwrks-dot-com", + test5 "test5 - test-data/creativeprompts", + test6 "test6 - test-data/artvaluereport2", + test7 "test7 - debian/Debianize.hs", + test8 "test8 - test-data/artvaluereport-data", + test9 "test9 - test-data/alex", + test10 "test10 - test-data/archive"]) + +test1 :: String -> Test +test1 label = + TestLabel label $ + TestCase (do level <- getDebhelperCompatLevel + standards <- getDebianStandardsVersion :: IO (Maybe StandardsVersion) + atoms <- testAtoms + deb <- execDebT + (do -- let top = Top "." + defaultAtoms + newDebianization (ChangeLog [testEntry]) level standards + license ~= Just BSD3 + -- inputCabalization top + finalizeDebianization') + atoms + diff <- diffDebianizations (testDeb1 atoms) deb + assertEqual label [] diff) + where + testDeb1 :: Atoms -> Atoms + testDeb1 atoms = + execDebM + (do defaultAtoms + newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) + rulesHead %= (const (Just (Text.unlines $ + [ "#!/usr/bin/make -f" + , "" + , "include /usr/share/cdbs/1/rules/debhelper.mk" + , "include /usr/share/cdbs/1/class/hlibrary.mk" ]))) + compat ~= Just 9 -- This will change as new version of debhelper are released + license ~= Just BSD3 + T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) + T.maintainer ~= Just (NameAddr (Just "David Fox") "dsf@seereason.com") + T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1)) -- This will change as new versions of debian-policy are released + T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing], + [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing], + [Rel (BinPkgName "cdbs") Nothing Nothing], + [Rel (BinPkgName "ghc") Nothing Nothing], + [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) + T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) + atoms + log = ChangeLog [Entry { logPackage = "haskell-cabal-debian" + , logVersion = buildDebianVersion Nothing "2.6.2" Nothing + , logDists = [ReleaseName {relName = "unstable"}] + , logUrgency = "low" + , logComments = " * Fix a bug constructing the destination pathnames that was dropping\n files that were supposed to be installed into packages.\n" + , logWho = "David Fox " + , logDate = "Thu, 20 Dec 2012 06:49:25 -0800" }] + +test2 :: String -> Test +test2 label = + TestLabel label $ + TestCase (do level <- getDebhelperCompatLevel + standards <- getDebianStandardsVersion + atoms <- testAtoms + deb <- execDebT + (do -- let top = Top "." + defaultAtoms + newDebianization (ChangeLog [testEntry]) level standards + license ~= Just BSD3 + -- inputCabalization top + finalizeDebianization') + atoms + diff <- diffDebianizations (expect atoms) deb + assertEqual label [] diff) + where + expect atoms = + execDebM + (do defaultAtoms + newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) + rulesHead %= (const (Just (Text.unlines $ + ["#!/usr/bin/make -f", + "", + "include /usr/share/cdbs/1/rules/debhelper.mk", + "include /usr/share/cdbs/1/class/hlibrary.mk"]))) + compat ~= Just 9 + license ~= Just BSD3 + T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) + T.maintainer ~= Just (NameAddr {nameAddr_name = Just "David Fox", nameAddr_addr = "dsf@seereason.com"}) + T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1)) + T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing], + [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing], + [Rel (BinPkgName "cdbs") Nothing Nothing], + [Rel (BinPkgName "ghc") Nothing Nothing], + [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) + T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) + atoms + log = ChangeLog [Entry {logPackage = "haskell-cabal-debian", + logVersion = Debian.Version.parseDebianVersion ("2.6.2" :: String), + logDists = [ReleaseName {relName = "unstable"}], + logUrgency = "low", + logComments = Prelude.unlines [" * Fix a bug constructing the destination pathnames that was dropping", + " files that were supposed to be installed into packages."], + logWho = "David Fox ", + logDate = "Thu, 20 Dec 2012 06:49:25 -0800"}] + +testEntry :: ChangeLogEntry +testEntry = + either (error "Error in test changelog entry") fst + (parseEntry (Prelude.unlines + [ "haskell-cabal-debian (2.6.2) unstable; urgency=low" + , "" + , " * Fix a bug constructing the destination pathnames that was dropping" + , " files that were supposed to be installed into packages." + , "" + , " -- David Fox Thu, 20 Dec 2012 06:49:25 -0800" ])) + +test3 :: String -> Test +test3 label = + TestLabel label $ + TestCase (do let top = Top "test-data/haskell-devscripts" + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + deb <- execDebT (inputDebianization top envset) atoms + diff <- diffDebianizations (testDeb2 atoms) deb + assertEqual label [] diff) + where + testDeb2 :: Atoms -> Atoms + testDeb2 atoms = + execDebM + (do defaultAtoms + newDebianization log (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) + T.sourceFormat ~= Just Native3 + T.rulesHead ~= Just (Text.unlines ["#!/usr/bin/make -f", + "# -*- makefile -*-", + "", + "# Uncomment this to turn on verbose mode.", + "#export DH_VERBOSE=1", + "", + "DEB_VERSION := $(shell dpkg-parsechangelog | egrep '^Version:' | cut -f 2 -d ' ')", + "", + "manpages = $(shell cat debian/manpages)", + "", + "%.1: %.pod", + "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", + "", + "%.1: %", + "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", + "", + ".PHONY: build", + "build: $(manpages)", + "", + "install-stamp:", + "\tdh install", + "", + ".PHONY: install", + "install: install-stamp", + "", + "binary-indep-stamp: install-stamp", + "\tdh binary-indep", + "\ttouch $@", + "", + ".PHONY: binary-indep", + "binary-indep: binary-indep-stamp", + "", + ".PHONY: binary-arch", + "binary-arch: install-stamp", + "", + ".PHONY: binary", + "binary: binary-indep-stamp", + "", + ".PHONY: clean", + "clean:", + "\tdh clean", + "\trm -f $(manpages)", + "", + ""]) + T.compat ~= Just 7 + T.copyright ~= Just "This package was debianized by John Goerzen on\nWed, 6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n\n" + T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"}) + T.maintainer ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) + T.uploaders ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] + T.sourcePriority ~= Just Extra + T.sourceSection ~= Just (MainSection "haskell") + T.buildDepends %= (++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]]) + T.buildDependsIndep %= (++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]]) + T.standardsVersion ~= Just (StandardsVersion 3 9 4 Nothing) + T.vcsFields %= Set.union (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts" + , S.VCSDarcs "http://darcs.debian.org/pkg-haskell/haskell-devscripts"]) + T.binaryArchitectures (BinPkgName "haskell-devscripts") ~= Just All + T.debianDescription (BinPkgName "haskell-devscripts") ~= + Just + (intercalate "\n" ["Tools to help Debian developers build Haskell packages", + " This package provides a collection of scripts to help build Haskell", + " packages for Debian. Unlike haskell-utils, this package is not", + " expected to be installed on the machines of end users.", + " .", + " This package is designed to support Cabalized Haskell libraries. It", + " is designed to build a library for each supported Debian compiler or", + " interpreter, generate appropriate postinst/prerm files for each one,", + " generate appropriate substvars entries for each one, and install the", + " package in the Debian temporary area as part of the build process."]) + T.depends (BinPkgName "haskell-devscripts") ~= + [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] + , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] + , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] +{- + control %= (\ y -> y { S.source = + , S.maintainer = Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) + , S.uploaders = [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] + , S.priority = Just Extra + , S.section = Just (MainSection "haskell") + , S.buildDepends = (S.buildDepends y) ++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]] + , S.buildDependsIndep = (S.buildDependsIndep y) ++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]] + , S.standardsVersion = Just (StandardsVersion 3 9 4 Nothing) + , S.vcsFields = Set.union (S.vcsFields y) (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts" + , S.VCSDarcs "http://darcs.debian.org/pkg-haskell/haskell-devscripts"]) + , S.binaryPackages = [S.BinaryDebDescription { B.package = BinPkgName {unBinPkgName = "haskell-devscripts"} + , B.architecture = All + , B.binarySection = Nothing + , B.binaryPriority = Nothing + , B.essential = False + , B.description = Just $ + (T.intercalate "\n" + ["Tools to help Debian developers build Haskell packages", + " This package provides a collection of scripts to help build Haskell", + " packages for Debian. Unlike haskell-utils, this package is not", + " expected to be installed on the machines of end users.", + " .", + " This package is designed to support Cabalized Haskell libraries. It", + " is designed to build a library for each supported Debian compiler or", + " interpreter, generate appropriate postinst/prerm files for each one,", + " generate appropriate substvars entries for each one, and install the", + " package in the Debian temporary area as part of the build process."]) + , B.relations = + B.PackageRelations + { B.depends = + [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] + , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] + , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] + , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] + , B.recommends = [] + , B.suggests = [] + , B.preDepends = [] + , B.breaks = [] + , B.conflicts = [] + , B.provides_ = [] + , B.replaces_ = [] + , B.builtUsing = [] }}]}) +-} + ) + atoms + log = ChangeLog [Entry { logPackage = "haskell-devscripts" + , logVersion = Debian.Version.parseDebianVersion ("0.8.13" :: String) + , logDists = [ReleaseName {relName = "experimental"}] + , logUrgency = "low" + , logComments = " [ Joachim Breitner ]\n * Improve parsing of \"Setup register\" output, patch by David Fox\n * Enable creation of hoogle files, thanks to Kiwamu Okabe for the\n suggestion. \n\n [ Kiwamu Okabe ]\n * Need --html option to fix bug that --hoogle option don't output html file.\n * Support to create /usr/lib/ghc-doc/hoogle/*.txt for hoogle package.\n\n [ Joachim Breitner ]\n * Symlink hoogle\8217s txt files to /usr/lib/ghc-doc/hoogle/\n * Bump ghc dependency to 7.6 \n * Bump standards version\n" + , logWho = "Joachim Breitner " + , logDate = "Mon, 08 Oct 2012 21:14:50 +0200" }, + Entry { logPackage = "haskell-devscripts" + , logVersion = Debian.Version.parseDebianVersion ("0.8.12" :: String) + , logDists = [ReleaseName {relName = "unstable"}] + , logUrgency = "low" + , logComments = " * Depend on ghc >= 7.4, adjusting to its haddock --interface-version\n behaviour.\n" + , logWho = "Joachim Breitner " + , logDate = "Sat, 04 Feb 2012 10:50:33 +0100"}] + +test4 :: String -> Test +test4 label = + TestLabel label $ + TestCase (do let inTop = Top "test-data/clckwrks-dot-com/input" + outTop = Top "test-data/clckwrks-dot-com/output" + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + old <- execDebT (inputDebianization outTop envset) atoms + let log = getL T.changelog old + new <- execDebT (debianization inTop defaultAtoms (customize log)) atoms + diff <- diffDebianizations old ({-copyFirstLogEntry old-} new) + assertEqual label [] diff) + where + customize :: Maybe ChangeLog -> DebT IO () + customize log = + do T.changelog ~= log + tight + fixRules + doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups" + doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production")) + T.revision ~= Nothing + T.missingDependencies += (BinPkgName "libghc-clckwrks-theme-clckwrks-doc") + T.sourceFormat ~= Just Native3 + T.homepage ~= Just "http://www.clckwrks.com/" + newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) +{- + customize log = modifyM (lift . customize' log) + customize' :: Maybe ChangeLog -> Atoms -> IO Atoms + customize' log atoms = + execDebT (newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing))) . + modL T.control (\ y -> y {T.homepage = Just "http://www.clckwrks.com/"}) . + setL T.sourceFormat (Just Native3) . + modL T.missingDependencies (insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")) . + setL T.revision Nothing . + execDebM (doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production"))) . + execDebM (doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups") . + fixRules . + execDebM tight . + setL T.changelog log +-} + -- A log entry gets added when the Debianization is generated, + -- it won't match so drop it for the comparison. + serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"] + -- Insert a line just above the debhelper.mk include + fixRules = + makeRulesHead >>= \ rh -> T.rulesHead %= (\ mt -> (Just . f) (fromMaybe rh mt)) + where + f t = Text.unlines $ concat $ + map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" + then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] :: [Text] + else [line] :: [Text]) (Text.lines t) +{- + mapAtoms f deb + where + f :: DebAtomKey -> DebAtom -> Set (DebAtomKey, DebAtom) + f Source (DebRulesHead t) = + singleton (Source, DebRulesHead (T.unlines $ concat $ + map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" + then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] :: [T.Text] + else [line] :: [T.Text]) (T.lines t))) + f k a = singleton (k, a) +-} + tight = mapM_ (tightDependencyFixup [(BinPkgName "libghc-clckwrks-theme-clckwrks-dev", BinPkgName "haskell-clckwrks-theme-clckwrks-utils"), + (BinPkgName "libghc-clckwrks-plugin-media-dev", BinPkgName "haskell-clckwrks-plugin-media-utils"), + (BinPkgName "libghc-clckwrks-plugin-bugs-dev", BinPkgName "haskell-clckwrks-plugin-bugs-utils"), + (BinPkgName "libghc-clckwrks-dev", BinPkgName "haskell-clckwrks-utils")]) serverNames + + theSite :: BinPkgName -> T.Site + theSite deb = + Site { domain = hostname' + , serverAdmin = "logic@seereason.com" + , server = theServer deb } + theServer :: BinPkgName -> Server + theServer deb = + Server { hostname = + case deb of + BinPkgName "clckwrks-dot-com-production" -> hostname' + _ -> hostname' + , port = portNum deb + , headerMessage = "Generated by clckwrks-dot-com/Setup.hs" + , retry = "60" + , serverFlags = + [ "--http-port", show (portNum deb) + , "--hide-port" + , "--hostname", hostname' + , "--top", databaseDirectory deb + , "--enable-analytics" + , "--jquery-path", "/usr/share/javascript/jquery/" + , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" + , "--jstree-path", jstreePath + , "--json2-path",json2Path + ] + , installFile = + InstallFile { execName = "clckwrks-dot-com-server" + , destName = show (pretty deb) + , sourceDir = Nothing + , destDir = Nothing } + } + hostname' = "clckwrks.com" + portNum :: BinPkgName -> Int + portNum (BinPkgName deb) = + case deb of + "clckwrks-dot-com-production" -> 9029 + "clckwrks-dot-com-staging" -> 9038 + "clckwrks-dot-com-development" -> 9039 + _ -> error $ "Unexpected package name: " ++ deb + jstreePath = "/usr/share/clckwrks-0.13.2/jstree" + json2Path = "/usr/share/clckwrks-0.13.2/json2" + +anyrel :: BinPkgName -> Relation +anyrel b = Rel b Nothing Nothing + +test5 :: String -> Test +test5 label = + TestLabel label $ + TestCase (do let inTop = (Top "test-data/creativeprompts/input") + outTop = (Top "test-data/creativeprompts/output") + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + old <- execDebT (inputDebianization outTop envset) atoms + let standards = getL T.standardsVersion old + level = getL T.compat old + new <- execDebT (debianization inTop defaultAtoms (customize old level standards)) atoms + diff <- diffDebianizations old new + assertEqual label [] diff) + where + customize old level standards = + do T.utilsPackageNames ~= singleton (BinPkgName "creativeprompts-data") + newDebianization' level standards + T.changelog ~= (getL T.changelog old) + doWebsite (BinPkgName "creativeprompts-production") (theSite (BinPkgName "creativeprompts-production")) + doServer (BinPkgName "creativeprompts-development") (theServer (BinPkgName "creativeprompts-development")) + doBackups (BinPkgName "creativeprompts-backups") "creativeprompts-backups" + T.execMap ++= ("trhsx", [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]]) + mapM_ (\ b -> T.depends b %= \ deps -> deps ++ [[anyrel (BinPkgName "markdown")]]) + [(BinPkgName "creativeprompts-production"), (BinPkgName "creativeprompts-development")] + T.debianDescription (BinPkgName "creativeprompts-development") ~= + Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server" + , " Testing version of the blog server, runs on port" + , " 8000 with HTML validation turned on." ]) + T.debianDescription (BinPkgName "creativeprompts-data") ~= + Just (intercalate "\n" [ "creativeprompts.com data files" + , " Static data files for creativeprompts.com"]) + T.debianDescription (BinPkgName "creativeprompts-production") ~= + Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server" + , " Production version of the blog server, runs on port" + , " 9021 with HTML validation turned off." ]) + T.debianDescription (BinPkgName "creativeprompts-backups") ~= + Just (intercalate "\n" [ "backup program for creativeprompts.com" + , " Install this somewhere other than creativeprompts.com to run automated" + , " backups of the database."]) + T.binaryArchitectures (BinPkgName "creativeprompts-production") ~= Just All + T.binaryArchitectures (BinPkgName "creativeprompts-data") ~= Just All + T.binaryArchitectures (BinPkgName "creativeprompts-development") ~= Just All + T.sourceFormat ~= Just Native3 + + theSite :: BinPkgName -> Site + theSite deb = + Site { domain = hostname' + , serverAdmin = "logic@seereason.com" + , server = theServer deb } + theServer :: BinPkgName -> Server + theServer deb = + Server { hostname = + case deb of + BinPkgName "clckwrks-dot-com-production" -> hostname' + _ -> hostname' + , port = portNum deb + , headerMessage = "Generated by creativeprompts-dot-com/debian/Debianize.hs" + , retry = "60" + , serverFlags = + [ "--http-port", show (portNum deb) + , "--hide-port" + , "--hostname", hostname' + , "--top", databaseDirectory deb + , "--enable-analytics" + , "--jquery-path", "/usr/share/javascript/jquery/" + , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" + , "--jstree-path", jstreePath + , "--json2-path",json2Path + ] + , installFile = + InstallFile { execName = "creativeprompts-server" + , destName = show (pretty deb) + , sourceDir = Nothing + , destDir = Nothing } + } + hostname' = "creativeprompts.com" + portNum :: BinPkgName -> Int + portNum (BinPkgName deb) = + case deb of + "creativeprompts-production" -> 9022 + "creativeprompts-staging" -> 9033 + "creativeprompts-development" -> 9034 + _ -> error $ "Unexpected package name: " ++ deb + jstreePath = "/usr/share/clckwrks-0.13.2/jstree" + json2Path = "/usr/share/clckwrks-0.13.2/json2" + +test6 :: String -> Test +test6 label = + TestLabel label $ + TestCase (do result <- readProcessWithExitCode "runhaskell" ["-isrc", "-DMIN_VERSION_Cabal(1,18,0)", "test-data/artvaluereport2/input/debian/Debianize.hs"] "" + assertEqual label (ExitSuccess, "", "") result) + +test7 :: String -> Test +test7 label = + TestLabel label $ + TestCase (do new <- readProcessWithExitCode "runhaskell" ["-isrc", "debian/Debianize.hs"] "" + assertEqual label (ExitSuccess, "", "Ignored: ./debian/cabal-debian.1\nIgnored: ./debian/cabal-debian.manpages\n") new) + +test8 :: String -> Test +test8 label = + TestLabel label $ + TestCase ( do let inTop = Top "test-data/artvaluereport-data/input" + outTop = Top "test-data/artvaluereport-data/output" + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + old <- execDebT (inputDebianization outTop envset) atoms + log <- evalDebT (inputChangeLog inTop >> access T.changelog) atoms + new <- execDebT (debianization inTop defaultAtoms (customize log)) atoms + diff <- diffDebianizations old new + assertEqual label [] diff + ) + where + customize Nothing = error "Missing changelog" + customize (Just log) = + do T.buildDepends %= (++ [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]]) + T.homepage ~= Just "http://artvaluereportonline.com" + T.sourceFormat ~= Just Native3 + T.changelog ~= Just log + newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing)) + +test9 :: String -> Test +test9 label = + TestLabel label $ + TestCase (do let inTop = Top "test-data/alex/input" + outTop = Top "test-data/alex/output" + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + old <- execDebT (inputDebianization outTop envset) atoms + let Just (ChangeLog (entry : _)) = getL T.changelog old + new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms + diff <- diffDebianizations old new + assertEqual label [] diff) + where + customize = + do newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing)) + mapM_ (\ name -> T.installData +++= (BinPkgName "alex", singleton (name, name))) + [ "AlexTemplate" + , "AlexTemplate-debug" + , "AlexTemplate-ghc" + , "AlexTemplate-ghc-debug" + , "AlexWrapper-basic" + , "AlexWrapper-basic-bytestring" + , "AlexWrapper-gscan" + , "AlexWrapper-monad" + , "AlexWrapper-monad-bytestring" + , "AlexWrapper-monadUserState" + , "AlexWrapper-monadUserState-bytestring" + , "AlexWrapper-posn" + , "AlexWrapper-posn-bytestring" + , "AlexWrapper-strict-bytestring"] + T.homepage ~= Just "http://www.haskell.org/alex/" + T.sourceFormat ~= Just Native3 + T.debVersion ~= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String)) + doExecutable (BinPkgName "alex") + (InstallFile {execName = "alex", destName = "alex", sourceDir = Nothing, destDir = Nothing}) + -- Bootstrap dependency + T.buildDepends %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]]) + +test10 :: String -> Test +test10 label = + TestLabel label $ + TestCase (do let inTop = Top "test-data/archive/input" + outTop = Top "test-data/archive/output" + envset = EnvSet "/" "/" "/" + atoms <- testAtoms + old <- execDebT (inputDebianization outTop envset) atoms + let Just (ChangeLog (entry : _)) = getL T.changelog old + new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms + diff <- diffDebianizations old new + assertEqual label [] diff) + where + customize :: DebT IO () + customize = + do T.sourcePackageName ~= Just (SrcPkgName "seereason-darcs-backups") + T.compat ~= Just 5 + T.standardsVersion ~= Just (StandardsVersion 3 8 1 Nothing) + T.maintainer ~= either (const Nothing) Just (parseMaintainer "David Fox ") + T.depends (BinPkgName "seereason-darcs-backups") %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]]) + T.sourceSection ~= Just (MainSection "haskell") + T.utilsPackageNames += utils + T.installCabalExec +++= (utils, singleton ("seereason-darcs-backups", "/etc/cron.hourly")) + utils = BinPkgName "seereason-darcs-backups" + +copyChangelogDate :: Monad m => String -> DebT m () +copyChangelogDate date = + T.changelog %= (\ (Just (ChangeLog (entry : older))) -> Just (ChangeLog (entry {logDate = date} : older))) + +data Change k a + = Created k a + | Deleted k a + | Modified k a a + | Unchanged k a + deriving (Eq, Show) + +diffMaps :: (Ord k, Eq a, Show k, Show a) => Map.Map k a -> Map.Map k a -> [Change k a] +diffMaps old new = + Map.elems (intersectionWithKey combine1 old new) ++ + map (uncurry Deleted) (Map.toList (differenceWithKey combine2 old new)) ++ + map (uncurry Created) (Map.toList (differenceWithKey combine2 new old)) + where + combine1 k a b = if a == b then Unchanged k a else Modified k a b + combine2 _ _ _ = Nothing + +diffDebianizations :: Atoms -> Atoms -> IO String -- [Change FilePath T.Text] +diffDebianizations old new = + do old' <- evalDebT (sortBinaryDebs >> debianizationFileMap) old + new' <- evalDebT (sortBinaryDebs >> debianizationFileMap) new + return $ show $ mconcat $ map prettyChange $ filter (not . isUnchanged) $ diffMaps old' new' + where + isUnchanged (Unchanged _ _) = True + isUnchanged _ = False + prettyChange :: Change FilePath Text -> Doc + prettyChange (Unchanged p _) = text "Unchanged: " <> pretty p <> text "\n" + prettyChange (Deleted p _) = text "Deleted: " <> pretty p <> text "\n" + prettyChange (Created p b) = + text "Created: " <> pretty p <> text "\n" <> + prettyDiff ("old" p) ("new" p) + -- We use split here instead of lines so we can + -- detect whether the file has a final newline + -- character. + (contextDiff 2 mempty (split (== '\n') b)) + prettyChange (Modified p a b) = + text "Modified: " <> pretty p <> text "\n" <> + prettyDiff ("old" p) ("new" p) + -- We use split here instead of lines so we can + -- detect whether the file has a final newline + -- character. + (contextDiff 2 (split (== '\n') a) (split (== '\n') b)) + +sortBinaryDebs :: DebT IO () +sortBinaryDebs = T.binaryPackages %= sortBy (compare `on` getL B.package) + +main :: IO () +main = runTestTT tests >>= putStrLn . show + 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: 4.3.1 +Version: 4.11 License: BSD3 License-File: debian/copyright Author: David Fox @@ -164,6 +164,7 @@ filepath, hsemail, HUnit, + memoize, mtl, parsec >= 3, process, @@ -179,6 +180,7 @@ Data.Algorithm.Diff.Context Data.Algorithm.Diff.Pretty Debian.Debianize + Debian.GHC Debian.Policy Distribution.Version.Invert Debian.Debianize.BuildDependencies @@ -210,68 +212,13 @@ Build-depends: debian >= 3.81 Executable cabal-debian - Hs-Source-Dirs: src + Hs-Source-Dirs: . Main-is: CabalDebian.hs ghc-options: -threaded -Wall -O2 - Build-Depends: - base, - Cabal, - containers, - data-lens, - data-lens-template, - debian, - deepseq, - Diff, - directory, - filepath, - hsemail, - mtl, - parsec, - process, - pureMD5, - regex-tdfa, - set-extra, - syb, - text, - unix, - Unixutils, - utf8-string --- if flag(local-debian) --- Hs-Source-Dirs: ., ../../haskell-debian --- Build-Depends: regex-compat, bytestring, process-listlike, network, old-locale, time --- else - Build-Depends: debian >= 3.81 + Build-Depends: base, Cabal, cabal-debian, data-lens, mtl Executable cabal-debian-tests - Hs-Source-Dirs: src - Main-is: Debian/Debianize/Tests.hs + Hs-Source-Dirs: . + Main-is: Tests.hs ghc-options: -threaded -Wall -O2 - Build-Depends: - base, - Cabal, - containers, - data-lens, - data-lens-template, - debian, - deepseq, - Diff, - directory, - filepath, - hsemail, - HUnit, - mtl, - parsec >= 3, - process, - pureMD5, - regex-tdfa, - set-extra, - syb, - text, - unix, - Unixutils, - utf8-string --- if flag(local-debian) --- Hs-Source-Dirs: ., ../../haskell-debian --- Build-Depends: regex-compat, bytestring, process-listlike, network, old-locale, time --- else - Build-depends: debian >= 3.81 + Build-Depends: base, Cabal, cabal-debian, containers, data-lens, debian, filepath, hsemail, HUnit, process, text diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,100 @@ +haskell-cabal-debian (4.10.1) unstable; urgency=low + + * Fix a tail exception in builtIn. + + -- David Fox Tue, 17 Jun 2014 07:21:22 -0700 + +haskell-cabal-debian (4.10) unstable; urgency=low + + * Rename knownVersionSplits -> debianVersionSplits and move to + Debian.Debianize.Details. (Should that be renamed + Debian.Debianize.Debian?) + * Add HC=ghc or HC=ghcjs to header of debian/rules depending on + the value of the compilerFlavor atom. + + -- David Fox Sat, 14 Jun 2014 10:20:01 -0700 + +haskell-cabal-debian (4.9) unstable; urgency=low + + * Generate the library package prefix, previously hard coded as libghc-, + using the CompilerFlavor value, so we get libghcjs-foo-dev when using + ghcjs. + + -- David Fox Fri, 13 Jun 2014 09:58:13 -0700 + +haskell-cabal-debian (4.8) unstable; urgency=low + + * Add a --no-hoogle flag to omit the hoogle documentation link. This + link doesn't contain the package's version number, so it will conflict + with other versions of the library (such as those built into ghc.) + + -- David Fox Tue, 10 Jun 2014 10:42:38 -0700 + +haskell-cabal-debian (4.7.1) unstable; urgency=low + + * Fix the code added in 4.7. + * Add --recommends and --suggests options, similar to --depends et. al. + + -- David Fox Tue, 03 Jun 2014 07:14:52 -0700 + +haskell-cabal-debian (4.7) unstable; urgency=low + + * Improve the treatment of dependencies which are built into ghc. This + will allow the use of newer libraries than the ones built into ghc, + provided they are given deb names that are different than the one ghc + specifically conflicts with. For example, a newer version of Cabal + could be used if it was in the deb package libghc-cabal-ghcjs-dev. To + change the debian names of libraries we need to use the mapCabal and + splitCabal functions, as is done in the autobuilder-seereason module + Debian.AutoBuilder.Details.Atoms. + + -- David Fox Mon, 02 Jun 2014 14:28:59 -0700 + +haskell-cabal-debian (4.6.2) unstable; urgency=low + + * Move a seereason specific function from here to the + autobuilder-seereason package. + + -- David Fox Mon, 02 Jun 2014 11:03:13 -0700 + +haskell-cabal-debian (4.6.1) unstable; urgency=low + + * Don't compute the current ghc version so often. + + -- David Fox Fri, 30 May 2014 13:40:12 -0700 + +haskell-cabal-debian (4.6) unstable; urgency=low + + * Add a --default-package option to change haskell-packagename-utils to + some other name. + * Fix treatment of cabalfile Data-Dir field - it describes where the + data files are in the source tree, but shouldn't affect where they will + be installed. + + -- David Fox Thu, 29 May 2014 08:27:54 -0700 + +haskell-cabal-debian (4.5) unstable; urgency=low + + * Remove the ghcVersion field and lens. + + -- David Fox Mon, 05 May 2014 11:55:53 -0700 + +haskell-cabal-debian (4.4) unstable; urgency=low + + * Add the copytruncate directive to logrotate files we generate. + As things were, hslogger would continue writing to the deleted + log file after it was rotated. + + -- David Fox Sun, 30 Mar 2014 13:05:48 -0700 + +haskell-cabal-debian (4.3.2) unstable; urgency=low + + * Speed up debianization by computing the ghc version once when + we enter the DebT monad rather than repeatedly. It is slow + because it needs to chroot. + + -- David Fox Fri, 28 Mar 2014 13:03:57 -0700 + haskell-cabal-debian (4.3.1) unstable; urgency=low * Safer default value for buildEnv - "/" instead of "". This is diff --git a/src/CabalDebian.hs b/src/CabalDebian.hs deleted file mode 100644 --- a/src/CabalDebian.hs +++ /dev/null @@ -1,55 +0,0 @@ --- | This is the main function of the cabal-debian executable. This --- is generally run by the autobuilder to debianize packages that --- don't have any custom debianization code in Setup.hs. This is a --- less flexible and powerful method than calling the debianize --- function directly, many sophisticated configuration options cannot --- be accessed using the command line interface. - -import Control.Monad.State (get, lift) -import Data.Lens.Lazy (getL, access) -import Data.List as List (unlines) -import Debian.Debianize.Details (debianDefaultAtoms) -import Debian.Debianize.Finalize (debianization) -import Debian.Debianize.Monad (DebT, evalDebT) -import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs, options) -import Debian.Debianize.Output (doDebianizeAction) -import Debian.Debianize.SubstVars (substvars) -import Debian.Debianize.Types (Top(Top)) -import Debian.Debianize.Types.Atoms (DebAction(Debianize, SubstVar, Usage), debAction, newAtoms, buildEnv) -import Prelude hiding (unlines, writeFile, init) -import System.Console.GetOpt (usageInfo) -import System.Environment (getProgName) - -top :: Top -top = Top "." - -main :: IO () -main = cabalDebianMain debianDefaultAtoms - --- | The main function for the cabal-debian executable. -cabalDebianMain :: DebT IO () -> IO () -cabalDebianMain init = - -- This picks up the options required to decide what action we are - -- taking. Much of this will be repeated in the call to debianize. - evalDebT (init >> compileEnvironmentArgs >> compileCommandlineArgs >> - testBuildEnv >> - get >>= return . getL debAction >>= finish) newAtoms - where - testBuildEnv = access buildEnv >>= \ root -> if root == "" then error ("Invalid build environment: " ++ show root) else return () - - finish (SubstVar debType) = substvars top debType - finish Debianize = debianization top (return ()) (return ()) >> doDebianizeAction top - finish Usage = do - progName <- lift getProgName - let info = unlines [ "Typical usage is to cd to the top directory of the package's unpacked source and run: " - , "" - , " " ++ progName ++ " --maintainer 'Maintainer Name '." - , "" - , "This will read the package's cabal file and any existing debian/changelog file and" - , "deduce what it can about the debianization, then it will create or modify files in" - , "the debian subdirectory. Note that it will not remove any files in debian, and" - , "these could affect the operation of the debianization in unknown ways. For this" - , "reason I recommend either using a pristine unpacked directory each time, or else" - , "using a revision control system to revert the package to a known state before running." - , "The following additional options are available:" ] - lift $ putStrLn (usageInfo info options) diff --git a/src/Debian/Debianize.hs b/src/Debian/Debianize.hs --- a/src/Debian/Debianize.hs +++ b/src/Debian/Debianize.hs @@ -111,7 +111,6 @@ , Debian.Debianize.Output.validateDebianization , Debian.Debianize.Details.debianDefaultAtoms - , Debian.Debianize.Details.seereasonDefaultAtoms , Debian.Debianize.Goodies.tightDependencyFixup , Debian.Debianize.Goodies.doExecutable diff --git a/src/Debian/Debianize/BuildDependencies.hs b/src/Debian/Debianize/BuildDependencies.hs --- a/src/Debian/Debianize/BuildDependencies.hs +++ b/src/Debian/Debianize/BuildDependencies.hs @@ -6,32 +6,31 @@ ) where import Control.Monad.State (MonadState(get)) -import Control.Monad.Trans (MonadIO, liftIO) +import Control.Monad.Trans (MonadIO) import Data.Char (isSpace) import Data.Function (on) import Data.Lens.Lazy (access, getL) import Data.List as List (filter, map, minimumBy, nub) import Data.Map as Map (lookup, Map) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Set as Set (singleton) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import qualified Data.Set as Set (member) -import Data.Version (showVersion, Version(Version)) -import Debian.Debianize.Bundled (ghcBuiltIn) +import Data.Version (showVersion, Version) +import Debian.Debianize.Bundled (builtIn) import Debian.Debianize.DebianName (mkPkgName, mkPkgName') -import Debian.Debianize.Input (ghcVersion') import Debian.Debianize.Monad as Monad (Atoms, DebT) -import qualified Debian.Debianize.Types as T (buildDepends, buildDependsIndep, debianNameMap, epochMap, execMap, extraLibMap, missingDependencies, noDocumentationLibrary, noProfilingLibrary, buildEnv) +import qualified Debian.Debianize.Types as T (buildDepends, buildDependsIndep, debianNameMap, epochMap, execMap, extraLibMap, missingDependencies, noDocumentationLibrary, noProfilingLibrary) +import Debian.Debianize.Types.Atoms (EnvSet(dependOS), compilerFlavor, buildEnv) import qualified Debian.Debianize.Types.BinaryDebDescription as B (PackageType(Development, Documentation, Profiling)) import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits) import Debian.Orphans () -import Debian.Relation (BinPkgName, Relation(..), Relations) +import Debian.Relation (BinPkgName, Relation(..), Relations, checkVersionReq) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT)) import Debian.Version (DebianVersion, parseDebianVersion) +import Distribution.Compiler (CompilerFlavor(GHC)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..)) import qualified Distribution.PackageDescription as Cabal (PackageDescription(buildDepends, executables, package)) -import Distribution.Simple.Compiler import Distribution.Version (anyVersion, asVersionIntervals, earlierVersion, foldVersionRange', fromVersionIntervals, intersectVersionRanges, isNoVersion, laterVersion, orEarlierVersion, orLaterVersion, toVersionIntervals, unionVersionRanges, VersionRange, withinVersion) import Distribution.Version.Invert (invertVersionRange) import Prelude hiding (init, log, map, unlines, unlines, writeFile) @@ -82,13 +81,14 @@ do deb <- get cDeps <- cabalDeps let bDeps = getL T.buildDepends deb - prof = (/= singleton True) $ getL T.noProfilingLibrary deb + prof = not $ getL T.noProfilingLibrary deb + cfl <- access compilerFlavor let xs = nub $ [[D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion ("7.0" :: String)))) Nothing], [D.Rel (D.BinPkgName "haskell-devscripts") (Just (D.GRE (parseDebianVersion ("0.8" :: String)))) Nothing], anyrel "cdbs", anyrel "ghc"] ++ bDeps ++ - (if prof then [anyrel "ghc-prof"] else []) ++ + (if prof && cfl == GHC then [anyrel "ghc-prof"] else []) ++ cDeps filterMissing xs where @@ -102,7 +102,7 @@ debianBuildDepsIndep :: MonadIO m => PackageDescription -> DebT m D.Relations debianBuildDepsIndep pkgDesc = - do doc <- get >>= return . (/= singleton True) . getL T.noDocumentationLibrary + do doc <- get >>= return . not . getL T.noDocumentationLibrary bDeps <- get >>= return . getL T.buildDependsIndep cDeps <- cabalDeps let xs = if doc @@ -139,8 +139,9 @@ -- references. Also the packages associated with extra libraries. buildDependencies :: MonadIO m => Dependency_ -> DebT m D.Relations buildDependencies (BuildDepends (Dependency name ranges)) = - do dev <- dependencies B.Development name ranges - prof <- dependencies B.Profiling name ranges + do hc <- access compilerFlavor + dev <- dependencies B.Development name ranges + prof <- if hc == GHC then dependencies B.Profiling name ranges else return [] return $ dev ++ prof buildDependencies dep@(ExtraLibs _) = do mp <- get >>= return . getL T.execMap @@ -193,19 +194,21 @@ dependencies :: MonadIO m => B.PackageType -> PackageName -> VersionRange -> DebT m Relations dependencies typ name cabalRange = do atoms <- get + hc <- access compilerFlavor -- Compute a list of alternative debian dependencies for -- satisfying a cabal dependency. The only caveat is that -- we may need to distribute any "and" dependencies implied -- by a version range over these "or" dependences. - let alts = case Map.lookup name (getL T.debianNameMap atoms) of - -- If there are no splits for this package just return the single dependency for the package - Nothing -> [(mkPkgName name typ, cabalRange')] + let alts :: [(BinPkgName, VersionRange)] + alts = case Map.lookup name (getL T.debianNameMap atoms) of + -- If there are no splits for this package just + -- return the single dependency for the package. + Nothing -> [(mkPkgName hc name typ, cabalRange')] -- If there are splits create a list of (debian package name, VersionRange) pairs - Just splits' -> List.map (\ (n, r) -> (mkPkgName' n typ, r)) (packageRangesFromVersionSplits splits') - mapM (convert name) alts >>= mapM (doBundled typ name) . convert' . canonical . Or . catMaybes + Just splits' -> List.map (\ (n, r) -> (mkPkgName' hc n typ, r)) (packageRangesFromVersionSplits splits') + mapM convert alts >>= mapM (doBundled typ name) . convert' . canonical . Or . catMaybes where - convert :: Monad m => PackageName -> (BinPkgName, VersionRange) -> DebT m (Maybe (Rels Relation)) - convert name (dname, range) = + convert (dname, range) = case isNoVersion range''' of True -> return Nothing False -> @@ -251,7 +254,7 @@ -- Simplify a VersionRange canon = fromVersionIntervals . toVersionIntervals --- If a package is bundled with the compiler we make the +-- | If a package is bundled with the compiler we make the -- compiler a substitute for that package. If we were to -- specify the virtual package (e.g. libghc-base-dev) we would -- have to make sure not to specify a version number. @@ -261,33 +264,60 @@ -> [D.Relation] -> DebT m [D.Relation] doBundled typ name rels = - do root <- access T.buildEnv - gver <- liftIO $ ghcVersion' root - pver <- ghcBuiltIn root name - -- Prefer the compiler to the library, if the compiler provides libghc-foo-dev - -- generate "ghc | libghc-foo-dev" rather than "libghc-foo-dev | ghc". It would be - -- better to see if the version built into the compiler is newer than the uploaded - -- version. For now, libraries built into the new 7.8 compiler must trump uploaded - -- packages because they were all built with 7.6.3. - let preferCompiler = case gver of - Just (CompilerId GHC (Version (7 : 8 : _) _)) -> True - _ -> False - case pver of - -- If preferCompiler is set generate "ghc | libghc-foo-dev" instead of "libghc-foo-dev | ghc" - Just v | preferCompiler -> return $ [D.Rel (compilerPackageName typ) Nothing Nothing] ++ rels - Just _ -> return $ rels ++ [D.Rel (compilerPackageName typ) Nothing Nothing] - Nothing -> return rels + mapM doRel rels >>= return . concat where + -- If a library is built into the compiler, this is the debian + -- package name the compiler will conflict with. + comp = D.Rel (compilerPackageName typ) Nothing Nothing + doRel :: MonadIO m => D.Relation -> DebT m [D.Relation] + doRel rel@(D.Rel dname req _) = do + -- gver <- access ghcVersion + hc <- access compilerFlavor + splits <- access T.debianNameMap + root <- access buildEnv >>= return . dependOS + -- Look at what version of the package is provided by the compiler. + atoms <- get + -- What version of this package (if any) does the compiler provide? + let pver = maybe Nothing (Just . debianVersion'' atoms name) (builtIn splits hc root name) + -- The name this library would have if it was in the compiler conflicts list. + let naiveDebianName = mkPkgName hc name typ + return $ -- The compiler should appear in the build dependency if + -- it provides a suitable version of the library, or + -- if it conflicts with all versions of the library. + (if isJust pver && (checkVersionReq req pver || dname == naiveDebianName) then [comp] else []) ++ + -- The library package can satisfy the dependency if + -- the compiler doesn't provide a version, or if the + -- debian name of the library package is different + -- from the debian name of the library package the + -- compiler provides. + (if isNothing pver || dname /= naiveDebianName then [rel] else []) compilerPackageName B.Documentation = D.BinPkgName "ghc-doc" compilerPackageName B.Profiling = D.BinPkgName "ghc-prof" compilerPackageName B.Development = D.BinPkgName "ghc" compilerPackageName _ = D.BinPkgName "ghc" -- whatevs +{- +doBundled :: MonadIO m => + B.PackageType -- Documentation, Profiling, Development... + -> PackageName -- Cabal package name + -> [D.Relation] -- Original set of debian dependencies + -> DebT m [D.Relation] -- Modified debian dependencies accounting for the packages the compiler provides +doBundled hc typ name rels = + concat <$> mapM doRel rels + where + doRel :: MonadIO m => D.Relation -> DebT m [D.Relation] + doRel rel@(D.Rel dname req _) = do + hc <- access +-} + -- Convert a cabal version to a debian version, adding an epoch number if requested debianVersion' :: Monad m => PackageName -> Version -> DebT m DebianVersion debianVersion' name v = do atoms <- get return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.epochMap atoms)) ++ showVersion v) + +debianVersion'' :: Atoms -> PackageName -> Version -> DebianVersion +debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.epochMap atoms)) ++ showVersion v) data Rels a = And {unAnd :: [Rels a]} | Or {unOr :: [Rels a]} | Rel' {unRel :: a} deriving Show diff --git a/src/Debian/Debianize/Bundled.hs b/src/Debian/Debianize/Bundled.hs --- a/src/Debian/Debianize/Bundled.hs +++ b/src/Debian/Debianize/Bundled.hs @@ -1,488 +1,81 @@ -- | Determine whether a specific version of a Haskell package is -- bundled with into this particular version of the given compiler. -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE CPP, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} module Debian.Debianize.Bundled - ( ghcBuiltIn + ( builtIn ) where -import Control.Monad.Trans (MonadIO) +import Control.Applicative ((<$>)) +import Control.DeepSeq (force) +import Control.Exception (try, SomeException) +import Data.Char (toLower) import Data.Function (on) -import Data.List (sortBy) -import Data.Version (Version(..)) -import Debian.Debianize.Input (ghcVersion') +import Data.Function.Memoize (memoize2) +import Data.List (sortBy, isPrefixOf) +import Data.Map as Map (Map) +import Data.Maybe (mapMaybe, listToMaybe) +import Data.Version (Version(..), parseVersion) +import Debian.Debianize.VersionSplits (DebBase(DebBase), VersionSplits, cabalFromDebian') +import Debian.GHC ({- Memoizable instances -}) +import Debian.Relation (BinPkgName(..)) import Debian.Relation.ByteString() -import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..), {-PackageDB(GlobalPackageDB), compilerFlavor-}) +import Debian.Version (DebianVersion, parseDebianVersion) +import Distribution.Simple.Compiler (CompilerFlavor(..), {-PackageDB(GlobalPackageDB), compilerFlavor-}) import Distribution.Package (PackageIdentifier(..), PackageName(..) {-, Dependency(..)-}) - -type Bundled = (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 :: CompilerId -> Bundled -ghcBuiltIns (CompilerId GHC compilerVersion) = - case dropWhile (\ pr -> (fst pr < compilerVersion)) pairs of - [] -> error $ "cabal-debian: No bundled package list for ghc " ++ show compilerVersion - x : _ -> x -ghcBuiltIns _ = error "ghcBuiltIns: Only GHC is supported" - -pairs :: [Bundled] -pairs = sortBy - (compare `on` fst) - ([ (Version [7,8,20140228] [], ghc781BuiltIns) - , (Version [7,8,20140130] [], ghc781BuiltIns) - , (Version [7,8,1] [], ghc781BuiltIns) - - , (Version [7,6,3] [], ghc763BuiltIns) - , (Version [7,6,2] [], ghc762BuiltIns) - , (Version [7,6,1] [], ghc761BuiltIns) - , (Version [7,6,1,20121207] [], ghc761BuiltIns) - - , (Version [7,4,1] [], ghc741BuiltIns) - , (Version [7,4,0,20111219] [], ghc740BuiltIns) - , (Version [7,4,0,20120108] [], ghc740BuiltIns) - , (Version [7,2,2] [], ghc721BuiltIns) - , (Version [7,2,1] [], ghc721BuiltIns) - , (Version [7,0,4] [], ghc701BuiltIns) - , (Version [7,0,3] [], ghc701BuiltIns) - , (Version [7,0,1] [], ghc701BuiltIns) - , (Version [6,8,3] [], ghc683BuiltIns) - , (Version [6,8,2] [], ghc682BuiltIns) - , (Version [6,8,1] [], ghc681BuiltIns) - , (Version [6,6,1] [], ghc661BuiltIns) - , (Version [6,6] [], ghc66BuiltIns) ]) - -ghcBuiltIn :: MonadIO m => FilePath -> PackageName -> m (Maybe Version) -ghcBuiltIn root package = do - compiler <- ghcVersion' root >>= maybe (error $ "No GHC available in environment at " ++ show root) return - let (_, xs) = ghcBuiltIns compiler - packageIds = filter (\ p -> pkgName p == package) xs - case packageIds of - [] -> return Nothing - [p] -> return $ Just (pkgVersion p) - ps -> error $ "Multiple versions of " ++ show package ++ " built into " ++ show compiler ++ ": " ++ show ps - -v :: String -> [Int] -> PackageIdentifier -v n x = PackageIdentifier (PackageName n) (Version x []) - -ghc781BuiltIns :: [PackageIdentifier] -ghc781BuiltIns = [ - v "array" [0,5,0,0], - v "base" [4,7,0,0], - v "binary" [0,7,1,0], - v "bin-package-db" [0,0,0,0], - v "bytestring" [0,10,4,0], - v "Cabal" [1,18,1,3], - v "containers" [0,5,4,0], - v "deepseq" [1,3,0,2], - v "directory" [1,2,0,2], - v "filepath" [1,3,0,2], - v "ghc" [7,8,20140130], - v "ghc-prim" [0,3,1,0], - v "haskell2010" [1,1,1,1], - v "haskell98" [2,0,0,3], - v "hoopl" [3,10,0,0], - v "hpc" [0,6,0,1], - v "integer-gmp" [0,5,1,0], - v "old-locale" [1,0,0,6], - v "old-time" [1,1,0,2], - v "pretty" [1,1,1,1], - v "process" [1,2,0,0], - v "template-haskell" [2,9,0,0], - v "time" [1,4,1], - v "transformers" [0,3,0,0], - v "unix" [2,7,0,0] - ] - -ghc763BuiltIns :: [PackageIdentifier] -ghc763BuiltIns = [ - v "array" [0,4,0,1], - v "base" [4,6,0,1], - v "binary" [0,5,1,1], - v "bin-package-db" [0,0,0,0], - v "bytestring" [0,10,0,2], - v "Cabal" [1,16,0], - v "containers" [0,5,0,0], - v "deepseq" [1,3,0,1], - v "directory" [1,2,0,1], - v "filepath" [1,3,0,1], - v "ghc" [7,6,3], - v "ghc-prim" [0,3,0,0], - v "haskell2010" [1,1,1,0], - v "haskell98" [2,0,0,2], - v "hoopl" [3,9,0,0], - v "hpc" [0,6,0,0], - v "integer-gmp" [0,5,0,0], - v "old-locale" [1,0,0,5], - v "old-time" [1,1,0,1], - v "pretty" [1,1,1,0], - v "process" [1,1,0,2], - v "template-haskell" [2,8,0,0], - v "time" [1,4,0,1], - v "unix" [2,6,0,1] - ] - --- Removed: rts, extensible-exceptions -ghc762BuiltIns :: [PackageIdentifier] -ghc762BuiltIns = [ - v "array" [0,4,0,1], - v "base" [4,6,0,1], - v "binary" [0,5,1,1], - v "bin-package-db" [0,0,0,0], - v "bytestring" [0,10,0,2], - v "Cabal" [1,16,0], - v "containers" [0,5,0,0], - v "deepseq" [1,3,0,1], - v "directory" [1,2,0,1], - v "filepath" [1,3,0,1], - v "ghc" [7,6,2], - v "ghc-prim" [0,3,0,0], - v "haskell2010" [1,1,1,0], - v "haskell98" [2,0,0,2], - v "hoopl" [3,9,0,0], - v "hpc" [0,6,0,0], - v "integer-gmp" [0,5,0,0], - v "old-locale" [1,0,0,5], - v "old-time" [1,1,0,1], - v "pretty" [1,1,1,0], - v "process" [1,1,0,2], - v "template-haskell" [2,8,0,0], - v "time" [1,4,0,1], - v "unix" [2,6,0,1] - ] - --- Removed: rts, extensible-exceptions -ghc761BuiltIns :: [PackageIdentifier] -ghc761BuiltIns = [ - v "array" [0,4,0,1], - v "base" [4,6,0,1], - v "binary" [0,5,1,1], - v "bin-package-db" [0,0,0,0], - v "bytestring" [0,10,0,2], - v "Cabal" [1,16,0], - v "containers" [0,5,0,0], - v "deepseq" [1,3,0,1], - v "directory" [1,2,0,1], - v "filepath" [1,3,0,1], - v "ghc" [7,6,1,20121207], - v "ghc-prim" [0,3,0,0], - v "haskell2010" [1,1,1,0], - v "haskell98" [2,0,0,2], - v "hoopl" [3,9,0,0], - v "hpc" [0,6,0,0], - v "integer-gmp" [0,5,0,0], - v "old-locale" [1,0,0,5], - v "old-time" [1,1,0,1], - v "pretty" [1,1,1,0], - v "process" [1,1,0,2], - v "template-haskell" [2,8,0,0], - v "time" [1,4,0,1], - v "unix" [2,6,0,1] - ] - --- | Packages bundled with 7.4.0.20111219-2. -ghc741BuiltIns :: [PackageIdentifier] -ghc741BuiltIns = [ - v "Cabal" [1,14,0], - v "array" [0,4,0,0], - v "base" [4,5,0,0], - v "bin-package-db" [0,0,0,0], - v "binary" [0,5,1,0], - v "bytestring" [0,9,2,1], - v "containers" [0,4,2,1], - v "deepseq" [1,3,0,0], - v "directory" [1,1,0,2], - v "extensible-exceptions" [0,1,1,4], - v "filepath" [1,3,0,0], - v "ghc" [7,4,1], - v "ghc-prim" [0,2,0,0], - v "haskell2010" [1,1,0,1], - v "haskell98" [2,0,0,1], - v "hoopl" [3,8,7,2], - v "hpc" [0,5,1,1], - v "integer-gmp" [0,4,0,0], - v "old-locale" [1,0,0,4], - v "old-time" [1,1,0,0], - v "pretty" [1,1,1,0], - v "process" [1,1,0,1], - v "rts" [1,0], - v "template-haskell" [2,7,0,0], - v "time" [1,4], - v "unix" [2,5,1,0] ] - --- | Packages bundled with 7.4.0.20111219-2. -ghc740BuiltIns :: [PackageIdentifier] -ghc740BuiltIns = [ - v "Cabal" [1,14,0], - v "array" [0,4,0,0], - v "base" [4,5,0,0], - v "bin-package-db" [0,0,0,0], - v "binary" [0,5,1,0], - v "bytestring" [0,9,2,1], - v "containers" [0,4,2,1], - v "deepseq" [1,3,0,0], - v "directory" [1,1,0,2], - v "extensible-exceptions" [0,1,1,4], - v "filepath" [1,3,0,0], - v "ghc" [7,4,0,20111219], - v "ghc-prim" [0,2,0,0], - v "haskell2010" [1,1,0,1], - v "haskell98" [2,0,0,1], - v "hoopl" [3,8,7,2], - v "hpc" [0,5,1,1], - v "integer-gmp" [0,4,0,0], - v "old-locale" [1,0,0,4], - v "old-time" [1,1,0,0], - v "pretty" [1,1,1,0], - v "process" [1,1,0,1], - v "rts" [1,0], - v "template-haskell" [2,7,0,0], - v "time" [1,4], - v "unix" [2,5,1,0] ] - -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] - ] +import System.IO.Unsafe (unsafePerformIO) +import System.Process (readProcess) +import System.Unix.Chroot (useEnv) +import Text.Regex.TDFA ((=~)) +import Text.ParserCombinators.ReadP (readP_to_S) -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] - ] +-- | Find out what version, if any, of a cabal library is built into +-- the newest version of haskell compiler hc in environment root. For +-- GHC this is done by looking at what virtual packages debian package +-- provides. I have modified the ghcjs packaging to generate the +-- required virtual packages in the Provides line. For other +-- compilers it maybe be unimplemented. +builtIn :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> PackageName -> Maybe Version +builtIn splits hc root lib = do + f $ memoize2 (\ hc' root' -> unsafePerformIO (builtIn' splits hc' root')) hc root + where + f :: (DebianVersion, [PackageIdentifier]) -> Maybe Version + f (hcv, ids) = case map pkgVersion (filter (\ i -> pkgName i == lib) ids) of + [] -> Nothing + [v] -> Just v + vs -> error $ show hc ++ "-" ++ show hcv ++ " in " ++ show root ++ " provides multiple versions of " ++ show lib ++ ": " ++ show vs -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] - ] +-- | Ok, lets see if we can infer the built in packages from the +-- Provides field returned by apt-cache. +builtIn' :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> IO (DebianVersion, [PackageIdentifier]) +builtIn' splits hc root = do + lns <- lines . either (\ (e :: SomeException) -> error $ "builtIn: " ++ show e) id <$> try (chroot root (readProcess "apt-cache" ["showpkg", hcname] "")) + let hcs = map words $ takeBetween (isPrefixOf "Provides:") (isPrefixOf "Reverse Provides:") lns + hcs' = reverse . sortBy (compare `on` fst) . map doHCVersion $ hcs + case hcs' of + [] -> error $ "No versions of " ++ show hc ++ " (" ++ show hcname ++ ") in " ++ show root + ((v, pids) : _) -> return (v, pids) + where + BinPkgName hcname = BinPkgName (map toLower (show hc)) + -- Find out what library versions are provided by the latest version + -- of the compiler. + doHCVersion :: [String] -> (DebianVersion, [PackageIdentifier]) + doHCVersion (versionString : "-" : deps) = (parseDebianVersion versionString, mapMaybe parsePackageID deps) + doHCVersion x = error $ "Unexpected output from apt-cache: " ++ show x + -- The virtual package id, which appears in the Provides + -- line for the compiler package, is generated by the + -- function package_id_to_virtual_package in Dh_Haskell.sh. + -- It consists of the library's debian package name and the + -- first five characters of the checksum. + -- parsePID "libghc-unix-dev-2.7.0.1-2a456" -> Just (PackageIdentifier "unix" (Version [2,7,0,1] [])) + parsePackageID :: String -> Maybe PackageIdentifier + parsePackageID s = case s =~ ("lib" ++ hcname ++ "-(.*)-dev-([0-9.]*)-.....$") :: (String, String, String, [String]) of + (_, _, _, [base, vs]) -> case listToMaybe (map fst $ filter ((== "") . snd) $ readP_to_S parseVersion $ vs) of + Just v -> Just (cabalFromDebian' splits (DebBase base) v) + Nothing -> Nothing + _ -> Nothing + chroot "/" = id + chroot _ = useEnv root (return . force) --- Script to output a list of the libraries in the ghc package --- provides line. This could be run inside the build environment --- instead of having these hard coded lists. --- --- apt-cache show ghc \ --- | grep ^Provides: \ --- | cut -d\ -f2- --- | sed 's/, /\n/g' \ --- | grep libghc- \ --- | cut -d- -f2- \ --- | grep dev$ \ --- | sort -u \ --- | sed 's/-dev//;s/$/",/;s/^/"/' --- --- base :: Set String --- base --- = Data.Set.fromList --- [ "array", --- "base", --- "binary", --- "bin-package-db", --- "bytestring", --- "cabal", --- "containers", --- "deepseq", --- "directory", --- "extensible-exceptions", --- "filepath", --- "ghc-prim", --- "haskell2010", --- "haskell98", --- "hoopl", --- "hpc", --- "integer-gmp", --- "old-locale", --- "old-time", --- "pretty", --- "process", --- "rts", --- "template-haskell", --- "time", --- "unix" ] +takeBetween :: (a -> Bool) -> (a -> Bool) -> [a] -> [a] +takeBetween startPred endPred = takeWhile (not . endPred) . dropWhile startPred . dropWhile (not . startPred) diff --git a/src/Debian/Debianize/DebianName.hs b/src/Debian/Debianize/DebianName.hs --- a/src/Debian/Debianize/DebianName.hs +++ b/src/Debian/Debianize/DebianName.hs @@ -13,14 +13,15 @@ import Data.Map as Map (lookup, alter) import Data.Version (Version, showVersion) import Debian.Debianize.Types.BinaryDebDescription as Debian (PackageType(..)) -import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription) +import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription, compilerFlavor) import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude ((%=)) -import Debian.Debianize.VersionSplits (insertSplit, doSplits, VersionSplits, makePackage) +import Debian.Debianize.VersionSplits (DebBase(DebBase), insertSplit, doSplits, VersionSplits, makePackage) import Debian.Orphans () import Debian.Relation (PkgName(..), Relations) import qualified Debian.Relation as D (VersionReq(EEQ)) import Debian.Version (parseDebianVersion) +import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import qualified Distribution.PackageDescription as Cabal import Prelude hiding (unlines) @@ -35,22 +36,23 @@ -- | Build the Debian package name for a given package type. debianName :: (Monad m, PkgName name) => PackageType -> DebT m name debianName typ = - do Just pkgDesc <- access packageDescription + do cfl <- access compilerFlavor + Just pkgDesc <- access packageDescription let pkgId = Cabal.package pkgDesc nameMap <- access T.debianNameMap - return $ debianName' (Map.lookup (pkgName pkgId) nameMap) typ pkgId + return $ debianName' cfl (Map.lookup (pkgName pkgId) nameMap) typ pkgId -- | Function that applies the mapping from cabal names to debian -- names based on version numbers. If a version split happens at v, -- this will return the ltName if < v, and the geName if the relation -- is >= v. -debianName' :: (PkgName name) => Maybe VersionSplits -> PackageType -> PackageIdentifier -> name -debianName' msplits typ pkgId = +debianName' :: (PkgName name) => CompilerFlavor -> Maybe VersionSplits -> PackageType -> PackageIdentifier -> name +debianName' cfl msplits typ pkgId = case msplits of - Nothing -> mkPkgName pname typ - Just splits -> (\ s -> mkPkgName' s typ) $ doSplits splits version + Nothing -> mkPkgName cfl pname typ + Just splits -> (\ s -> mkPkgName' cfl s typ) $ doSplits splits version where - -- def = mkPkgName pname typ + -- def = mkPkgName cfl pname typ pname@(PackageName _) = pkgName pkgId version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId))))) @@ -58,24 +60,25 @@ -- debian package type. Unfortunately, this does not enforce the -- correspondence between the PackageType value and the name type, so -- it can return nonsense like (SrcPkgName "libghc-debian-dev"). -mkPkgName :: PkgName name => PackageName -> PackageType -> name -mkPkgName pkg typ = mkPkgName' (debianBaseName pkg) typ +mkPkgName :: PkgName name => CompilerFlavor -> PackageName -> PackageType -> name +mkPkgName cfl pkg typ = mkPkgName' cfl (debianBaseName pkg) typ -mkPkgName' :: PkgName name => String -> PackageType -> name -mkPkgName' base typ = +mkPkgName' :: PkgName name => CompilerFlavor -> DebBase -> PackageType -> name +mkPkgName' cfl (DebBase base) typ = pkgNameFromString $ case typ of - Documentation -> "libghc-" ++ base ++ "-doc" - Development -> "libghc-" ++ base ++ "-dev" - Profiling -> "libghc-" ++ base ++ "-prof" + Documentation -> prefix ++ base ++ "-doc" + Development -> prefix ++ base ++ "-dev" + Profiling -> prefix ++ base ++ "-prof" Utilities -> "haskell-" ++ base ++ "-utils" Exec -> base Source' -> "haskell-" ++ base ++ "" Cabal -> base + where prefix = "lib" ++ map toLower (show cfl) ++ "-" -debianBaseName :: PackageName -> String +debianBaseName :: PackageName -> DebBase debianBaseName (PackageName name) = - map (fixChar . toLower) name + DebBase (map (fixChar . toLower) name) where -- Underscore is prohibited in debian package names. fixChar :: Char -> Char @@ -86,7 +89,7 @@ -- Not really a debian package name, but the name of a cabal package -- that maps to the debian package name we want. (Should this be a -- SrcPkgName?) -mapCabal :: Monad m => PackageName -> String -> DebT m () +mapCabal :: Monad m => PackageName -> DebBase -> DebT m () mapCabal pname dname = debianNameMap %= Map.alter f pname where @@ -95,7 +98,7 @@ f (Just sp) = error $ "mapCabal " ++ show pname ++ " " ++ show dname ++ ": - already mapped: " ++ show sp -- | Map versions less than ver of Cabal Package pname to Debian package ltname -splitCabal :: Monad m => PackageName -> String -> Version -> DebT m () +splitCabal :: Monad m => PackageName -> DebBase -> Version -> DebT m () splitCabal pname ltname ver = debianNameMap %= Map.alter f pname where diff --git a/src/Debian/Debianize/Details.hs b/src/Debian/Debianize/Details.hs --- a/src/Debian/Debianize/Details.hs +++ b/src/Debian/Debianize/Details.hs @@ -1,48 +1,39 @@ {-# OPTIONS -Wall #-} module Debian.Debianize.Details ( debianDefaultAtoms - , seereasonDefaultAtoms + , debianVersionSplits ) where +import Data.Map as Map (Map, fromList) import Data.Version (Version(Version)) import Debian.Debianize.DebianName (mapCabal, splitCabal) -import Debian.Debianize.Types.Atoms as T (epochMap, missingDependencies) +import Debian.Debianize.Types.Atoms as T (epochMap) import Debian.Debianize.Monad (DebT) -import Debian.Debianize.Prelude ((+=), (++=)) -import Debian.Relation (BinPkgName(BinPkgName)) +import Debian.Debianize.Prelude ((++=)) +import Debian.Debianize.VersionSplits (DebBase(DebBase), VersionSplits, makePackage, insertSplit) import Distribution.Package (PackageName(PackageName)) +-- | Some details about the debian repository - special cases for how +-- some cabal packages are mapped to debian package names. debianDefaultAtoms :: Monad m => DebT m () debianDefaultAtoms = do T.epochMap ++= (PackageName "HaXml", 1) T.epochMap ++= (PackageName "HTTP", 1) - mapCabal (PackageName "parsec") "parsec3" - splitCabal (PackageName "parsec") "parsec2" (Version [3] []) - mapCabal (PackageName "QuickCheck") "quickcheck2" - splitCabal (PackageName "QuickCheck") "quickcheck1" (Version [2] []) - mapCabal (PackageName "gtk2hs-buildtools") "gtk2hs-buildtools" - -seereasonDefaultAtoms :: Monad m => DebT m () -seereasonDefaultAtoms = - do debianDefaultAtoms - - missingDependencies += BinPkgName "libghc-happstack-authenticate-9-doc" - - mapCabal (PackageName "clckwrks") "clckwrks" - splitCabal (PackageName "clckwrks") "clckwrks-13" (Version [0, 14] []) - splitCabal (PackageName "clckwrks") "clckwrks-14" (Version [0, 15] []) - - mapCabal (PackageName "blaze-html") "blaze-html" - splitCabal (PackageName "blaze-html") "blaze-html-5" (Version [0, 6] []) - - mapCabal (PackageName "happstack-authenticate") "happstack-authenticate" - splitCabal (PackageName "happstack-authenticate") "happstack-authenticate-9" (Version [0, 10] []) - - mapCabal (PackageName "http-types") "http-types" - splitCabal (PackageName "http-types") "http-types-7" (Version [0, 8] []) - - mapCabal (PackageName "web-plugins") "web-plugins" - splitCabal (PackageName "web-plugins") "web-plugins-1" (Version [0, 2] []) + mapCabal (PackageName "parsec") (DebBase "parsec3") + splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] []) + mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2") + splitCabal (PackageName "QuickCheck") (DebBase "quickcheck1") (Version [2] []) + mapCabal (PackageName "gtk2hs-buildtools") (DebBase "gtk2hs-buildtools") - mapCabal (PackageName "case-insensitive") "case-insensitive" - splitCabal (PackageName "case-insensitive") "case-insensitive-0" (Version [1] []) +-- | These are the instances of debian names changing that I know +-- about. I know they really shouldn't be hard coded. Send a patch. +-- Note that this inherits the lack of type safety of the mkPkgName +-- function. (FIXME: Use combinators to construct this.) +debianVersionSplits :: Map PackageName VersionSplits +debianVersionSplits = + Map.fromList + [ (PackageName "Cabal", makePackage (DebBase "cabal")) + , (PackageName "parsec", insertSplit (Version [3] []) (DebBase "parsec3") (makePackage (DebBase "parsec2"))) + , (PackageName "QuickCheck", insertSplit (Version [2] []) (DebBase "quickcheck2") (makePackage (DebBase "quickcheck1"))) + -- This looks like a no-op - probably isn't needed. + , (PackageName "gtk2hs-buildtools", makePackage (DebBase "gtk2hs-buildtools")) ] diff --git a/src/Debian/Debianize/Finalize.hs b/src/Debian/Debianize/Finalize.hs --- a/src/Debian/Debianize/Finalize.hs +++ b/src/Debian/Debianize/Finalize.hs @@ -31,8 +31,8 @@ import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs) import Debian.Debianize.Prelude ((%=), (+++=), (+=), foldEmpty, fromEmpty, fromSingleton, (~=), (~?=)) import Debian.Debianize.Types (Top) -import qualified Debian.Debianize.Types as T (apacheSite, backups, binaryArchitectures, binaryPackages, binarySection, breaks, buildDepends, buildDependsIndep, buildDir, builtUsing, changelog, comments, compat, conflicts, debianDescription, debVersion, depends, epochMap, executable, extraDevDeps, extraLibMap, file, install, installCabalExec, installCabalExecTo, installData, installDir, installTo, intermediateFiles, license, link, maintainer, noDocumentationLibrary, noProfilingLibrary, packageDescription, packageType, preDepends, provides, recommends, replaces, revision, rulesFragments, serverInfo, source, sourcePackageName, sourcePriority, sourceSection, suggests, utilsPackageNames, verbosity, watch, website, buildEnv) -import qualified Debian.Debianize.Types.Atoms as A (InstallFile(execName, sourceDir), showAtoms) +import qualified Debian.Debianize.Types as T (apacheSite, backups, binaryArchitectures, binaryPackages, binarySection, breaks, buildDepends, buildDependsIndep, buildDir, builtUsing, changelog, comments, compat, conflicts, debianDescription, debVersion, depends, epochMap, executable, extraDevDeps, extraLibMap, file, install, installCabalExec, installCabalExecTo, installData, installDir, installTo, intermediateFiles, license, link, maintainer, noDocumentationLibrary, noProfilingLibrary, noHoogle, packageDescription, packageType, preDepends, provides, recommends, replaces, revision, rulesFragments, serverInfo, source, sourcePackageName, sourcePriority, sourceSection, suggests, utilsPackageNames, verbosity, watch, website) +import qualified Debian.Debianize.Types.Atoms as A (InstallFile(execName, sourceDir), showAtoms, compilerFlavor) import qualified Debian.Debianize.Types.BinaryDebDescription as B (BinaryDebDescription, package, PackageType(Development, Documentation, Exec, Profiling, Source', Utilities)) import Debian.Orphans () import Debian.Policy (getDebhelperCompatLevel, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Optional), Section(..)) @@ -42,10 +42,11 @@ import Debian.Release (parseReleaseName) import Debian.Time (getCurrentLocalRFC822Time) import Debian.Version (buildDebianVersion, DebianVersion, parseDebianVersion) +import Distribution.Compiler (CompilerFlavor(GHC)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName)) -import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, executables, library, license, package)) +import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataDir, dataFiles, executables, library, license, package)) import Prelude hiding (init, log, map, unlines, unlines, writeFile) import System.FilePath ((<.>), (), makeRelative, splitFileName, takeDirectory, takeFileName) @@ -54,7 +55,7 @@ -- description and possibly the debian/changelog file, then generate -- and return the new debianization (along with the data directory -- computed from the cabal package description.) -debianization :: Top -> DebT IO () -> DebT IO () -> DebT IO () +debianization :: (MonadIO m, Functor m) => Top -> DebT m () -> DebT m () -> DebT m () debianization top init customize = do compileEnvironmentArgs compileCommandlineArgs @@ -241,8 +242,8 @@ do edds <- access T.extraDevDeps T.depends b %= \ rels -> [anyrel "${shlibs:Depends}", anyrel "${haskell:Depends}", anyrel "${misc:Depends}"] ++ (if typ == B.Development then edds else []) ++ rels - T.recommends b ~= [anyrel "${haskell:Recommends}"] - T.suggests b ~= [anyrel "${haskell:Suggests}"] + T.recommends b %= \ rels -> [anyrel "${haskell:Recommends}"] ++ rels + T.suggests b %= \ rels -> [anyrel "${haskell:Suggests}"] ++ rels T.preDepends b ~= [] T.breaks b ~= [] T.conflicts b %= \ rels -> [anyrel "${haskell:Conflicts}"] ++ rels @@ -254,17 +255,18 @@ librarySpecs pkgDesc = do debName <- debianName B.Documentation let dev = isJust (Cabal.library pkgDesc) - doc <- get >>= return . (/= singleton True) . getL T.noDocumentationLibrary - prof <- get >>= return . (/= singleton True) . getL T.noProfilingLibrary + doc <- get >>= return . not . getL T.noDocumentationLibrary + prof <- get >>= return . not . getL T.noProfilingLibrary + cfl <- access A.compilerFlavor + hoogle <- get >>= return . not . getL T.noHoogle when dev (librarySpec Any B.Development) - when (dev && prof) (librarySpec Any B.Profiling) - when (dev && doc) + when (dev && prof && cfl == GHC) (librarySpec Any B.Profiling) + when (dev && doc && hoogle) (do docSpecsParagraph T.link +++= (debName, singleton ("/usr/share/doc" show (pretty debName) "html" cabal <.> "txt", - "/usr/lib/ghc-doc/hoogle" hoogle <.> "txt"))) + "/usr/lib/ghc-doc/hoogle" List.map toLower cabal <.> "txt"))) where PackageName cabal = pkgName (Cabal.package pkgDesc) - hoogle = List.map toLower cabal docSpecsParagraph :: Monad m => DebT m () docSpecsParagraph = @@ -308,18 +310,21 @@ -- The names of cabal executables that go into eponymous debs insExecPkg <- access T.executable >>= return . Set.map ename . Set.fromList . elems - let installedData = Set.unions (Map.elems installedDataMap) + let installedData = Set.map (\ a -> (a, a)) $ Set.unions (Map.elems installedDataMap) installedExec = Set.unions (Map.elems installedExecMap) - let availableData = Set.union installedData (Set.fromList (Cabal.dataFiles pkgDesc)) :: Set FilePath - availableExec = Set.union installedExec (Set.map Cabal.exeName (Set.filter (Cabal.buildable . Cabal.buildInfo) (Set.fromList (Cabal.executables pkgDesc)))) :: Set FilePath + let prefixPath = Cabal.dataDir pkgDesc + let dataFilePaths = Set.fromList (zip (List.map (prefixPath ) (Cabal.dataFiles pkgDesc)) (Cabal.dataFiles pkgDesc)) :: Set (FilePath, FilePath) + execFilePaths = Set.map Cabal.exeName (Set.filter (Cabal.buildable . Cabal.buildInfo) (Set.fromList (Cabal.executables pkgDesc))) :: Set FilePath + let availableData = Set.union installedData dataFilePaths + availableExec = Set.union installedExec execFilePaths access T.utilsPackageNames >>= \ names -> when (Set.null names) (debianName B.Utilities >>= \ name -> T.utilsPackageNames ~= singleton name) utilsPackages <- access T.utilsPackageNames -- Files that are installed into packages other than the utils packages - let installedDataOther = Set.unions $ Map.elems $ foldr (Map.delete) installedDataMap (Set.toList utilsPackages) + let installedDataOther = Set.map (\ a -> (a, a)) $ Set.unions $ Map.elems $ foldr (Map.delete) installedDataMap (Set.toList utilsPackages) installedExecOther = Set.union (tr "insExecPkg: " insExecPkg) $ Set.unions $ Map.elems $ foldr (Map.delete) (tr "installedExec: " installedExecMap) (Set.toList utilsPackages) @@ -338,7 +343,7 @@ T.binarySection p ~?= Just (MainSection "misc") binaryPackageRelations p B.Utilities) utilsPackages) -- Add the unassigned files to the utils packages - Set.mapM_ (\ p -> Set.mapM_ (\ path -> T.installData +++= (p, singleton (path, path))) utilsDataMissing) utilsPackages + Set.mapM_ (\ p -> Set.mapM_ (\ pair -> T.installData +++= (p, singleton pair)) utilsDataMissing) utilsPackages Set.mapM_ (\ p -> Set.mapM_ (\ name -> T.installCabalExec +++= (p, singleton (name, "usr/bin"))) (tr "utilsExecMissing: " utilsExecMissing)) utilsPackages where ename i = diff --git a/src/Debian/Debianize/Goodies.hs b/src/Debian/Debianize/Goodies.hs --- a/src/Debian/Debianize/Goodies.hs +++ b/src/Debian/Debianize/Goodies.hs @@ -18,6 +18,7 @@ , makeRulesHead ) where +import Data.Char (toLower) import Data.Lens.Lazy (modL, access) import Data.List as List (map, intersperse, intercalate) import Data.Map as Map (insertWith) @@ -178,6 +179,7 @@ T.installDir +++= (b, singleton (apacheLogDirectory b)) T.logrotateStanza +++= (b, singleton (Text.unlines $ [ pack (apacheAccessLog b) <> " {" + , " copytruncate" -- hslogger doesn't notice when the log is rotated, maybe this will help , " weekly" , " rotate 5" , " compress" @@ -185,6 +187,7 @@ , "}"])) T.logrotateStanza +++= (b, singleton (Text.unlines $ [ pack (apacheErrorLog b) <> " {" + , " copytruncate" , " weekly" , " rotate 5" , " compress" @@ -356,7 +359,10 @@ makeRulesHead :: Monad m => DebT m Text makeRulesHead = do b <- debianName B.Cabal - let ls = ["DEB_CABAL_PACKAGE = " <> pack (show (pretty (b :: BinPkgName))), ""] + hc <- access T.compilerFlavor + let ls = ["DEB_CABAL_PACKAGE = " <> pack (show (pretty (b :: BinPkgName))), + "HC = " <> pack (map toLower (show hc)), + ""] return $ Text.unlines $ ["#!/usr/bin/make -f", ""] ++ diff --git a/src/Debian/Debianize/Input.hs b/src/Debian/Debianize/Input.hs --- a/src/Debian/Debianize/Input.hs +++ b/src/Debian/Debianize/Input.hs @@ -1,12 +1,10 @@ -- | Read an existing Debianization from a directory file. -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-} +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.Debianize.Input ( inputDebianization , inputDebianizationFile , inputChangeLog - , ghcVersion - , ghcVersion' , inputCabalization , inputCabalization' , inputMaintainer @@ -15,41 +13,49 @@ import Debug.Trace (trace) +import Control.Applicative ((<$>)) import Control.Category ((.)) -import Control.DeepSeq (NFData, force) +--import Control.DeepSeq (NFData, force) import Control.Exception (bracket) -import Control.Monad (when, foldM, filterM) +import Control.Monad (when, filterM) import Control.Monad.State (get, put) -import Control.Monad.Trans (MonadIO, liftIO, lift) +import Control.Monad.Trans (MonadIO, liftIO) import Data.Char (isSpace, toLower) import Data.Lens.Lazy (getL, setL, modL, access) import Data.Maybe (fromMaybe) import Data.Set as Set (Set, toList, fromList, insert, singleton) import Data.Text (Text, unpack, pack, lines, words, break, strip, null) import Data.Text.IO (readFile) -import Data.Version (showVersion, Version(Version)) +--import Data.Version (showVersion, Version(Version)) import Debian.Changes (ChangeLog(..), ChangeLogEntry(logWho), parseChangeLog) import Debian.Control (Control'(unControl), Paragraph'(..), stripWS, parseControlFromFile, Field, Field'(..), ControlFunctions) import qualified Debian.Debianize.Types as T (maintainer) -import qualified Debian.Debianize.Types.Atoms as T (changelog) +import qualified Debian.Debianize.Types.Atoms as T (changelog, compilerFlavor, makeAtoms) import Debian.Debianize.Types.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription) import qualified Debian.Debianize.Types.BinaryDebDescription as B import qualified Debian.Debianize.Types.SourceDebDescription as S import Debian.Debianize.Types.Atoms - (newAtoms, control, warning, sourceFormat, watch, rulesHead, compat, packageDescription, + (control, warning, sourceFormat, watch, rulesHead, compat, packageDescription, license, licenseFile, copyright, changelog, installInit, postInst, postRm, preInst, preRm, - logrotateStanza, link, install, installDir, intermediateFiles, cabalFlagAssignments, verbosity) -import Debian.Debianize.Monad (Atoms, DebT, execDebT) + logrotateStanza, link, install, installDir, intermediateFiles, cabalFlagAssignments, verbosity, buildEnv) +import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude (getDirectoryContents', withCurrentDirectory, readFileMaybe, read', intToVerbosity', (~=), (~?=), (+=), (++=), (+++=)) -import Debian.Debianize.Types (Top(unTop), buildEnv) +import Debian.Debianize.Types (Top(unTop)) +import Debian.Debianize.Types.Atoms (EnvSet(dependOS)) +import Debian.GHC (newestAvailableCompilerId) import Debian.Orphans () import Debian.Policy (Section(..), parseStandardsVersion, readPriority, readSection, parsePackageArchitectures, parseMaintainer, parseUploaders, readSourceFormat, getDebianMaintainer) import Debian.Relation (Relations, BinPkgName(..), SrcPkgName(..), parseRelations) -import Debian.Version (DebianVersion, parseDebianVersion) -import Distribution.Compiler (CompilerId(CompilerId), CompilerFlavor(GHC)) +--import Debian.Version (DebianVersion, parseDebianVersion) +import Distribution.Compiler (CompilerId) import Distribution.Package (Package(packageId), PackageIdentifier(..), PackageName(PackageName), Dependency) -import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFile, maintainer, package, license, copyright {-, synopsis, description-})) +import qualified Distribution.PackageDescription as Cabal (PackageDescription(maintainer, package, license, copyright {-, synopsis, description-})) +#if MIN_VERSION_Cabal(1,19,0) +import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFiles)) +#else +import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFile)) +#endif import Distribution.PackageDescription as Cabal (PackageDescription, FlagName) import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription) @@ -57,33 +63,35 @@ import Distribution.System (Platform(..), buildOS, buildArch) import Distribution.Verbosity (Verbosity) import Prelude hiding (readFile, lines, words, break, null, log, sum, (.)) -import qualified Prelude (lines) -import System.Directory (doesFileExist, doesDirectoryExist) +-- import qualified Prelude (lines) +import System.Directory (doesFileExist) import System.Exit (ExitCode(..)) import System.FilePath ((), takeExtension, dropExtension) import System.Posix.Files (setFileCreationMask) -import System.Process (readProcess, system) +import System.Process (system) import System.IO.Error (catchIOError, tryIOError) -import System.Unix.Chroot (useEnv) +-- import System.Unix.Chroot (useEnv) -- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) -inputDebianization :: Top -> DebT IO () -inputDebianization top = +inputDebianization :: MonadIO m => Top -> EnvSet -> DebT m () +inputDebianization top envset = do -- Erase any the existing information - put newAtoms + hc <- access T.compilerFlavor + let atoms = T.makeAtoms hc envset + put atoms (ctl, _) <- inputSourceDebDescription top inputAtomsFromDirectory top control ~= ctl -- | Try to input a file and if successful add it to the debianization. -inputDebianizationFile :: Top -> FilePath -> DebT IO () +inputDebianizationFile :: MonadIO m => Top -> FilePath -> DebT m () inputDebianizationFile top path = do inputAtomsFromDirectory top - lift (readFileMaybe (unTop top path)) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text)) + liftIO (readFileMaybe (unTop top path)) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text)) -inputSourceDebDescription :: Top -> DebT IO (S.SourceDebDescription, [Field]) +inputSourceDebDescription :: MonadIO m => Top -> DebT m (S.SourceDebDescription, [Field]) inputSourceDebDescription top = - do paras <- lift $ parseControlFromFile (unTop top "debian/control") >>= either (error . show) (return . unControl) + do paras <- liftIO $ parseControlFromFile (unTop top "debian/control") >>= either (error . show) (return . unControl) case paras of [] -> error "Missing source paragraph" [_] -> error "Missing binary paragraph" @@ -192,61 +200,59 @@ do log <- liftIO $ tryIOError (readFile (unTop top "debian/changelog") >>= return . parseChangeLog . unpack) changelog ~?= either (\ _ -> Nothing) Just log -inputAtomsFromDirectory :: Top -> DebT IO () -- .install files, .init files, etc. +inputAtomsFromDirectory :: MonadIO m => Top -> DebT m () -- .install files, .init files, etc. inputAtomsFromDirectory top = - do atoms <- get - atoms' <- lift $ findFiles atoms - atoms'' <- lift $ doFiles (unTop top "debian/cabalInstall") atoms' - put atoms'' + do findFiles + doFiles (unTop top "debian/cabalInstall") where - -- Find regular files matching debian/* and debian/source/format and + -- Find regular files in the debian/ or in debian/source/format/ and -- add them to the debianization. - findFiles :: Atoms -> IO Atoms - findFiles atoms = - getDirectoryContents' (unTop top "debian") >>= + findFiles :: MonadIO m => DebT m () + findFiles = + liftIO (getDirectoryContents' (unTop top "debian")) >>= return . (++ ["source/format"]) >>= - filterM (doesFileExist . ((unTop top "debian") )) >>= - foldM (\ atoms' name -> inputAtoms (unTop top "debian") name atoms') atoms - doFiles :: FilePath -> Atoms -> IO Atoms - doFiles tmp atoms = - do sums <- getDirectoryContents' tmp `catchIOError` (\ _ -> return []) - paths <- mapM (\ sum -> getDirectoryContents' (tmp sum) >>= return . map (sum )) sums >>= return . filter ((/= '~') . last) . concat - files <- mapM (readFile . (tmp )) paths - execDebT (mapM_ (intermediateFiles +=) (zip (map ("debian/cabalInstall" ) paths) files)) atoms + liftIO . filterM (doesFileExist . ((unTop top "debian") )) >>= \ names -> + mapM_ (inputAtoms (unTop top "debian")) names + doFiles :: MonadIO m => FilePath -> DebT m () + doFiles tmp = + do sums <- liftIO $ getDirectoryContents' tmp `catchIOError` (\ _ -> return []) + paths <- liftIO $ mapM (\ sum -> getDirectoryContents' (tmp sum) >>= return . map (sum )) sums >>= return . filter ((/= '~') . last) . concat + files <- liftIO $ mapM (readFile . (tmp )) paths + mapM_ (intermediateFiles +=) (zip (map ("debian/cabalInstall" ) paths) files) -- | Construct a file path from the debian directory and a relative -- path, read its contents and add the result to the debianization. -- This may mean using a specialized parser from the debian package -- (e.g. parseChangeLog), and some files (like control) are ignored -- here, though I don't recall why at the moment. -inputAtoms :: FilePath -> FilePath -> Atoms -> IO Atoms -inputAtoms _ path xs | elem path ["control"] = return xs -inputAtoms debian name@"source/format" xs = readFile (debian name) >>= \ text -> execDebT (either (warning +=) ((sourceFormat ~=) . Just) (readSourceFormat text)) xs -inputAtoms debian name@"watch" xs = readFile (debian name) >>= \ text -> execDebT (watch ~= Just text) xs -inputAtoms debian name@"rules" xs = readFile (debian name) >>= \ text -> execDebT (rulesHead ~= (Just text)) xs -inputAtoms debian name@"compat" xs = readFile (debian name) >>= \ text -> execDebT (compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text))) xs -inputAtoms debian name@"copyright" xs = readFile (debian name) >>= \ text -> execDebT (copyright ~= Just text) xs -inputAtoms debian name@"changelog" xs = - readFile (debian name) >>= return . parseChangeLog . unpack >>= \ log -> execDebT (changelog ~= Just log) xs -inputAtoms debian name xs = +inputAtoms :: MonadIO m => FilePath -> FilePath -> DebT m () +inputAtoms _ path | elem path ["control"] = return () +inputAtoms debian name@"source/format" = liftIO (readFile (debian name)) >>= \ text -> either (warning +=) ((sourceFormat ~=) . Just) (readSourceFormat text) +inputAtoms debian name@"watch" = liftIO (readFile (debian name)) >>= \ text -> watch ~= Just text +inputAtoms debian name@"rules" = liftIO (readFile (debian name)) >>= \ text -> rulesHead ~= (Just text) +inputAtoms debian name@"compat" = liftIO (readFile (debian name)) >>= \ text -> compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text)) +inputAtoms debian name@"copyright" = liftIO (readFile (debian name)) >>= \ text -> copyright ~= Just text +inputAtoms debian name@"changelog" = + liftIO (readFile (debian name)) >>= return . parseChangeLog . unpack >>= \ log -> changelog ~= Just log +inputAtoms debian name = case (BinPkgName (dropExtension name), takeExtension name) of - (p, ".install") -> readFile (debian name) >>= \ text -> execDebT (mapM_ (readInstall p) (lines text)) xs - (p, ".dirs") -> readFile (debian name) >>= \ text -> execDebT (mapM_ (readDir p) (lines text)) xs - (p, ".init") -> readFile (debian name) >>= \ text -> execDebT (installInit ++= (p, text)) xs - (p, ".logrotate") -> readFile (debian name) >>= \ text -> execDebT (logrotateStanza +++= (p, singleton text)) xs - (p, ".links") -> readFile (debian name) >>= \ text -> execDebT (mapM_ (readLink p) (lines text)) xs - (p, ".postinst") -> readFile (debian name) >>= \ text -> execDebT (postInst ++= (p, text)) xs - (p, ".postrm") -> readFile (debian name) >>= \ text -> execDebT (postRm ++= (p, text)) xs - (p, ".preinst") -> readFile (debian name) >>= \ text -> execDebT (preInst ++= (p, text)) xs - (p, ".prerm") -> readFile (debian name) >>= \ text -> execDebT (preRm ++= (p, text)) xs - (_, ".log") -> return xs -- Generated by debhelper - (_, ".debhelper") -> return xs -- Generated by debhelper - (_, ".hs") -> return xs -- Code that uses this library - (_, ".setup") -> return xs -- Compiled Setup.hs file - (_, ".substvars") -> return xs -- Unsupported - (_, "") -> return xs -- File with no extension - (_, x) | last x == '~' -> return xs -- backup file - _ -> trace ("Ignored: " ++ debian name) (return xs) + (p, ".install") -> liftIO (readFile (debian name)) >>= \ text -> mapM_ (readInstall p) (lines text) + (p, ".dirs") -> liftIO (readFile (debian name)) >>= \ text -> mapM_ (readDir p) (lines text) + (p, ".init") -> liftIO (readFile (debian name)) >>= \ text -> installInit ++= (p, text) + (p, ".logrotate") -> liftIO (readFile (debian name)) >>= \ text -> logrotateStanza +++= (p, singleton text) + (p, ".links") -> liftIO (readFile (debian name)) >>= \ text -> mapM_ (readLink p) (lines text) + (p, ".postinst") -> liftIO (readFile (debian name)) >>= \ text -> postInst ++= (p, text) + (p, ".postrm") -> liftIO (readFile (debian name)) >>= \ text -> postRm ++= (p, text) + (p, ".preinst") -> liftIO (readFile (debian name)) >>= \ text -> preInst ++= (p, text) + (p, ".prerm") -> liftIO (readFile (debian name)) >>= \ text -> preRm ++= (p, text) + (_, ".log") -> return () -- Generated by debhelper + (_, ".debhelper") -> return () -- Generated by debhelper + (_, ".hs") -> return () -- Code that uses this library + (_, ".setup") -> return () -- Compiled Setup.hs file + (_, ".substvars") -> return () -- Unsupported + (_, "") -> return () -- File with no extension + (_, x) | last x == '~' -> return () -- backup file + _ -> trace ("Ignored: " ++ debian name) (return ()) -- | Read a line from a debian .links file readLink :: Monad m => BinPkgName -> Text -> DebT m () @@ -267,13 +273,14 @@ readDir :: Monad m => BinPkgName -> Text -> DebT m () readDir p line = installDir +++= (p, singleton (unpack line)) -inputCabalization :: MonadIO m => Top -> DebT m () +inputCabalization :: (MonadIO m, Functor m) => Top -> DebT m () inputCabalization top = - do vb <- access verbosity >>= return . intToVerbosity' + do hc <- access T.compilerFlavor + vb <- access verbosity >>= return . intToVerbosity' flags <- access cabalFlagAssignments - root <- access buildEnv - mcid <- liftIO (ghcVersion' root) - ePkgDesc <- liftIO $ inputCabalization' top vb flags (fromMaybe (error $ "inputCabalization - invalid buildEnv: " ++ show root) mcid) + root <- dependOS <$> access buildEnv + let mcid = newestAvailableCompilerId hc root + ePkgDesc <- liftIO $ inputCabalization' top vb flags mcid either (\ deps -> error $ "Missing dependencies in cabal package at " ++ show (unTop top) ++ ": " ++ show deps) (\ pkgDesc -> do packageDescription ~= Just pkgDesc @@ -281,9 +288,15 @@ -- the license-file: field or the contents of the license: -- field. license ~?= (Just (Cabal.license pkgDesc)) +#if MIN_VERSION_Cabal(1,19,0) + licenseFileText <- liftIO $ case Cabal.licenseFiles pkgDesc of + [] -> return Nothing + (path : _) -> readFileMaybe (unTop top path) -- better than nothing +#else licenseFileText <- liftIO $ case Cabal.licenseFile pkgDesc of "" -> return Nothing path -> readFileMaybe (unTop top path) +#endif licenseFile ~?= licenseFileText copyright ~?= (case Cabal.copyright pkgDesc of "" -> Nothing @@ -314,32 +327,9 @@ ExitSuccess -> return () ExitFailure n -> die ("autoreconf failed with status " ++ show n) --- | Use apt-cache to find the version number of the newest in a build environment. -ghcVersion :: MonadIO m => FilePath -> m (Maybe DebianVersion) -ghcVersion root = do - exists <- liftIO $ doesDirectoryExist root - when (not exists) (error $ "ghcVersion: no such environment: " ++ show root) - versions <- liftIO $ chroot root $ readProcess "apt-cache" ["showpkg", "ghc"] "" >>= - return . dropWhile (/= "Versions: ") . Prelude.lines - case versions of - (_ : versionLine : _) -> return . Just . parseDebianVersion . takeWhile (/= ' ') $ versionLine - _ -> return Nothing - -chroot :: NFData a => FilePath -> IO a -> IO a -chroot "/" task = task -chroot root task = useEnv root (return . force) task - --- | Return a Data.Version.Version with the major and minor digits of the compiler version. -ghcVersion' :: MonadIO m => FilePath -> m (Maybe CompilerId) -ghcVersion' root = do - ghcVersion root >>= return . maybe Nothing (Just . cabVersion) - where - cabVersion :: DebianVersion -> CompilerId - cabVersion debVersion = - let (Version ds ts) = greatestLowerBound debVersion (map (\ d -> Version [d] []) [0..]) in - CompilerId GHC (greatestLowerBound debVersion (map (\ d -> Version (ds ++ [d]) ts) [0..])) - greatestLowerBound :: DebianVersion -> [Version] -> Version - greatestLowerBound b xs = last $ takeWhile (\ v -> parseDebianVersion (showVersion v) < b) xs +-- chroot :: NFData a => FilePath -> IO a -> IO a +-- chroot "/" task = task +-- chroot root task = useEnv root (return . force) task -- | Try to compute a string for the the debian "Maintainer:" field using, in this order -- 1. the maintainer explicitly specified using "Debian.Debianize.Monad.maintainer" diff --git a/src/Debian/Debianize/Options.hs b/src/Debian/Debianize/Options.hs --- a/src/Debian/Debianize/Options.hs +++ b/src/Debian/Debianize/Options.hs @@ -7,24 +7,26 @@ , withEnvironmentArgs ) where -import Control.Monad.State (lift) -import Data.Char (toLower, isDigit, ord) +import Control.Monad.State (get, put) +import Control.Monad.Trans (MonadIO, liftIO) +import Data.Char (toLower, toUpper, isDigit, ord) import Data.Lens.Lazy (Lens) import Data.Set (singleton) import Debian.Debianize.Goodies (doExecutable) -import Debian.Debianize.Types - (verbosity, dryRun, debAction, noDocumentationLibrary, noProfilingLibrary, - missingDependencies, sourcePackageName, cabalFlagAssignments, maintainer, buildDir, buildEnv, omitLTDeps, - sourceFormat, buildDepends, buildDependsIndep, extraDevDeps, depends, conflicts, replaces, provides, - extraLibMap, debVersion, revision, epochMap, execMap) import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude (read', maybeRead, (+=), (~=), (%=), (++=), (+++=)) -import Debian.Debianize.Types.Atoms (Atoms, InstallFile(..), DebAction(..)) +import Debian.Debianize.Types + (verbosity, dryRun, debAction, noDocumentationLibrary, noProfilingLibrary, noHoogle, + missingDependencies, sourcePackageName, cabalFlagAssignments, maintainer, buildDir, omitLTDeps, + sourceFormat, buildDepends, buildDependsIndep, extraDevDeps, depends, conflicts, replaces, provides, + recommends, suggests, extraLibMap, debVersion, revision, epochMap, execMap, utilsPackageNames) +import Debian.Debianize.Types.Atoms (Atoms, EnvSet(..), InstallFile(..), DebAction(..), setBuildEnv, compilerFlavor) import Debian.Orphans () import Debian.Policy (SourceFormat(Quilt3), parseMaintainer) import Debian.Relation (BinPkgName(..), SrcPkgName(..), Relations, Relation(..)) import Debian.Relation.String (parseRelations) import Debian.Version (parseDebianVersion) +import Distribution.Compiler (CompilerFlavor) import Distribution.PackageDescription (FlagName(..)) import Distribution.Package (PackageName(..)) import Prelude hiding (readFile, lines, null, log, sum) @@ -33,9 +35,10 @@ import System.FilePath ((), splitFileName) import System.IO.Error (tryIOError) import System.Posix.Env (setEnv) +import Text.Read (readMaybe) import Text.Regex.TDFA ((=~)) -compileArgs :: [String] -> DebT IO () +compileArgs :: MonadIO m => [String] -> DebT m () compileArgs args = case getOpt' RequireOrder options args of (os, [], [], []) -> sequence_ os @@ -43,17 +46,17 @@ ", Unrecognized: " ++ show unk ++ ", Non-Options: " ++ show non) -compileEnvironmentArgs :: DebT IO () +compileEnvironmentArgs :: MonadIO m => DebT m () compileEnvironmentArgs = withEnvironmentArgs compileArgs -compileCommandlineArgs :: DebT IO () -compileCommandlineArgs = lift getArgs >>= compileArgs +compileCommandlineArgs :: MonadIO m => DebT m () +compileCommandlineArgs = liftIO getArgs >>= compileArgs -- | Read a value out of the CABALDEBIAN environment variable which is -- the result of applying show to a [String]. -withEnvironmentArgs :: ([String] -> DebT IO a) -> DebT IO a +withEnvironmentArgs :: MonadIO m => ([String] -> DebT m a) -> DebT m a withEnvironmentArgs f = - lift (tryIOError (getEnv "CABALDEBIAN")) >>= either (\ _ -> f []) (maybe (f []) f . maybeRead) + liftIO (tryIOError (getEnv "CABALDEBIAN")) >>= either (\ _ -> f []) (maybe (f []) f . maybeRead) -- | Insert a value for CABALDEBIAN into the environment that the -- withEnvironment* functions above will find and use. E.g. @@ -62,7 +65,7 @@ putEnvironmentArgs fs = setEnv "CABALDEBIAN" (show fs) True -- | Options that modify other atoms. -options :: [OptDescr (DebT IO ())] +options :: MonadIO m => [OptDescr (DebT m ())] options = [ Option "v" ["verbose"] (ReqArg (\ s -> verbosity ~= (read' (\ s' -> error $ "verbose: " ++ show s') s)) "n") "Change the amount of progress messages generated", @@ -73,7 +76,10 @@ Option "" ["executable"] (ReqArg (\ path -> executableOption path (\ bin e -> doExecutable bin e)) "SOURCEPATH or SOURCEPATH:DESTDIR") (unlines [ "Create an individual binary package to hold this executable. Other executables " , " and data files are gathered into a single utils package named 'haskell-packagename-utils'."]), - Option "" ["disable-haddock"] (NoArg (noDocumentationLibrary ~= singleton True)) + Option "" ["default-package"] (ReqArg (\ name -> utilsPackageNames ~= singleton (BinPkgName name)) "DEB") + (unlines [ "Set the name of the catch-all package that receives all the files not included in a library package or " + , " some other executable package. By default this is 'haskell-packagename-utils'."]), + Option "" ["disable-haddock"] (NoArg (noDocumentationLibrary ~= True)) (unlines [ "Don't generate API documentation packages, usually named" , "libghc-packagename-doc. Use this if your build is crashing due to a" , "haddock bug."]), @@ -87,9 +93,13 @@ (unlines [ "Use this name for the debian source package, the name in the Source field at the top of the" , "debian control file, and also at the very beginning of the debian/changelog file. By default" , "this is haskell-, where the cabal package name is downcased."]), - Option "" ["disable-library-profiling"] (NoArg (noProfilingLibrary ~= singleton True)) + Option "" ["disable-library-profiling"] (NoArg (noProfilingLibrary ~= True)) (unlines [ "Don't generate profiling (-prof) library packages. This has been used in one case" , "where the package code triggered a compiler bug."]), + Option "" ["no-hoogle"] (NoArg (noHoogle ~= True)) + (unlines [ "Do not create the link from /usr/lib/ghc-doc/hoogle/Package.txt to the top" + , "of the package's html documentation tree. This path does not contain" + , "the package version, so it may conflict with libraries built into ghc."]), Option "" ["maintainer"] (ReqArg (\ maint -> either (error ("Invalid maintainer string: " ++ show maint)) ((maintainer ~=) . Just) (parseMaintainer maint)) "Maintainer Name ") (unlines [ "Override the Maintainer name and email given in $DEBEMAIL or $EMAIL or $DEBFULLNAME or $FULLNAME"]), Option "" ["build-dep"] @@ -125,6 +135,12 @@ Option "" ["provides"] (ReqArg (addDep provides) "deb:deb,deb:deb,...") "Like --depends, modifies the Provides field.", + Option "" ["recommends"] + (ReqArg (addDep recommends) "deb:deb,deb:deb,...") + "Like --depends, modifies the Recommends field.", + Option "" ["suggests"] + (ReqArg (addDep suggests) "deb:deb,deb:deb,...") + "Like --depends, modifies the Suggests field.", Option "" ["map-dep"] (ReqArg (\ pair -> case break (== '=') pair of (cab, (_ : deb)) -> extraLibMap +++= (cab, rels deb) (_, "") -> error "usage: --map-dep CABALNAME=RELATIONS") "CABALNAME=RELATIONS") @@ -146,7 +162,7 @@ (cab, (_ : deb)) -> execMap ++= (cab, rels deb) _ -> error "usage: --exec-map EXECNAME=RELATIONS") "EXECNAME=RELATIONS") "Specify a mapping from the name appearing in the Build-Tool field of the cabal file to a debian binary package name, e.g. --exec-map trhsx=haskell-hsx-utils", - Option "" ["omit-lt-deps"] (NoArg (omitLTDeps ~= singleton True)) + Option "" ["omit-lt-deps"] (NoArg (omitLTDeps ~= True)) (unlines [ "Remove all less-than dependencies from the generated control file. Less-than" , "dependencies are less useful and more troublesome for debian packages than cabal," , "because you can't install multiple versions of a given debian package. For more" @@ -158,11 +174,17 @@ , "run by haskell-devscripts. The build subdirectory is added to match the" , "behavior of the --builddir option in the Setup script."]), - Option "" ["buildenv"] (ReqArg (\ s -> buildEnv ~= s) "PATH") + let f :: MonadIO m => String -> DebT m () + f s = get >>= setBuildEnv (EnvSet {cleanOS = s "clean", dependOS = s "depend", buildOS = s "build"}) >>= put in + Option "" ["buildenvdir"] (ReqArg f "PATH") (unlines [ "Directory containing the build environment for which the debianization will" , "be generated. This determines which compiler will be available, which in turn" , "determines which basic libraries can be provided by the compiler. This can be" , "set to /, but it must be set."]), + Option "" ["hc", "compiler-flavor"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s) + (\ hc -> compilerFlavor ~= hc) + (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER") + (unlines [ "Specify which Haskell compiler: ghc, ghcjs, hugs, etc." ]), Option "f" ["flags"] (ReqArg (\ fs -> mapM_ (cabalFlagAssignments +=) (flagList fs)) "FLAGS") (unlines [ "Flags to pass to the finalizePackageDescription function in" , "Distribution.PackageDescription.Configuration when loading the cabal file."]), diff --git a/src/Debian/Debianize/Output.hs b/src/Debian/Debianize/Output.hs --- a/src/Debian/Debianize/Output.hs +++ b/src/Debian/Debianize/Output.hs @@ -16,8 +16,8 @@ import Control.Category ((.)) import Control.Exception as E (throw) -import Control.Monad.State (get, lift) -import Control.Monad.Trans (MonadIO) +import Control.Monad.State (get) +import Control.Monad.Trans (MonadIO, liftIO) import Data.Algorithm.Diff.Context (contextDiff) import Data.Algorithm.Diff.Pretty (prettyDiff) import Data.Lens.Lazy (getL) @@ -26,6 +26,7 @@ import Data.Text as Text (split, Text, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Debianize.Types (Top(unTop)) +import Debian.Debianize.Types.Atoms (EnvSet) import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.Input (inputDebianization) import Debian.Debianize.Monad (DebT, Atoms, evalDebT) @@ -37,9 +38,10 @@ import Debian.Pretty (Pretty(pretty)) import Prelude hiding (unlines, writeFile, (.)) import System.Directory (createDirectoryIfMissing, doesFileExist, getPermissions, Permissions(executable), setPermissions) -import System.Environment (getEnv) +--import System.Environment (getEnv) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeDirectory) +import System.IO (hPutStrLn, stderr) import System.Process (readProcessWithExitCode, showCommandForUser) -- | Run the script in @debian/Debianize.hs@ with the given command @@ -52,42 +54,43 @@ -- in the debian subdirectory of this library. runDebianizeScript :: [String] -> IO Bool runDebianizeScript args = - getEnv "HOME" >>= \ home -> + -- getEnv "HOME" >>= \ home -> doesFileExist "debian/Debianize.hs" >>= \ exists -> case exists of False -> return False - True -> - let autobuilderd = "-i.:" ++ home ".autobuilder.d" - args' = [autobuilderd, "debian/Debianize.hs"] ++ args in - putEnvironmentArgs args >> readProcessWithExitCode "runhaskell" args' "" >>= \ result -> - case result of - (ExitSuccess, _, _) -> return True - (code, out, err) -> - error ("runDebianizeScript: " ++ showCommandForUser "runhaskell" args' ++ " -> " ++ show code ++ "\n stdout: " ++ show out ++"\n stderr: " ++ show err) + True -> do + let args' = ["debian/Debianize.hs"] ++ args + putEnvironmentArgs args + hPutStrLn stderr (showCommandForUser "runhaskell" args') + result <- readProcessWithExitCode "runhaskell" args' "" + case result of + (ExitSuccess, _, _) -> return True + (code, out, err) -> error ("runDebianizeScript: " ++ showCommandForUser "runhaskell" args' ++ " -> " ++ show code ++ + "\n stdout: " ++ show out ++"\n stderr: " ++ show err) -- | Depending on the options in @atoms@, either validate, describe, -- or write the generated debianization. -doDebianizeAction :: Top -> DebT IO () -doDebianizeAction top = +doDebianizeAction :: (MonadIO m, Functor m) => Top -> EnvSet -> DebT m () +doDebianizeAction top envset = do new <- get case () of _ | getL T.validate new -> - do inputDebianization top + do inputDebianization top envset old <- get return $ validateDebianization old new _ | getL T.dryRun new -> - do inputDebianization top + do inputDebianization top envset old <- get - diff <- lift $ compareDebianization old new - lift $ putStr ("Debianization (dry run):\n" ++ diff) + diff <- liftIO $ compareDebianization old new + liftIO $ putStr ("Debianization (dry run):\n" ++ diff) _ -> writeDebianization top -- | Write the files of the debianization @d@ to the directory @top@. -writeDebianization :: Top -> DebT IO () +writeDebianization :: (MonadIO m, Functor m) => Top -> DebT m () writeDebianization top = do files <- debianizationFileMap - lift $ withCurrentDirectory (unTop top) $ mapM_ (uncurry doFile) (Map.toList files) - lift $ getPermissions (unTop top "debian/rules") >>= setPermissions (unTop top "debian/rules") . (\ p -> p {executable = True}) + liftIO $ withCurrentDirectory (unTop top) $ mapM_ (uncurry doFile) (Map.toList files) + liftIO $ getPermissions (unTop top "debian/rules") >>= setPermissions (unTop top "debian/rules") . (\ p -> p {executable = True}) where doFile path text = do createDirectoryIfMissing True (takeDirectory path) diff --git a/src/Debian/Debianize/SubstVars.hs b/src/Debian/Debianize/SubstVars.hs --- a/src/Debian/Debianize/SubstVars.hs +++ b/src/Debian/Debianize/SubstVars.hs @@ -12,7 +12,7 @@ import Control.Monad (foldM) import Control.Monad.Reader (ReaderT(runReaderT)) import Control.Monad.State (get) -import Control.Monad.Trans (MonadIO, lift) +import Control.Monad.Trans (MonadIO, liftIO, lift) import Data.Lens.Lazy (getL, modL, access) import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition, unlines) import Data.List as List (map) @@ -59,17 +59,18 @@ -- 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 :: Top +substvars :: (MonadIO m, Functor m) => + Top -> T.DebType -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc - -> DebT IO () + -> DebT m () substvars top debType = do inputCabalization top - debVersions <- lift buildDebVersionMap - modifyM (lift . libPaths debVersions) - control <- lift $ readFile "debian/control" >>= either (error . show) return . parseControl "debian/control" + debVersions <- liftIO buildDebVersionMap + modifyM (liftIO . libPaths debVersions) + control <- liftIO $ readFile "debian/control" >>= either (error . show) return . parseControl "debian/control" substvars' debType control -substvars' :: T.DebType -> Control' String -> DebT IO () +substvars' :: (MonadIO m, Functor m) => T.DebType -> Control' String -> DebT m () substvars' debType control = get >>= return . getL T.packageInfo >>= \ info -> cabalDependencies >>= \ cabalDeps -> @@ -83,18 +84,18 @@ -- haskell-cabal-debian-doc.substvars: -- haskell:Depends=ghc-doc, haddock (>= 2.1.0), haddock (<< 2.1.0-999) ([], Just path') -> - do old <- lift $ readFile path' + do old <- liftIO $ readFile path' deps <- debDeps debType control new <- addDeps old deps dry <- get >>= return . getL T.dryRun - lift (diffFile path' (pack new) >>= maybe (putStrLn ("cabal-debian substvars: No updates found for " ++ show path')) + liftIO (diffFile path' (pack new) >>= maybe (putStrLn ("cabal-debian substvars: No updates found for " ++ show path')) (\ diff -> if dry then putStr diff else replaceFile path' new)) ([], Nothing) -> return () (missing, _) -> - lift $ 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 . pretty . 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.") + liftIO $ 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 . pretty . 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 deps = case partition (isPrefixOf "haskell:Depends=") (lines old) of diff --git a/src/Debian/Debianize/Tests.hs b/src/Debian/Debianize/Tests.hs deleted file mode 100644 --- a/src/Debian/Debianize/Tests.hs +++ /dev/null @@ -1,689 +0,0 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} -module Main - ( tests - , main - ) where - --- import Control.Monad.State (get, put) -import Data.Algorithm.Diff.Context (contextDiff) -import Data.Algorithm.Diff.Pretty (prettyDiff) -import Data.Function (on) -import Data.Lens.Lazy (access, getL) -import Data.List (sortBy) -import Data.Map as Map (differenceWithKey, intersectionWithKey) -import qualified Data.Map as Map (elems, Map, toList) -import Data.Maybe (fromMaybe) -import Data.Monoid ((<>), mconcat, mempty) -import Data.Set as Set (fromList, singleton, union) -import Data.Text as Text (intercalate, lines, split, Text, unlines) -import Data.Version (Version(Version)) -import Debian.Changes (ChangeLog(..), ChangeLogEntry(..), parseEntry) -import Debian.Debianize.DebianName (mapCabal, splitCabal) -import Debian.Debianize.Files (debianizationFileMap) -import Debian.Debianize.Finalize (debianization, finalizeDebianization') -import Debian.Debianize.Goodies (doBackups, doExecutable, doServer, doWebsite, makeRulesHead, tightDependencyFixup) -import Debian.Debianize.Input (inputChangeLog, inputDebianization) -import Debian.Debianize.Monad (DebT, evalDebT, execDebM, execDebT) -import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), (~=)) -import Debian.Debianize.Types as T -import Debian.Debianize.Types.Atoms as T -import qualified Debian.Debianize.Types.BinaryDebDescription as B -import qualified Debian.Debianize.Types.SourceDebDescription as S -import Debian.Policy (databaseDirectory, PackageArchitectures(All), PackagePriority(Extra), parseMaintainer, Section(MainSection), SourceFormat(Native3), StandardsVersion(..), getDebhelperCompatLevel, getDebianStandardsVersion) -import Debian.Pretty (pretty, text, Doc) -import Debian.Relation (BinPkgName(..), Relation(..), SrcPkgName(..), VersionReq(..)) -import Debian.Release (ReleaseName(ReleaseName, relName)) -import Debian.Version (parseDebianVersion, buildDebianVersion) -import Distribution.Simple.Compiler (CompilerId(CompilerId), CompilerFlavor(GHC)) -import Distribution.License (License(..)) -import Distribution.Package (PackageName(PackageName)) -import Prelude hiding (log) -import System.Exit (ExitCode(ExitSuccess)) -import System.FilePath (()) -import System.Process (readProcessWithExitCode) -import Test.HUnit hiding ((~?=)) -import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) - --- | A suitable defaultAtoms value for the debian repository. -defaultAtoms :: Monad m => DebT m () -defaultAtoms = - do T.epochMap ++= (PackageName "HaXml", 1) - T.epochMap ++= (PackageName "HTTP", 1) - mapCabal (PackageName "parsec") "parsec3" - splitCabal (PackageName "parsec") "parsec2" (Version [3] []) - mapCabal (PackageName "QuickCheck") "quickcheck2" - splitCabal (PackageName "QuickCheck") "quickcheck1" (Version [2] []) - mapCabal (PackageName "gtk2hs-buildtools") "gtk2hs-buildtools" - --- | Create a Debianization based on a changelog entry and a license --- value. Uses the currently installed versions of debhelper and --- debian-policy to set the compatibility levels. -newDebianization :: Monad m => ChangeLog -> Maybe Int -> Maybe StandardsVersion -> DebT m () -newDebianization (ChangeLog (WhiteSpace {} : _)) _ _ = error "defaultDebianization: Invalid changelog entry" -newDebianization (log@(ChangeLog (entry : _))) level standards = - do T.changelog ~= Just log - T.compat ~= level - T.source ~= Just (SrcPkgName (logPackage entry)) - T.maintainer ~= either error Just (parseMaintainer (logWho entry)) - T.standardsVersion ~= standards -newDebianization _ _ _ = error "Invalid changelog" - -newDebianization' :: Monad m => Maybe Int -> Maybe StandardsVersion -> DebT m () -newDebianization' level standards = - do T.compat ~= level - T.standardsVersion ~= standards - -tests :: Test -tests = TestLabel "Debianization Tests" (TestList [-- 1 and 2 do not input a cabal package - we're not ready to - -- debianize without a cabal package. - {- test1 "test1", - test2 "test2", -} - test3 "test3", - test4 "test4 - test-data/clckwrks-dot-com", - test5 "test5 - test-data/creativeprompts", - test6 "test6 - test-data/artvaluereport2", - test7 "test7 - debian/Debianize.hs", - test8 "test8 - test-data/artvaluereport-data", - test9 "test9 - test-data/alex", - test10 "test10 - test-data/archive"]) - -test1 :: String -> Test -test1 label = - TestLabel label $ - TestCase (do level <- getDebhelperCompatLevel - standards <- getDebianStandardsVersion :: IO (Maybe StandardsVersion) - deb <- execDebT - (do -- let top = Top "." - defaultAtoms - newDebianization (ChangeLog [testEntry]) level standards - license ~= Just BSD3 - -- inputCabalization top - finalizeDebianization') - newAtoms - diff <- diffDebianizations testDeb1 deb - assertEqual label [] diff) - where - testDeb1 :: Atoms - testDeb1 = - execDebM - (do defaultAtoms - newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) - rulesHead %= (const (Just (Text.unlines $ - [ "#!/usr/bin/make -f" - , "" - , "include /usr/share/cdbs/1/rules/debhelper.mk" - , "include /usr/share/cdbs/1/class/hlibrary.mk" ]))) - compat ~= Just 9 -- This will change as new version of debhelper are released - license ~= Just BSD3 - T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) - T.maintainer ~= Just (NameAddr (Just "David Fox") "dsf@seereason.com") - T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1)) -- This will change as new versions of debian-policy are released - T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing], - [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing], - [Rel (BinPkgName "cdbs") Nothing Nothing], - [Rel (BinPkgName "ghc") Nothing Nothing], - [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) - T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) - newAtoms - log = ChangeLog [Entry { logPackage = "haskell-cabal-debian" - , logVersion = buildDebianVersion Nothing "2.6.2" Nothing - , logDists = [ReleaseName {relName = "unstable"}] - , logUrgency = "low" - , logComments = " * Fix a bug constructing the destination pathnames that was dropping\n files that were supposed to be installed into packages.\n" - , logWho = "David Fox " - , logDate = "Thu, 20 Dec 2012 06:49:25 -0800" }] - -test2 :: String -> Test -test2 label = - TestLabel label $ - TestCase (do level <- getDebhelperCompatLevel - standards <- getDebianStandardsVersion - deb <- execDebT - (do -- let top = Top "." - defaultAtoms - newDebianization (ChangeLog [testEntry]) level standards - license ~= Just BSD3 - -- inputCabalization top - finalizeDebianization') - newAtoms - diff <- diffDebianizations expect deb - assertEqual label [] diff) - where - expect = - execDebM - (do defaultAtoms - newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1))) - rulesHead %= (const (Just (Text.unlines $ - ["#!/usr/bin/make -f", - "", - "include /usr/share/cdbs/1/rules/debhelper.mk", - "include /usr/share/cdbs/1/class/hlibrary.mk"]))) - compat ~= Just 9 - license ~= Just BSD3 - T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"}) - T.maintainer ~= Just (NameAddr {nameAddr_name = Just "David Fox", nameAddr_addr = "dsf@seereason.com"}) - T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1)) - T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing], - [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing], - [Rel (BinPkgName "cdbs") Nothing Nothing], - [Rel (BinPkgName "ghc") Nothing Nothing], - [Rel (BinPkgName "ghc-prof") Nothing Nothing]]) - T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]])) - newAtoms - log = ChangeLog [Entry {logPackage = "haskell-cabal-debian", - logVersion = Debian.Version.parseDebianVersion ("2.6.2" :: String), - logDists = [ReleaseName {relName = "unstable"}], - logUrgency = "low", - logComments = Prelude.unlines [" * Fix a bug constructing the destination pathnames that was dropping", - " files that were supposed to be installed into packages."], - logWho = "David Fox ", - logDate = "Thu, 20 Dec 2012 06:49:25 -0800"}] - -testEntry :: ChangeLogEntry -testEntry = - either (error "Error in test changelog entry") fst - (parseEntry (Prelude.unlines - [ "haskell-cabal-debian (2.6.2) unstable; urgency=low" - , "" - , " * Fix a bug constructing the destination pathnames that was dropping" - , " files that were supposed to be installed into packages." - , "" - , " -- David Fox Thu, 20 Dec 2012 06:49:25 -0800" ])) - -test3 :: String -> Test -test3 label = - TestLabel label $ - TestCase (do let top = Top "test-data/haskell-devscripts" - deb <- execDebT (inputDebianization top) T.newAtoms - diff <- diffDebianizations testDeb2 deb - assertEqual label [] diff) - where - testDeb2 :: Atoms - testDeb2 = - execDebM - (do defaultAtoms - newDebianization log (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) - T.sourceFormat ~= Just Native3 - T.rulesHead ~= Just (Text.unlines ["#!/usr/bin/make -f", - "# -*- makefile -*-", - "", - "# Uncomment this to turn on verbose mode.", - "#export DH_VERBOSE=1", - "", - "DEB_VERSION := $(shell dpkg-parsechangelog | egrep '^Version:' | cut -f 2 -d ' ')", - "", - "manpages = $(shell cat debian/manpages)", - "", - "%.1: %.pod", - "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", - "", - "%.1: %", - "\tpod2man -c 'Haskell devscripts documentation' -r 'Haskell devscripts $(DEB_VERSION)' $< > $@", - "", - ".PHONY: build", - "build: $(manpages)", - "", - "install-stamp:", - "\tdh install", - "", - ".PHONY: install", - "install: install-stamp", - "", - "binary-indep-stamp: install-stamp", - "\tdh binary-indep", - "\ttouch $@", - "", - ".PHONY: binary-indep", - "binary-indep: binary-indep-stamp", - "", - ".PHONY: binary-arch", - "binary-arch: install-stamp", - "", - ".PHONY: binary", - "binary: binary-indep-stamp", - "", - ".PHONY: clean", - "clean:", - "\tdh clean", - "\trm -f $(manpages)", - "", - ""]) - T.compat ~= Just 7 - T.copyright ~= Just "This package was debianized by John Goerzen on\nWed, 6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n\n" - T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"}) - T.maintainer ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) - T.uploaders ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] - T.sourcePriority ~= Just Extra - T.sourceSection ~= Just (MainSection "haskell") - T.buildDepends %= (++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]]) - T.buildDependsIndep %= (++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]]) - T.standardsVersion ~= Just (StandardsVersion 3 9 4 Nothing) - T.vcsFields %= Set.union (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts" - , S.VCSDarcs "http://darcs.debian.org/pkg-haskell/haskell-devscripts"]) - T.binaryArchitectures (BinPkgName "haskell-devscripts") ~= Just All - T.debianDescription (BinPkgName "haskell-devscripts") ~= - Just - (intercalate "\n" ["Tools to help Debian developers build Haskell packages", - " This package provides a collection of scripts to help build Haskell", - " packages for Debian. Unlike haskell-utils, this package is not", - " expected to be installed on the machines of end users.", - " .", - " This package is designed to support Cabalized Haskell libraries. It", - " is designed to build a library for each supported Debian compiler or", - " interpreter, generate appropriate postinst/prerm files for each one,", - " generate appropriate substvars entries for each one, and install the", - " package in the Debian temporary area as part of the build process."]) - T.depends (BinPkgName "haskell-devscripts") ~= - [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] - , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] - , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] -{- - control %= (\ y -> y { S.source = - , S.maintainer = Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) - , S.uploaders = [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] - , S.priority = Just Extra - , S.section = Just (MainSection "haskell") - , S.buildDepends = (S.buildDepends y) ++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]] - , S.buildDependsIndep = (S.buildDependsIndep y) ++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]] - , S.standardsVersion = Just (StandardsVersion 3 9 4 Nothing) - , S.vcsFields = Set.union (S.vcsFields y) (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts" - , S.VCSDarcs "http://darcs.debian.org/pkg-haskell/haskell-devscripts"]) - , S.binaryPackages = [S.BinaryDebDescription { B.package = BinPkgName {unBinPkgName = "haskell-devscripts"} - , B.architecture = All - , B.binarySection = Nothing - , B.binaryPriority = Nothing - , B.essential = False - , B.description = Just $ - (T.intercalate "\n" - ["Tools to help Debian developers build Haskell packages", - " This package provides a collection of scripts to help build Haskell", - " packages for Debian. Unlike haskell-utils, this package is not", - " expected to be installed on the machines of end users.", - " .", - " This package is designed to support Cabalized Haskell libraries. It", - " is designed to build a library for each supported Debian compiler or", - " interpreter, generate appropriate postinst/prerm files for each one,", - " generate appropriate substvars entries for each one, and install the", - " package in the Debian temporary area as part of the build process."]) - , B.relations = - B.PackageRelations - { B.depends = - [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "ghc"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.6" :: String)))) Nothing] - , [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "${misc:Depends}"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "html-xml-utils"}) Nothing Nothing] - , [Rel (BinPkgName {unBinPkgName = "hscolour"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.8" :: String)))) Nothing] - , [Rel (BinPkgName {unBinPkgName = "ghc-haddock"}) (Just (GRE (Debian.Version.parseDebianVersion ("7.4" :: String)))) Nothing] ] - , B.recommends = [] - , B.suggests = [] - , B.preDepends = [] - , B.breaks = [] - , B.conflicts = [] - , B.provides_ = [] - , B.replaces_ = [] - , B.builtUsing = [] }}]}) --} - ) - T.newAtoms - log = ChangeLog [Entry { logPackage = "haskell-devscripts" - , logVersion = Debian.Version.parseDebianVersion ("0.8.13" :: String) - , logDists = [ReleaseName {relName = "experimental"}] - , logUrgency = "low" - , logComments = " [ Joachim Breitner ]\n * Improve parsing of \"Setup register\" output, patch by David Fox\n * Enable creation of hoogle files, thanks to Kiwamu Okabe for the\n suggestion. \n\n [ Kiwamu Okabe ]\n * Need --html option to fix bug that --hoogle option don't output html file.\n * Support to create /usr/lib/ghc-doc/hoogle/*.txt for hoogle package.\n\n [ Joachim Breitner ]\n * Symlink hoogle\8217s txt files to /usr/lib/ghc-doc/hoogle/\n * Bump ghc dependency to 7.6 \n * Bump standards version\n" - , logWho = "Joachim Breitner " - , logDate = "Mon, 08 Oct 2012 21:14:50 +0200" }, - Entry { logPackage = "haskell-devscripts" - , logVersion = Debian.Version.parseDebianVersion ("0.8.12" :: String) - , logDists = [ReleaseName {relName = "unstable"}] - , logUrgency = "low" - , logComments = " * Depend on ghc >= 7.4, adjusting to its haddock --interface-version\n behaviour.\n" - , logWho = "Joachim Breitner " - , logDate = "Sat, 04 Feb 2012 10:50:33 +0100"}] - -test4 :: String -> Test -test4 label = - TestLabel label $ - TestCase (do let inTop = Top "test-data/clckwrks-dot-com/input" - outTop = Top "test-data/clckwrks-dot-com/output" - old <- execDebT (inputDebianization outTop) T.newAtoms - let log = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms (customize log)) T.newAtoms - diff <- diffDebianizations old ({-copyFirstLogEntry old-} new) - assertEqual label [] diff) - where - customize :: Maybe ChangeLog -> DebT IO () - customize log = - do T.changelog ~= log - tight - fixRules - doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups" - doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production")) - T.revision ~= Nothing - T.missingDependencies += (BinPkgName "libghc-clckwrks-theme-clckwrks-doc") - T.sourceFormat ~= Just Native3 - T.homepage ~= Just "http://www.clckwrks.com/" - newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) -{- - customize log = modifyM (lift . customize' log) - customize' :: Maybe ChangeLog -> Atoms -> IO Atoms - customize' log atoms = - execDebT (newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing))) . - modL T.control (\ y -> y {T.homepage = Just "http://www.clckwrks.com/"}) . - setL T.sourceFormat (Just Native3) . - modL T.missingDependencies (insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")) . - setL T.revision Nothing . - execDebM (doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production"))) . - execDebM (doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups") . - fixRules . - execDebM tight . - setL T.changelog log --} - -- A log entry gets added when the Debianization is generated, - -- it won't match so drop it for the comparison. - serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"] - -- Insert a line just above the debhelper.mk include - fixRules = - makeRulesHead >>= \ rh -> T.rulesHead %= (\ mt -> (Just . f) (fromMaybe rh mt)) - where - f t = Text.unlines $ concat $ - map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" - then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] :: [Text] - else [line] :: [Text]) (Text.lines t) -{- - mapAtoms f deb - where - f :: DebAtomKey -> DebAtom -> Set (DebAtomKey, DebAtom) - f Source (DebRulesHead t) = - singleton (Source, DebRulesHead (T.unlines $ concat $ - map (\ line -> if line == "include /usr/share/cdbs/1/rules/debhelper.mk" - then ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups", "", line] :: [T.Text] - else [line] :: [T.Text]) (T.lines t))) - f k a = singleton (k, a) --} - tight = mapM_ (tightDependencyFixup [(BinPkgName "libghc-clckwrks-theme-clckwrks-dev", BinPkgName "haskell-clckwrks-theme-clckwrks-utils"), - (BinPkgName "libghc-clckwrks-plugin-media-dev", BinPkgName "haskell-clckwrks-plugin-media-utils"), - (BinPkgName "libghc-clckwrks-plugin-bugs-dev", BinPkgName "haskell-clckwrks-plugin-bugs-utils"), - (BinPkgName "libghc-clckwrks-dev", BinPkgName "haskell-clckwrks-utils")]) serverNames - - theSite :: BinPkgName -> T.Site - theSite deb = - Site { domain = hostname' - , serverAdmin = "logic@seereason.com" - , server = theServer deb } - theServer :: BinPkgName -> Server - theServer deb = - Server { hostname = - case deb of - BinPkgName "clckwrks-dot-com-production" -> hostname' - _ -> hostname' - , port = portNum deb - , headerMessage = "Generated by clckwrks-dot-com/Setup.hs" - , retry = "60" - , serverFlags = - [ "--http-port", show (portNum deb) - , "--hide-port" - , "--hostname", hostname' - , "--top", databaseDirectory deb - , "--enable-analytics" - , "--jquery-path", "/usr/share/javascript/jquery/" - , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" - , "--jstree-path", jstreePath - , "--json2-path",json2Path - ] - , installFile = - InstallFile { execName = "clckwrks-dot-com-server" - , destName = show (pretty deb) - , sourceDir = Nothing - , destDir = Nothing } - } - hostname' = "clckwrks.com" - portNum :: BinPkgName -> Int - portNum (BinPkgName deb) = - case deb of - "clckwrks-dot-com-production" -> 9029 - "clckwrks-dot-com-staging" -> 9038 - "clckwrks-dot-com-development" -> 9039 - _ -> error $ "Unexpected package name: " ++ deb - jstreePath = "/usr/share/clckwrks-0.13.2/jstree" - json2Path = "/usr/share/clckwrks-0.13.2/json2" - -anyrel :: BinPkgName -> Relation -anyrel b = Rel b Nothing Nothing - -test5 :: String -> Test -test5 label = - TestLabel label $ - TestCase (do let inTop = (Top "test-data/creativeprompts/input") - outTop = (Top "test-data/creativeprompts/output") - old <- execDebT (inputDebianization outTop) newAtoms - let standards = getL T.standardsVersion old - level = getL T.compat old - new <- execDebT (debianization inTop defaultAtoms (customize old level standards)) newAtoms - diff <- diffDebianizations old new - assertEqual label [] diff) - where - customize old level standards = - do T.utilsPackageNames ~= singleton (BinPkgName "creativeprompts-data") - newDebianization' level standards - T.changelog ~= (getL T.changelog old) - doWebsite (BinPkgName "creativeprompts-production") (theSite (BinPkgName "creativeprompts-production")) - doServer (BinPkgName "creativeprompts-development") (theServer (BinPkgName "creativeprompts-development")) - doBackups (BinPkgName "creativeprompts-backups") "creativeprompts-backups" - T.execMap ++= ("trhsx", [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]]) - mapM_ (\ b -> T.depends b %= \ deps -> deps ++ [[anyrel (BinPkgName "markdown")]]) - [(BinPkgName "creativeprompts-production"), (BinPkgName "creativeprompts-development")] - T.debianDescription (BinPkgName "creativeprompts-development") ~= - Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server" - , " Testing version of the blog server, runs on port" - , " 8000 with HTML validation turned on." ]) - T.debianDescription (BinPkgName "creativeprompts-data") ~= - Just (intercalate "\n" [ "creativeprompts.com data files" - , " Static data files for creativeprompts.com"]) - T.debianDescription (BinPkgName "creativeprompts-production") ~= - Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server" - , " Production version of the blog server, runs on port" - , " 9021 with HTML validation turned off." ]) - T.debianDescription (BinPkgName "creativeprompts-backups") ~= - Just (intercalate "\n" [ "backup program for creativeprompts.com" - , " Install this somewhere other than creativeprompts.com to run automated" - , " backups of the database."]) - T.binaryArchitectures (BinPkgName "creativeprompts-production") ~= Just All - T.binaryArchitectures (BinPkgName "creativeprompts-data") ~= Just All - T.binaryArchitectures (BinPkgName "creativeprompts-development") ~= Just All - T.sourceFormat ~= Just Native3 - - theSite :: BinPkgName -> Site - theSite deb = - Site { domain = hostname' - , serverAdmin = "logic@seereason.com" - , server = theServer deb } - theServer :: BinPkgName -> Server - theServer deb = - Server { hostname = - case deb of - BinPkgName "clckwrks-dot-com-production" -> hostname' - _ -> hostname' - , port = portNum deb - , headerMessage = "Generated by creativeprompts-dot-com/debian/Debianize.hs" - , retry = "60" - , serverFlags = - [ "--http-port", show (portNum deb) - , "--hide-port" - , "--hostname", hostname' - , "--top", databaseDirectory deb - , "--enable-analytics" - , "--jquery-path", "/usr/share/javascript/jquery/" - , "--jqueryui-path", "/usr/share/javascript/jquery-ui/" - , "--jstree-path", jstreePath - , "--json2-path",json2Path - ] - , installFile = - InstallFile { execName = "creativeprompts-server" - , destName = show (pretty deb) - , sourceDir = Nothing - , destDir = Nothing } - } - hostname' = "creativeprompts.com" - portNum :: BinPkgName -> Int - portNum (BinPkgName deb) = - case deb of - "creativeprompts-production" -> 9022 - "creativeprompts-staging" -> 9033 - "creativeprompts-development" -> 9034 - _ -> error $ "Unexpected package name: " ++ deb - jstreePath = "/usr/share/clckwrks-0.13.2/jstree" - json2Path = "/usr/share/clckwrks-0.13.2/json2" - -test6 :: String -> Test -test6 label = - TestLabel label $ - TestCase (do result <- readProcessWithExitCode "runhaskell" ["-isrc", "test-data/artvaluereport2/input/debian/Debianize.hs"] "" - assertEqual label (ExitSuccess, "", "") result) - -test7 :: String -> Test -test7 label = - TestLabel label $ - TestCase (do new <- readProcessWithExitCode "runhaskell" ["-isrc", "debian/Debianize.hs"] "" - assertEqual label (ExitSuccess, "", "Ignored: ./debian/cabal-debian.1\nIgnored: ./debian/cabal-debian.manpages\n") new) - -test8 :: String -> Test -test8 label = - TestLabel label $ - TestCase ( do let inTop = Top "test-data/artvaluereport-data/input" - outTop = Top "test-data/artvaluereport-data/output" - old <- execDebT (inputDebianization outTop) newAtoms - log <- evalDebT (inputChangeLog inTop >> access T.changelog) newAtoms - new <- execDebT (debianization inTop defaultAtoms (customize log)) newAtoms - diff <- diffDebianizations old new - assertEqual label [] diff - ) - where - customize Nothing = error "Missing changelog" - customize (Just log) = - do T.buildDepends %= (++ [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]]) - T.homepage ~= Just "http://artvaluereportonline.com" - T.sourceFormat ~= Just Native3 - T.changelog ~= Just log - newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing)) - -test9 :: String -> Test -test9 label = - TestLabel label $ - TestCase (do let inTop = Top "test-data/alex/input" - outTop = Top "test-data/alex/output" - old <- execDebT (inputDebianization outTop) newAtoms - let Just (ChangeLog (entry : _)) = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) newAtoms - diff <- diffDebianizations old new - assertEqual label [] diff) - where - customize = - do newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing)) - mapM_ (\ name -> T.installData +++= (BinPkgName "alex", singleton (name, name))) - [ "AlexTemplate" - , "AlexTemplate-debug" - , "AlexTemplate-ghc" - , "AlexTemplate-ghc-debug" - , "AlexWrapper-basic" - , "AlexWrapper-basic-bytestring" - , "AlexWrapper-gscan" - , "AlexWrapper-monad" - , "AlexWrapper-monad-bytestring" - , "AlexWrapper-monadUserState" - , "AlexWrapper-monadUserState-bytestring" - , "AlexWrapper-posn" - , "AlexWrapper-posn-bytestring" - , "AlexWrapper-strict-bytestring"] - T.homepage ~= Just "http://www.haskell.org/alex/" - T.sourceFormat ~= Just Native3 - T.debVersion ~= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String)) - doExecutable (BinPkgName "alex") - (InstallFile {execName = "alex", destName = "alex", sourceDir = Nothing, destDir = Nothing}) - -- Bootstrap dependency - T.buildDepends %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]]) - -test10 :: String -> Test -test10 label = - TestLabel label $ - TestCase (do let inTop = Top "test-data/archive/input" - outTop = Top "test-data/archive/output" - old <- execDebT (inputDebianization outTop) newAtoms - let Just (ChangeLog (entry : _)) = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) newAtoms - diff <- diffDebianizations old new - assertEqual label [] diff) - where - customize :: DebT IO () - customize = - do T.sourcePackageName ~= Just (SrcPkgName "seereason-darcs-backups") - T.compat ~= Just 5 - T.standardsVersion ~= Just (StandardsVersion 3 8 1 Nothing) - T.maintainer ~= either (const Nothing) Just (parseMaintainer "David Fox ") - T.depends (BinPkgName "seereason-darcs-backups") %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]]) - T.sourceSection ~= Just (MainSection "haskell") - T.utilsPackageNames += utils - T.installCabalExec +++= (utils, singleton ("seereason-darcs-backups", "/etc/cron.hourly")) - utils = BinPkgName "seereason-darcs-backups" - -copyChangelogDate :: Monad m => String -> DebT m () -copyChangelogDate date = - T.changelog %= (\ (Just (ChangeLog (entry : older))) -> Just (ChangeLog (entry {logDate = date} : older))) - -data Change k a - = Created k a - | Deleted k a - | Modified k a a - | Unchanged k a - deriving (Eq, Show) - -diffMaps :: (Ord k, Eq a, Show k, Show a) => Map.Map k a -> Map.Map k a -> [Change k a] -diffMaps old new = - Map.elems (intersectionWithKey combine1 old new) ++ - map (uncurry Deleted) (Map.toList (differenceWithKey combine2 old new)) ++ - map (uncurry Created) (Map.toList (differenceWithKey combine2 new old)) - where - combine1 k a b = if a == b then Unchanged k a else Modified k a b - combine2 _ _ _ = Nothing - -diffDebianizations :: Atoms -> Atoms -> IO String -- [Change FilePath T.Text] -diffDebianizations old new = - do old' <- evalDebT (sortBinaryDebs >> debianizationFileMap) old - new' <- evalDebT (sortBinaryDebs >> debianizationFileMap) new - return $ show $ mconcat $ map prettyChange $ filter (not . isUnchanged) $ diffMaps old' new' - where - isUnchanged (Unchanged _ _) = True - isUnchanged _ = False - prettyChange :: Change FilePath Text -> Doc - prettyChange (Unchanged p _) = text "Unchanged: " <> pretty p <> text "\n" - prettyChange (Deleted p _) = text "Deleted: " <> pretty p <> text "\n" - prettyChange (Created p b) = - text "Created: " <> pretty p <> text "\n" <> - prettyDiff ("old" p) ("new" p) - -- We use split here instead of lines so we can - -- detect whether the file has a final newline - -- character. - (contextDiff 2 mempty (split (== '\n') b)) - prettyChange (Modified p a b) = - text "Modified: " <> pretty p <> text "\n" <> - prettyDiff ("old" p) ("new" p) - -- We use split here instead of lines so we can - -- detect whether the file has a final newline - -- character. - (contextDiff 2 (split (== '\n') a) (split (== '\n') b)) - -sortBinaryDebs :: DebT IO () -sortBinaryDebs = T.binaryPackages %= sortBy (compare `on` getL B.package) - -main :: IO () -main = runTestTT tests >>= putStrLn . show - diff --git a/src/Debian/Debianize/Types.hs b/src/Debian/Debianize/Types.hs --- a/src/Debian/Debianize/Types.hs +++ b/src/Debian/Debianize/Types.hs @@ -36,10 +36,10 @@ , rulesHead , rulesFragments , noProfilingLibrary + , noHoogle , noDocumentationLibrary , utilsPackageNames , buildDir - , buildEnv , watch -- * Source Package Build Dependencies diff --git a/src/Debian/Debianize/Types/Atoms.hs b/src/Debian/Debianize/Types/Atoms.hs --- a/src/Debian/Debianize/Types/Atoms.hs +++ b/src/Debian/Debianize/Types/Atoms.hs @@ -1,7 +1,7 @@ -- | This module holds a long list of lenses that access the Atoms -- record, the record that holds the input data from which the -- debianization is to be constructed. -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module Debian.Debianize.Types.Atoms {- ( Atoms , showAtoms @@ -14,7 +14,9 @@ , PackageInfo(..) ) -} where +import Control.Applicative ((<$>)) import Control.Category ((.)) +import Control.Monad.Trans (MonadIO, liftIO) import Data.Lens.Lazy (Lens, lens) import Data.Map as Map (Map) import Data.Monoid (Monoid(..)) @@ -27,10 +29,14 @@ import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat) import Debian.Relation (BinPkgName, Relations, SrcPkgName) import Debian.Version (DebianVersion) +import Distribution.Compiler (CompilerFlavor) import Distribution.License (License) import Distribution.Package (PackageName) import Distribution.PackageDescription as Cabal (FlagName, PackageDescription) import Prelude hiding (init, init, log, log, unlines, (.)) +import System.Console.GetOpt (getOpt, ArgOrder(Permute), OptDescr(Option), ArgDescr(ReqArg)) +import System.Environment (getArgs) +import System.FilePath (()) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) -- | Bits and pieces of information about the mapping from cabal package @@ -41,14 +47,15 @@ -- debianization is finalized. data Atoms = Atoms - { noDocumentationLibrary_ :: Set Bool - -- ^ Do not produce a libghc-foo-doc package. FIXME: make this Bool or Maybe Bool - , noProfilingLibrary_ :: Set Bool - -- ^ Do not produce a libghc-foo-prof package. FIXME: make this Bool or Maybe Bool - , omitLTDeps_ :: Set Bool + { noDocumentationLibrary_ :: Bool + -- ^ Do not produce a libghc-foo-doc package. + , noProfilingLibrary_ :: Bool + -- ^ Do not produce a libghc-foo-prof package. + , noHoogle_ :: Bool + -- ^ Don't link the documentation for hoogle. + , omitLTDeps_ :: Bool -- ^ If present, don't generate the << dependency when we see a cabal -- equals dependency. (The implementation of this was somehow lost.) - -- FIXME: make this Bool or Maybe Bool , buildDir_ :: Set FilePath -- ^ The build directory used by cabal, typically dist/build when -- building manually or dist-ghc/build when building using GHC and @@ -57,12 +64,12 @@ -- the --builddir option of runhaskell Setup appends the "/build" -- to the value it receives, so, yes, try not to get confused. -- FIXME: make this FilePath or Maybe FilePath - , buildEnv_ :: FilePath + , buildEnv_ :: EnvSet -- ^ Directory containing the build environment for which the -- debianization will be generated. This determines which -- compiler will be available, which in turn determines which - -- basic libraries can be provided by the compiler. This may be - -- set to /, but it must be set. + -- basic libraries can be provided by the compiler. By default + -- all the paths in EnvSet are "/". , flags_ :: Flags -- ^ Information regarding mode of operation - verbosity, dry-run, usage, etc , debianNameMap_ :: Map PackageName VersionSplits @@ -201,16 +208,38 @@ -- reason to use this is because we don't yet know the name of the dev library package. , packageDescription_ :: Maybe PackageDescription -- ^ The result of reading a cabal configuration file. + , compilerFlavor_ :: CompilerFlavor + -- ^ The newest available version of GHC in the build repository. We don't support + -- base repositories with no version of GHC, it has been standard in Debian and + -- Ubuntu for quite some time. } deriving (Eq, Show) -newAtoms :: Atoms -newAtoms - = Atoms - { noDocumentationLibrary_ = mempty - , noProfilingLibrary_ = mempty - , omitLTDeps_ = mempty +data EnvSet = EnvSet + { cleanOS :: FilePath -- ^ The output of the debootstrap command + , dependOS :: FilePath -- ^ An environment with build dependencies installed + , buildOS :: FilePath -- ^ An environment where we have built a package + } deriving (Eq, Show) + +-- | Look for --buildenvdir in the command line arguments to get the +-- changeroot path, use "/" if not present. +newAtoms :: MonadIO m => CompilerFlavor -> m Atoms +newAtoms hc = liftIO $ do + (roots, _, _) <- getOpt Permute [Option "buildenvdir" [] (ReqArg id "PATH") + "Directory containing the build environment"] <$> getArgs + let envset = case roots of + (x : _) -> EnvSet {cleanOS = x "clean", dependOS = x "depend", buildOS = x "build"} + _ -> EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"} + return $ makeAtoms hc envset + +makeAtoms :: CompilerFlavor -> EnvSet -> Atoms +makeAtoms hc envset = + Atoms + { noDocumentationLibrary_ = False + , noProfilingLibrary_ = False + , noHoogle_ = False + , omitLTDeps_ = False , buildDir_ = mempty - , buildEnv_ = "/" + , buildEnv_ = envset , flags_ = defaultFlags , debianNameMap_ = mempty , control_ = S.newSourceDebDescription @@ -264,6 +293,7 @@ , backups_ = mempty , extraDevDeps_ = mempty , packageDescription_ = Nothing + , compilerFlavor_ = hc } -- | This record supplies information about the task we want done - @@ -378,9 +408,16 @@ buildDir :: Lens Atoms (Set FilePath) buildDir = lens buildDir_ (\ b a -> a {buildDir_ = b}) -buildEnv :: Lens Atoms FilePath +-- We need to update ghcVersion when this is changed, which means doing IO +-- buildEnv :: Lens Atoms (Maybe EnvSet) +-- buildEnv = lens buildEnv_ (\ b a -> a {buildEnv_ = b}) + +buildEnv :: Lens Atoms EnvSet buildEnv = lens buildEnv_ (\ b a -> a {buildEnv_ = b}) +setBuildEnv :: MonadIO m => EnvSet -> Atoms -> m Atoms +setBuildEnv envset atoms = return $ atoms {buildEnv_ = envset} + -- | Map from cabal Extra-Lib names to debian binary package names. extraLibMap :: Lens Atoms (Map String Relations) extraLibMap = lens extraLibMap_ (\ a b -> b {extraLibMap_ = a}) @@ -462,15 +499,19 @@ -- | Set this to filter any less-than dependencies out of the generated debian -- dependencies. (Not sure if this is implemented.) -omitLTDeps :: Lens Atoms (Set Bool) +omitLTDeps :: Lens Atoms Bool omitLTDeps = lens omitLTDeps_ (\ b a -> a {omitLTDeps_ = b}) -- | Set this to omit the prof library deb. -noProfilingLibrary :: Lens Atoms (Set Bool) +noProfilingLibrary :: Lens Atoms Bool noProfilingLibrary = lens noProfilingLibrary_ (\ b a -> a {noProfilingLibrary_ = b}) +-- | Set this to omit the hoogle documentation link +noHoogle :: Lens Atoms Bool +noHoogle = lens noHoogle_ (\ b a -> a {noHoogle_ = b}) + -- | Set this to omit the doc library deb. -noDocumentationLibrary :: Lens Atoms (Set Bool) +noDocumentationLibrary :: Lens Atoms Bool noDocumentationLibrary = lens noDocumentationLibrary_ (\ b a -> a {noDocumentationLibrary_ = b}) -- | The copyright information from the cabal file @@ -600,3 +641,17 @@ -- FIXME: change signature to BinPkgName -> Lens Atoms (Set (FilePath, Text)) intermediateFiles :: Lens Atoms (Set (FilePath, Text)) intermediateFiles = lens intermediateFiles_ (\ a b -> b {intermediateFiles_ = a}) + +compilerFlavor :: Lens Atoms CompilerFlavor +compilerFlavor = lens compilerFlavor_ (\ a b -> b {compilerFlavor_ = a}) + +{- +compilerFlavor :: Monad m => StateT Atoms m CompilerFlavor +compilerFlavor = do +#if MIN_VERSION_Cabal(1,20,0) + CompilerId x _ _ <- access ghcVersion +#else + CompilerId x _ <- access ghcVersion +#endif + return x +-} diff --git a/src/Debian/Debianize/VersionSplits.hs b/src/Debian/Debianize/VersionSplits.hs --- a/src/Debian/Debianize/VersionSplits.hs +++ b/src/Debian/Debianize/VersionSplits.hs @@ -1,43 +1,64 @@ +-- | Convert between cabal and debian package names based on version +-- number ranges. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} module Debian.Debianize.VersionSplits - ( VersionSplits - , packageRangesFromVersionSplits + ( DebBase(DebBase) + -- * Combinators for VersionSplits + , VersionSplits , makePackage , insertSplit + -- * Operators on VersionSplits + , cabalFromDebian + , cabalFromDebian' + , debianFromCabal + , packageRangesFromVersionSplits , doSplits - , knownVersionSplits ) where +import Data.Map as Map (Map, mapMaybeWithKey, elems) +import Data.Set as Set (Set, toList, fromList) import Data.Version (Version(Version), showVersion) import Debian.Debianize.Interspersed (Interspersed(leftmost, pairs, foldInverted), foldTriples) -import Data.Map as Map (Map, fromList) import Debian.Orphans () import qualified Debian.Relation as D -import Debian.Version (parseDebianVersion) -import Distribution.Package (PackageName(PackageName)) +import Debian.Version (DebianVersion, parseDebianVersion) +import Distribution.Package (PackageIdentifier(..), PackageName(..)) import Distribution.Version (VersionRange, anyVersion, intersectVersionRanges, earlierVersion, orLaterVersion) import Prelude hiding (init, unlines, log) +-- | The base of a debian binary package name, the string that appears +-- between "libghc-" and "-dev". +newtype DebBase = DebBase String deriving (Eq, Ord, Read, Show) + -- | Describes a mapping from cabal package name and version to debian -- package names. For example, versions of the cabal QuickCheck -- package less than 2 are mapped to "quickcheck1", while version 2 or -- greater is mapped to "quickcheck2". data VersionSplits = VersionSplits { - oldestPackage :: String - -- ^ The name given to versions older than the oldest split. - , splits :: [(Version, String)] + oldestPackage :: DebBase + -- ^ The Debian name given to versions older than the oldest split. + , splits :: [(Version, DebBase)] -- ^ Each pair is The version where the split occurs, and the -- name to use for versions greater than or equal to that -- version. This list assumed to be in (must be kept in) -- ascending version number order. - } deriving (Eq, Ord, Show) + } deriving (Eq, Ord) -makePackage :: String -> VersionSplits +instance Show VersionSplits where + show s = foldr (\ (v, b) r -> ("insertSplit (" ++ show v ++ ") (" ++ show b ++ ") (" ++ r ++ ")")) ("makePackage (" ++ show (oldestPackage s) ++ ")") (splits s) + +instance Interspersed VersionSplits DebBase Version where + leftmost (VersionSplits {oldestPackage = p}) = p + pairs (VersionSplits {splits = xs}) = xs + +-- | Create a version split database that assigns a single debian +-- package name base to all cabal versions. +makePackage :: DebBase -> VersionSplits makePackage name = VersionSplits {oldestPackage = name, splits = []} -- | Split the version range and give the older packages a new name. -insertSplit :: Version -> String -> VersionSplits -> VersionSplits +insertSplit :: Version -> DebBase -> VersionSplits -> VersionSplits insertSplit ver@(Version _ _) ltname sp@(VersionSplits {}) = -- (\ x -> trace ("insertSplit " ++ show (ltname, ver, sp) ++ " -> " ++ show x) x) $ case splits sp of @@ -56,19 +77,44 @@ insert [] = [(ver, oldestPackage sp)] -- ltname = base ++ "-" ++ (show (last ns - 1)) -instance Interspersed VersionSplits String Version where - leftmost (VersionSplits {splits = []}) = error "Empty Interspersed instance" - leftmost (VersionSplits {oldestPackage = p}) = p - pairs (VersionSplits {splits = xs}) = xs - -packageRangesFromVersionSplits :: VersionSplits -> [(String, VersionRange)] +packageRangesFromVersionSplits :: VersionSplits -> [(DebBase, VersionRange)] packageRangesFromVersionSplits s = foldInverted (\ older dname newer more -> (dname, intersectVersionRanges (maybe anyVersion orLaterVersion older) (maybe anyVersion earlierVersion newer)) : more) [] s -doSplits :: VersionSplits -> Maybe D.VersionReq -> String +debianFromCabal :: VersionSplits -> PackageIdentifier -> DebBase +debianFromCabal s p = + doSplits s (Just (D.EEQ debVer)) + where debVer = parseDebianVersion (showVersion (pkgVersion p)) + +cabalFromDebian' :: Map PackageName VersionSplits -> DebBase -> Version -> PackageIdentifier +cabalFromDebian' mp base ver = + PackageIdentifier (cabalFromDebian mp base dver) ver + where dver = parseDebianVersion (showVersion ver) + +-- | Brute force implementation - I'm assuming this is not a huge map. +cabalFromDebian :: Map PackageName VersionSplits -> DebBase -> DebianVersion -> PackageName +cabalFromDebian mp base@(DebBase name) ver = + case Set.toList pset of + [x] -> x + [] -> PackageName name + l -> error $ "Error, multiple cabal package names associated with " ++ show base ++ ": " ++ show l + where + -- Look for splits that involve the right DebBase and return the + -- associated Cabal package name. It is unlikely that more than + -- one Cabal name will be returned - if so throw an exception. + pset :: Set PackageName + pset = Set.fromList $ Map.elems $ + Map.mapMaybeWithKey + (\ p s -> if doSplits s (Just (D.EEQ ver)) == base then Just p else Nothing) + mp + +-- | Given a version split database, turn the debian version +-- requirements into a debian package name base that ought to satisfy +-- them. +doSplits :: VersionSplits -> Maybe D.VersionReq -> DebBase doSplits s version = foldTriples' (\ ltName v geName _ -> let split = parseDebianVersion (showVersion v) in @@ -84,17 +130,5 @@ (oldestPackage s) s where - foldTriples' :: (String -> Version -> String -> String -> String) -> String -> VersionSplits -> String + foldTriples' :: (DebBase -> Version -> DebBase -> DebBase -> DebBase) -> DebBase -> VersionSplits -> DebBase foldTriples' = foldTriples - --- | These are the instances of debian names changing that I know --- about. I know they really shouldn't be hard coded. Send a patch. --- Note that this inherits the lack of type safety of the mkPkgName --- function. -knownVersionSplits :: Map PackageName VersionSplits -knownVersionSplits = - Map.fromList - [ (PackageName "parsec", VersionSplits {oldestPackage = "parsec2", splits = [(Version [3] [], "parsec3")]}) - , (PackageName "QuickCheck", VersionSplits {oldestPackage = "quickcheck1", splits = [(Version [2] [], "quickcheck2")]}) - -- This just gives a special case cabal to debian name mapping. - , (PackageName "gtk2hs-buildtools", VersionSplits {oldestPackage = "gtk2hs-buildtools", splits = []}) ] diff --git a/src/Debian/GHC.hs b/src/Debian/GHC.hs new file mode 100644 --- /dev/null +++ b/src/Debian/GHC.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, TemplateHaskell #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +module Debian.GHC + ( withCompilerVersion + , newestAvailable + , compilerIdFromDebianVersion + , compilerFlavorOption + , newestAvailableCompilerId + -- , ghcNewestAvailableVersion' + -- , ghcNewestAvailableVersion + -- , compilerIdFromDebianVersion + ) where + +import Control.DeepSeq (force) +import Control.Exception (SomeException, try) +import Control.Monad (when) +import Data.Char (toLower, toUpper, isSpace) +import Data.Function.Memoize (deriveMemoizable, memoize2) +import Data.Maybe (fromMaybe) +import Data.Version (showVersion, Version(Version)) +import Debian.Relation (BinPkgName(BinPkgName)) +import Debian.Version (DebianVersion, parseDebianVersion) +import Distribution.Compiler (CompilerId(CompilerId), CompilerFlavor(..)) +import System.Console.GetOpt +import System.Directory (doesDirectoryExist) +import System.IO.Unsafe (unsafePerformIO) +import System.Process (readProcess) +import System.Unix.Chroot (useEnv) +import Text.Read (readMaybe) + +$(deriveMemoizable ''CompilerFlavor) +$(deriveMemoizable ''BinPkgName) + +withCompilerVersion :: CompilerFlavor -> FilePath -> (DebianVersion -> a) -> a +withCompilerVersion hc root f = f (newestAvailableCompiler hc root) + +-- | Memoized version of newestAvailable' +newestAvailable :: BinPkgName -> FilePath -> Maybe DebianVersion +newestAvailable pkg root = + memoize2 f pkg root + where + f :: BinPkgName -> FilePath -> Maybe DebianVersion + f pkg' root' = unsafePerformIO (newestAvailable' pkg' root') + +-- | Look up the newest version of a deb available in the given changeroot. +newestAvailable' :: BinPkgName -> FilePath -> IO (Maybe DebianVersion) +newestAvailable' (BinPkgName name) root = do + exists <- doesDirectoryExist root + when (not exists) (error $ "newestAvailable: no such environment: " ++ show root) + versions <- try $ chroot root $ + (readProcess "apt-cache" ["showpkg", name] "" >>= + return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String]) + case versions of + Left e -> error $ "newestAvailable failed in " ++ show root ++ ": " ++ show e + Right (_ : versionLine : _) -> return . Just . parseDebianVersion . takeWhile (/= ' ') $ versionLine + _ -> return Nothing + where + chroot "/" = id + chroot _ = useEnv root (return . force) + +newestAvailableCompiler :: CompilerFlavor -> FilePath -> DebianVersion +newestAvailableCompiler hc root = + case debName hc of + Nothing -> error $ "newestAvailableCompiler - Unsupported CompilerFlavor: " ++ show hc + Just pkg -> fromMaybe (error $ "newestAvailableCompiler - No versions of " ++ show hc ++ " available in " ++ show root) (newestAvailable pkg root) + +newestAvailableCompilerId :: CompilerFlavor -> FilePath -> CompilerId +newestAvailableCompilerId hc root = compilerIdFromDebianVersion hc (newestAvailableCompiler hc root) + +{- +-- | The IO portion of ghcVersion. For there to be no version of ghc +-- available is an exceptional condition, it has been standard in +-- Debian and Ubuntu for a long time. +ghcNewestAvailableVersion :: CompilerFlavor -> FilePath -> IO DebianVersion +ghcNewestAvailableVersion hc root = do + exists <- doesDirectoryExist root + when (not exists) (error $ "ghcVersion: no such environment: " ++ show root) + versions <- try $ chroot $ + (readProcess "apt-cache" ["showpkg", map toLower (show hc)] "" >>= + return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String]) + case versions of + Left e -> error $ "ghcNewestAvailableVersion failed in " ++ show root ++ ": " ++ show e + Right (_ : versionLine : _) -> return . parseDebianVersion . takeWhile (/= ' ') $ versionLine + _ -> error $ "No version of ghc available in " ++ show root + where + chroot = case root of + "/" -> id + _ -> useEnv root (return . force) + +-- | Memoize the CompilerId built for the newest available version of +-- the compiler package so we don't keep running apt-cache showpkg +-- over and over. +ghcNewestAvailableVersion' :: CompilerFlavor -> FilePath -> CompilerId +ghcNewestAvailableVersion' hc root = + memoize f (hc, root) + where + f :: (CompilerFlavor, FilePath) -> CompilerId + f (hc', root) = unsafePerformIO (g hc' root) + g hc root = do + ver <- ghcNewestAvailableVersion hc root + let cid = compilerIdFromDebianVersion ver + -- hPutStrLn stderr ("GHC Debian version: " ++ show ver ++ ", Compiler ID: " ++ show cid) + return cid +-} + +compilerIdFromDebianVersion :: CompilerFlavor -> DebianVersion -> CompilerId +compilerIdFromDebianVersion hc debVersion = + let (Version ds ts) = greatestLowerBound debVersion (map (\ d -> Version [d] []) [0..]) in + CompilerId hc (greatestLowerBound debVersion (map (\ d -> Version (ds ++ [d]) ts) [0..])) +#if MIN_VERSION_Cabal(1,21,0) + Nothing +#endif + where + greatestLowerBound :: DebianVersion -> [Version] -> Version + greatestLowerBound b xs = last $ takeWhile (\ v -> parseDebianVersion (showVersion v) < b) xs + +-- | General function to build a command line option that reads most +-- of the possible values for CompilerFlavor. +compilerFlavorOption :: forall a. (CompilerFlavor -> a -> a) -> OptDescr (a -> a) +compilerFlavorOption f = + Option [] ["hc", "compiler-flavor"] (ReqArg readHC "COMPILER") "Build packages using this Haskell compiler" + where + -- Most of the constructors in CompilerFlavor are arity zero and + -- all caps, though two are capitalized - Hugs and Helium. This + -- won't read those, and it won't read HaskellSuite String or + -- OtherCompiler String + readHC :: String -> a -> a + readHC s = maybe (error $ "Invalid CompilerFlavor: " ++ show s) f (readMaybe (map toUpper s)) + +debName :: CompilerFlavor -> Maybe BinPkgName +debName hc = + case map toLower (show hc) of + s | any isSpace s -> Nothing + s -> Just (BinPkgName s) diff --git a/test-data/alex/output/debian/control b/test-data/alex/output/debian/control --- a/test-data/alex/output/debian/control +++ b/test-data/alex/output/debian/control @@ -10,23 +10,8 @@ , ghc-prof , libghc-quickcheck2-dev (>= 2) , libghc-quickcheck2-prof (>= 2) - , libghc-array-dev | ghc - , libghc-array-prof | ghc-prof - , libghc-base-dev (>= 2.1) | ghc - , libghc-base-dev (<< 5) | ghc - , libghc-base-prof (>= 2.1) | ghc-prof - , libghc-base-prof (<< 5) | ghc-prof - , libghc-containers-dev | ghc - , libghc-containers-prof | ghc-prof - , libghc-directory-dev | ghc - , libghc-directory-prof | ghc-prof Build-Depends-Indep: ghc-doc , libghc-quickcheck2-doc (>= 2) - , libghc-array-doc | ghc-doc - , libghc-base-doc (>= 2.1) | ghc-doc - , libghc-base-doc (<< 5) | ghc-doc - , libghc-containers-doc | ghc-doc - , libghc-directory-doc | ghc-doc Standards-Version: 3.9.3 Homepage: http://www.haskell.org/alex/ diff --git a/test-data/archive/output/debian/control b/test-data/archive/output/debian/control --- a/test-data/archive/output/debian/control +++ b/test-data/archive/output/debian/control @@ -11,14 +11,11 @@ , libghc-extra-prof , libghc-archive-dev (>= 1.7) , libghc-archive-prof (>= 1.7) - , libghc-base-dev | ghc - , libghc-base-prof | ghc-prof , libghc-network-dev , libghc-network-prof Build-Depends-Indep: ghc-doc , libghc-extra-doc , libghc-archive-doc (>= 1.7) - , libghc-base-doc | ghc-doc , libghc-network-doc Standards-Version: 3.8.1 diff --git a/test-data/artvaluereport-data/output/debian/control b/test-data/artvaluereport-data/output/debian/control --- a/test-data/artvaluereport-data/output/debian/control +++ b/test-data/artvaluereport-data/output/debian/control @@ -26,26 +26,14 @@ , libghc-acid-state-prof , libghc-applicative-extras-dev , libghc-applicative-extras-prof - , libghc-base-dev | ghc - , libghc-base-prof | ghc-prof - , libghc-binary-dev | ghc - , libghc-binary-prof | ghc-prof - , libghc-bytestring-dev | ghc - , libghc-bytestring-prof | ghc-prof , libghc-cabal-debian-dev , libghc-cabal-debian-prof , libghc-cereal-dev , libghc-cereal-prof - , libghc-containers-dev | ghc - , libghc-containers-prof | ghc-prof , libghc-cryptohash-dev (>= 0.7) , libghc-cryptohash-prof (>= 0.7) , libghc-debian-dev (>= 3.67) , libghc-debian-prof (>= 3.67) - , libghc-directory-dev | ghc - , libghc-directory-prof | ghc-prof - , libghc-filepath-dev | ghc - , libghc-filepath-prof | ghc-prof , libghc-formlets-dev , libghc-formlets-prof , libghc-happstack-extra-dev @@ -74,16 +62,12 @@ , libghc-mtl-prof , libghc-network-dev (>= 2.4) , libghc-network-prof (>= 2.4) - , libghc-old-time-dev | ghc - , libghc-old-time-prof | ghc-prof , libghc-pandoc-dev , libghc-pandoc-prof , libghc-pandoc-types-dev , libghc-pandoc-types-prof , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3) , libghc-parsec3-prof (>= 3) | libghc-parsec2-prof (<< 3) - , libghc-process-dev | ghc - , libghc-process-prof | ghc-prof , libghc-process-extras-dev (>= 0.6) , libghc-process-extras-prof (>= 0.6) , libghc-process-progress-dev @@ -104,10 +88,6 @@ , libghc-syb-with-class-prof , libghc-text-dev , libghc-text-prof - , libghc-time-dev | ghc - , libghc-time-prof | ghc-prof - , libghc-unix-dev | ghc - , libghc-unix-prof | ghc-prof , libghc-utf8-string-dev , libghc-utf8-string-prof , libghc-xhtml-dev @@ -122,16 +102,10 @@ , libghc-unixutils-doc (>= 1.50) , libghc-acid-state-doc , libghc-applicative-extras-doc - , libghc-base-doc | ghc-doc - , libghc-binary-doc | ghc-doc - , libghc-bytestring-doc | ghc-doc , libghc-cabal-debian-doc , libghc-cereal-doc - , libghc-containers-doc | ghc-doc , libghc-cryptohash-doc (>= 0.7) , libghc-debian-doc (>= 3.67) - , libghc-directory-doc | ghc-doc - , libghc-filepath-doc | ghc-doc , libghc-formlets-doc , libghc-happstack-extra-doc , libghc-happstack-hsp-doc @@ -146,11 +120,9 @@ , libghc-maccatcher-doc , libghc-mtl-doc , libghc-network-doc (>= 2.4) - , libghc-old-time-doc | ghc-doc , libghc-pandoc-doc , libghc-pandoc-types-doc , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3) - , libghc-process-doc | ghc-doc , libghc-process-extras-doc (>= 0.6) , libghc-process-progress-doc , libghc-puremd5-doc @@ -161,8 +133,6 @@ , libghc-syb-doc , libghc-syb-with-class-doc , libghc-text-doc - , libghc-time-doc | ghc-doc - , libghc-unix-doc | ghc-doc , libghc-utf8-string-doc , libghc-xhtml-doc Standards-Version: 3.9.3 diff --git a/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate b/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate --- a/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate +++ b/test-data/clckwrks-dot-com/output/debian/clckwrks-dot-com-production.logrotate @@ -1,4 +1,5 @@ /var/log/apache2/clckwrks-dot-com-production/access.log { + copytruncate weekly rotate 5 compress @@ -6,6 +7,7 @@ } /var/log/apache2/clckwrks-dot-com-production/error.log { + copytruncate weekly rotate 5 compress diff --git a/test-data/clckwrks-dot-com/output/debian/control b/test-data/clckwrks-dot-com/output/debian/control --- a/test-data/clckwrks-dot-com/output/debian/control +++ b/test-data/clckwrks-dot-com/output/debian/control @@ -7,10 +7,6 @@ , cdbs , ghc , ghc-prof - , libghc-base-dev (>> 4) | ghc - , libghc-base-dev (<< 5) | ghc - , libghc-base-prof (>> 4) | ghc-prof - , libghc-base-prof (<< 5) | ghc-prof , libghc-clckwrks-dev (>= 0.13) , libghc-clckwrks-dev (<< 0.15) , libghc-clckwrks-prof (>= 0.13) @@ -27,10 +23,6 @@ , libghc-clckwrks-theme-clckwrks-dev (<< 0.3) , libghc-clckwrks-theme-clckwrks-prof (>= 0.2) , libghc-clckwrks-theme-clckwrks-prof (<< 0.3) - , libghc-containers-dev (>= 0.4) | ghc - , libghc-containers-dev (<< 0.5) | ghc - , libghc-containers-prof (>= 0.4) | ghc-prof - , libghc-containers-prof (<< 0.5) | ghc-prof , libghc-happstack-server-dev (>= 7.0) , libghc-happstack-server-dev (<< 7.2) , libghc-happstack-server-prof (>= 7.0) @@ -52,16 +44,12 @@ , libghc-web-plugins-prof (>= 0.1) , libghc-web-plugins-prof (<< 0.2) Build-Depends-Indep: ghc-doc - , libghc-base-doc (>> 4) | ghc-doc - , libghc-base-doc (<< 5) | ghc-doc , libghc-clckwrks-doc (>= 0.13) , libghc-clckwrks-doc (<< 0.15) , libghc-clckwrks-plugin-bugs-doc (>= 0.3) , libghc-clckwrks-plugin-bugs-doc (<< 0.4) , libghc-clckwrks-plugin-media-doc (>= 0.3) , libghc-clckwrks-plugin-media-doc (<< 0.4) - , libghc-containers-doc (>= 0.4) | ghc-doc - , libghc-containers-doc (<< 0.5) | ghc-doc , libghc-happstack-server-doc (>= 7.0) , libghc-happstack-server-doc (<< 7.2) , libghc-hsp-doc (>= 0.7) diff --git a/test-data/creativeprompts/output/debian/control b/test-data/creativeprompts/output/debian/control --- a/test-data/creativeprompts/output/debian/control +++ b/test-data/creativeprompts/output/debian/control @@ -25,18 +25,10 @@ , libghc-archive-prof (>= 1.2.9) , libghc-authenticate-dev (>= 0.8.0) , libghc-authenticate-prof (>= 0.8.0) - , libghc-base-dev (>= 4) | ghc - , libghc-base-dev (<< 5) | ghc - , libghc-base-prof (>= 4) | ghc-prof - , libghc-base-prof (<< 5) | ghc-prof , libghc-blaze-html-dev (>= 0.5) , libghc-blaze-html-prof (>= 0.5) , libghc-blaze-markup-dev , libghc-blaze-markup-prof - , libghc-bytestring-dev | ghc - , libghc-bytestring-prof | ghc-prof - , libghc-containers-dev | ghc - , libghc-containers-prof | ghc-prof , libghc-debian-packaging-dev (>= 0.8) , libghc-debian-packaging-prof (>= 0.8) , libghc-digestive-functors-dev (>= 0.2) @@ -45,12 +37,8 @@ , libghc-digestive-functors-happstack-prof (>= 0.1) , libghc-digestive-functors-hsp-dev (>= 0.3.1) , libghc-digestive-functors-hsp-prof (>= 0.3.1) - , libghc-directory-dev | ghc - , libghc-directory-prof | ghc-prof , libghc-extensible-exceptions-dev , libghc-extensible-exceptions-prof - , libghc-filepath-dev | ghc - , libghc-filepath-prof | ghc-prof , libghc-happstack-authenticate-dev (>= 0.6) , libghc-happstack-authenticate-prof (>= 0.6) , libghc-happstack-hsp-dev (>= 7.1) @@ -81,14 +69,8 @@ , libghc-mtl-prof , libghc-network-dev , libghc-network-prof - , libghc-old-locale-dev | ghc - , libghc-old-locale-prof | ghc-prof - , libghc-old-time-dev | ghc - , libghc-old-time-prof | ghc-prof , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3) , libghc-parsec3-prof (>= 3) | libghc-parsec2-prof (<< 3) - , libghc-process-dev | ghc - , libghc-process-prof | ghc-prof , libghc-random-dev , libghc-random-prof , libghc-safecopy-dev (>= 0.6.0) @@ -97,10 +79,6 @@ , libghc-syb-prof , libghc-text-dev (>= 0.11) , libghc-text-prof (>= 0.11) - , libghc-time-dev | ghc - , libghc-time-prof | ghc-prof - , libghc-unix-dev | ghc - , libghc-unix-prof | ghc-prof , libghc-utf8-string-dev , libghc-utf8-string-prof , libghc-web-routes-dev (>= 0.26.2) @@ -124,19 +102,13 @@ , libghc-acid-state-doc (>= 0.6.0) , libghc-archive-doc (>= 1.2.9) , libghc-authenticate-doc (>= 0.8.0) - , libghc-base-doc (>= 4) | ghc-doc - , libghc-base-doc (<< 5) | ghc-doc , libghc-blaze-html-doc (>= 0.5) , libghc-blaze-markup-doc - , libghc-bytestring-doc | ghc-doc - , libghc-containers-doc | ghc-doc , libghc-debian-packaging-doc (>= 0.8) , libghc-digestive-functors-doc (>= 0.2) , libghc-digestive-functors-happstack-doc (>= 0.1) , libghc-digestive-functors-hsp-doc (>= 0.3.1) - , libghc-directory-doc | ghc-doc , libghc-extensible-exceptions-doc - , libghc-filepath-doc | ghc-doc , libghc-happstack-authenticate-doc (>= 0.6) , libghc-happstack-hsp-doc (>= 7.1) , libghc-happstack-hsp-doc (<< 7.2) @@ -152,16 +124,11 @@ , libghc-json-doc , libghc-mtl-doc , libghc-network-doc - , libghc-old-locale-doc | ghc-doc - , libghc-old-time-doc | ghc-doc , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3) - , libghc-process-doc | ghc-doc , libghc-random-doc , libghc-safecopy-doc (>= 0.6.0) , libghc-syb-doc , libghc-text-doc (>= 0.11) - , libghc-time-doc | ghc-doc - , libghc-unix-doc | ghc-doc , libghc-utf8-string-doc , libghc-web-routes-doc (>= 0.26.2) , libghc-web-routes-happstack-doc diff --git a/test-data/creativeprompts/output/debian/creativeprompts-production.logrotate b/test-data/creativeprompts/output/debian/creativeprompts-production.logrotate --- a/test-data/creativeprompts/output/debian/creativeprompts-production.logrotate +++ b/test-data/creativeprompts/output/debian/creativeprompts-production.logrotate @@ -1,4 +1,5 @@ /var/log/apache2/creativeprompts-production/access.log { + copytruncate weekly rotate 5 compress @@ -6,6 +7,7 @@ } /var/log/apache2/creativeprompts-production/error.log { + copytruncate weekly rotate 5 compress