diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -80,7 +80,7 @@ do (A.debInfo . D.changelog) .= Just log (A.debInfo . D.compat) .= level (A.debInfo . D.control . S.source) .= Just (SrcPkgName (logPackage entry)) - (A.debInfo . D.control . S.maintainer) .= either error Just (parseMaintainer (logWho entry)) + (A.debInfo . D.control . S.maintainer) .= either error Right (parseMaintainer (logWho entry)) (A.debInfo . D.control . S.standardsVersion) .= standards newDebianization _ _ _ = error "Invalid changelog" @@ -290,7 +290,7 @@ (debInfo . D.compat) .= Just 9 (debInfo . D.copyright) %= (Just . id . fromMaybe (readCopyrightDescription "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")) (debInfo . D.control . S.source) .= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"}) - (debInfo . D.control . S.maintainer) .= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) + (debInfo . D.control . S.maintainer) .= Right (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"}) (debInfo . D.control . S.uploaders) .= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}] (debInfo . D.control . S.priority) .= Just Extra (debInfo . D.control . S.section) .= Just (MainSection "haskell") @@ -668,7 +668,7 @@ (A.debInfo . D.sourcePackageName) .= Just (SrcPkgName "seereason-darcs-backups") (A.debInfo . D.compat) .= Just 9 (A.debInfo . D.control . S.standardsVersion) .= Just (StandardsVersion 3 8 1 Nothing) - (A.debInfo . D.control . S.maintainer) .= either (const Nothing) Just (parseMaintainer "David Fox ") + (A.debInfo . D.control . S.maintainer) .= parseMaintainer "David Fox " (A.debInfo . D.binaryDebDescription (BinPkgName "seereason-darcs-backups") . B.relations . B.depends) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]]) (A.debInfo . D.control . S.section) .= Just (MainSection "haskell") (A.debInfo . D.utilsPackageNameBase) .= Just "seereason-darcs-backups" 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.29 +Version: 4.30 Copyright: Copyright (c) 2007-2014, David Fox, Jeremy Shaw License: BSD3 License-File: LICENSE diff --git a/debian-haskell/Debian/Control/Text.hs b/debian-haskell/Debian/Control/Text.hs --- a/debian-haskell/Debian/Control/Text.hs +++ b/debian-haskell/Debian/Control/Text.hs @@ -92,7 +92,7 @@ where hasFieldName :: String -> Field' T.Text -> Bool hasFieldName name (Field (fieldName',_)) = T.pack name == T.map toLower fieldName' hasFieldName _ _ = False - stripWS = T.reverse . T.strip . T.reverse . T.strip + stripWS = T.strip protectFieldText = protectFieldText' asString = T.unpack diff --git a/debian/Debianize.hs b/debian/Debianize.hs --- a/debian/Debianize.hs +++ b/debian/Debianize.hs @@ -8,20 +8,14 @@ import Data.Text as Text (pack) import Data.Version (Version(Version)) import Debian.Debianize +import Debian.Debianize.Output (performDebianization) import Debian.Debianize.Optparse (parseProgramArguments, CommandLineOptions(..)) import Debian.Relation (BinPkgName(BinPkgName), Relations, parseRelations) import Distribution.Package (PackageName(PackageName)) main :: IO () -main = parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= evalStateT cabalDebian +main = performDebianization customize where - cabalDebian = do - -- Read and inspect the cabal info to compute the debianization - debianize customize - -- Write, compare, or validate the resulting debianization, - -- or print usage message, depending on options. - finishDebianization - customize :: Monad m => CabalT m () customize = do debianDefaults @@ -29,6 +23,7 @@ -- changing as new package versions arrive. mapCabal (PackageName "Cabal") (DebBase "cabal-122") splitCabal (PackageName "Cabal") (DebBase "cabal") (Version [1,22] []) + (debInfo . control . maintainer) .= parseMaintainer "David Fox " (debInfo . sourceFormat) .= Native3 (debInfo . control . standardsVersion) .= Just (StandardsVersion 3 9 3 Nothing) (debInfo . compat) .= Just 9 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,23 @@ +haskell-cabal-debian (4.30) unstable; urgency=low + + * Remove mechanism to pass arguments via the CABALDEBIAN environment + variable. + * Make compareDebianization a pure function. + * Remove MonadIO superclass from some functions + + -- David Fox Thu, 18 Jun 2015 09:12:59 -0700 + +haskell-cabal-debian (4.29.3) unstable; urgency=low + + * Fix escaping of wildcard characters that are not meaningful in cabal (i.e. square brackets) + * Fix generation of argument list when running an external debian/Debianization.hs script + (the whole thing was being repeated.) + * Make sure the enable tests and run tests options are handled correctly (not sure they were + wrong, but pretty sure they're now right.) + * Export Dmitry's performDebianization function instead of debianize in Debian.Debianize. + + -- David Fox Sat, 13 Jun 2015 05:24:03 -0700 + haskell-cabal-debian (4.29) unstable; urgency=low * Restore the --epoch-map, --cabal-flag, --ghcjs, and --buildenvdir options diff --git a/src/Debian/Debianize.hs b/src/Debian/Debianize.hs --- a/src/Debian/Debianize.hs +++ b/src/Debian/Debianize.hs @@ -1,48 +1,38 @@ -- | [/QUICK START:/] -- --- You can either run the @cabal-debian --debianize@, or +-- You can either run @cabal-debian@, or -- for more power and flexibility you can put a @Debianize.hs@ script in -- the package's @debian@ subdirectory. --- 'Debian.Debianize.CabalInfo' value and pass it to the --- 'Debian.Debianize.debianize' function. The --- 'Debian.Debianize.callDebianize' function retrieves extra arguments --- from the @CABALDEBIAN@ environment variable and calls --- 'Debian.Debianize.debianize' with the build directory set as it --- would be when the packages is built by @dpkg-buildpackage@. -- -- To see what your debianization would produce, or how it differs -- from the debianization already present: -- --- > % cabal-debian --debianize -n +-- > % cabal-debian -n -- -- This is equivalent to the library call -- --- > % ghc -e 'Debian.Debianize.callDebianize ["-n"]' +-- > % ghc -e 'System.Environment.withArgs ["-n"] $ Debian.Debianize.performDebianization Debian.Debianize.debianDefaults' -- -- To actually create the debianization and then build the debs, -- --- > % ghc -e 'Debian.Debianize.callDebianize []' +-- > % ghc -e 'Debian.Debianize.performDebianization Debian.Debianize.debianDefaults' -- > % sudo dpkg-buildpackage -- --- At this point you may need to modify Cabal.defaultFlags to achieve --- specific packaging goals. Create a module for this in debian/Debianize.hs: +-- At this point you may need a script to achieve specific packaging +-- goals. Put this this in debian/Debianize.hs: -- --- > import Data.Lens.Lazy --- > import Data.Map as Map (insertWith) --- > import Data.Set as Set (union, singleton) +-- > import Control.Lens +-- > import Data.Map as Map +-- > import Data.Set as Set -- > import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) --- > import Debian.Debianize (defaultAtoms, depends, debianization, writeDebianization) --- > main = debianization "." defaultAtoms >>= --- > return . modL depends (insertWith union (BinPkgName "cabal-debian") (singleton (Rel (BinPkgName "debian-policy") Nothing Nothing))) >>= --- > writeDebianization "." +-- > import Debian.Debianize +-- > main = performDebianization $ do +-- > debianDefaults +-- > (debInfo . binaryDebDescription (BinPkgName "cabal-debian") . relations . depends) %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)")) -- -- Then to test it, -- --- > % CABALDEBIAN='["-n"]' runhaskell debian/Debianize.hs --- --- or equivalently --- --- > % ghc -e 'Debian.Debianize.runDebianize ["-n"]' +-- > % runhaskell debian/Debianize.hs -n -- -- and to run it for real: -- @@ -97,7 +87,7 @@ , module Debian.Debianize.InputDebian , module Debian.Debianize.InputCabal -- * Finish computing the debianization and output the result - , module Debian.Debianize.Finalize + -- , module Debian.Debianize.Finalize , module Debian.Debianize.Output -- * Utility functions , module Debian.Debianize.Prelude @@ -113,12 +103,12 @@ import Debian.Debianize.DebInfo -- (Atom(..), atomSet, changelog, compat, control, copyright, DebInfo, file, flags, install, installCabalExec, installCabalExecTo, installData, installDir, installInit, installTo, intermediateFiles, link, logrotateStanza, makeDebInfo, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, warning, watch, apacheSite, backups, buildDir, comments, debVersion, execMap, executable, extraDevDeps, extraLibMap, InstallFile(..), maintainerOption, missingDependencies, noDocumentationLibrary, noProfilingLibrary, official, omitLTDeps, omitProfVersionDeps, revision, Server(..), serverInfo, Site(..), sourceArchitectures, sourcePackageName, uploadersOption, utilsPackageNameBase, website, xDescription, overrideDebianNameBase) import Debian.Debianize.DebianName (mapCabal, splitCabal, remapCabal) import Debian.Debianize.Details (debianDefaults) -import Debian.Debianize.Finalize (debianize) +--import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Goodies -- (doBackups, doExecutable, doServer, doWebsite, tightDependencyFixup) import Debian.Debianize.InputDebian (inputChangeLog, inputDebianization, inputDebianizationFile) import Debian.Debianize.InputCabal (inputCabalization) import Debian.Debianize.Monad (CabalM, CabalT, evalCabalM, evalCabalT, execCabalM, execCabalT, runCabalM, runCabalT, DebianT, execDebianT, evalDebianT, liftCabal) -import Debian.Debianize.Output (compareDebianization, describeDebianization, finishDebianization, runDebianizeScript, validateDebianization, writeDebianization) +import Debian.Debianize.Output (compareDebianization, describeDebianization, finishDebianization, performDebianization, runDebianizeScript, validateDebianization, writeDebianization) import Debian.Debianize.Prelude (buildDebVersionMap, debOfFile, dpkgFileMap, withCurrentDirectory, (.?=)) import Debian.Debianize.SourceDebDescription import Debian.Debianize.VersionSplits (DebBase(DebBase)) 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 @@ -9,7 +9,6 @@ import Control.Applicative ((<$>)) import Control.Lens import Control.Monad.State (MonadState(get)) -import Control.Monad.Trans (MonadIO) import Data.Char (isSpace, toLower) import Data.Function (on) import Data.List as List (filter, groupBy, map, minimumBy, nub, sortBy) @@ -75,12 +74,12 @@ -- so we just gather them all up here. allBuildDepends :: Monad m => PackageDescription -> CabalT m [Dependency_] allBuildDepends pkgDesc = - use (A.debInfo . D.enableTests) >>= \ testsEnabled -> + use (A.debInfo . D.testsStatus) >>= \ testsStatus -> allBuildDepends' (mergeCabalDependencies $ Cabal.buildDepends pkgDesc ++ concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc) ++ - (if testsEnabled then concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) $ {-filter Cabal.testEnabled-} (Cabal.testSuites pkgDesc) else [])) + (if testsStatus /= D.TestsDisable then concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) $ {-filter Cabal.testEnabled-} (Cabal.testSuites pkgDesc) else [])) (mergeCabalDependencies $ concatMap buildTools $ allBuildInfo pkgDesc) (mergeCabalDependencies $ concatMap pkgconfigDepends $ allBuildInfo pkgDesc) (concatMap extraLibs . allBuildInfo $ pkgDesc) >>= @@ -108,7 +107,7 @@ -- The haskell-cdbs package contains the hlibrary.mk file with -- the rules for building haskell packages. -debianBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations +debianBuildDeps :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDeps pkgDesc = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial @@ -141,7 +140,7 @@ hcPackageTypes hc = error $ "Unsupported compiler flavor: " ++ show hc -debianBuildDepsIndep :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations +debianBuildDepsIndep :: (Monad m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDepsIndep pkgDesc = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial @@ -160,7 +159,7 @@ -- | The documentation dependencies for a package include the -- documentation package for any libraries which are build -- dependencies, so we have use to all the cross references. -docDependencies :: (MonadIO m, Functor m) => Dependency_ -> CabalT m D.Relations +docDependencies :: (Monad m, Functor m) => Dependency_ -> CabalT m D.Relations docDependencies (BuildDepends (Dependency name ranges)) = do hc <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hc -- vestigial @@ -171,7 +170,7 @@ -- | The Debian build dependencies for a package include the profiling -- libraries and the documentation packages, used for creating cross -- references. Also the packages associated with extra libraries. -buildDependencies :: (MonadIO m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations +buildDependencies :: (Monad m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) = use (A.debInfo . D.omitProfVersionDeps) >>= \ omitProfDeps -> concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges omitProfDeps) (toList hcTypePairs) @@ -226,7 +225,7 @@ -- | Turn a cabal dependency into debian dependencies. The result -- needs to correspond to a single debian package to be installed, -- so we will return just an OrRelation. -dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations +dependencies :: Monad m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations dependencies hc typ name cabalRange omitProfVersionDeps = do nameMap <- use A.debianNameMap -- Compute a list of alternative debian dependencies for @@ -293,7 +292,7 @@ -- 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. -doBundled :: MonadIO m => +doBundled :: Monad m => B.PackageType -> PackageName -> CompilerFlavor @@ -305,7 +304,7 @@ -- If a library is built into the compiler, this is the debian -- package name the compiler will conflict with. comp = D.Rel (compilerPackageName hc typ) Nothing Nothing - doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation] + doRel :: Monad m => D.Relation -> CabalT m [D.Relation] doRel rel@(D.Rel dname req _) = do -- gver <- use ghcVersion splits <- use A.debianNameMap diff --git a/src/Debian/Debianize/CabalInfo.hs b/src/Debian/Debianize/CabalInfo.hs --- a/src/Debian/Debianize/CabalInfo.hs +++ b/src/Debian/Debianize/CabalInfo.hs @@ -1,6 +1,3 @@ --- | 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 CPP, DeriveDataTypeable, OverloadedStrings, TemplateHaskell #-} {-# OPTIONS_GHC -Wall #-} module Debian.Debianize.CabalInfo @@ -39,14 +36,6 @@ import Distribution.PackageDescription as Cabal (PackageDescription(homepage)) import Prelude hiding (init, init, log, log, null) import System.Unix.Mount (withProcAndSys) - --- This enormous record is a mistake - instead it should be an Atom --- type with lots of constructors, and the Atoms type is a set of --- these. Then we can cruise through the atom set converting the --- elements into other simpler elements until they elements are all --- simple enough to convert directly into a debianization. At the --- moment I really need this for the Install atoms, so I will try to --- convert just that portion of the type to this new scheme. -- | Bits and pieces of information about the mapping from cabal package -- names and versions to debian package names and versions. In essence, diff --git a/src/Debian/Debianize/DebInfo.hs b/src/Debian/Debianize/DebInfo.hs --- a/src/Debian/Debianize/DebInfo.hs +++ b/src/Debian/Debianize/DebInfo.hs @@ -15,6 +15,7 @@ , Site(Site, domain, server, serverAdmin) , Server(Server, headerMessage, hostname, installFile, port, retry, serverFlags) , InstallFile(InstallFile, destDir, destName, execName, sourceDir) + , TestsStatus(..) -- * Lenses , flags @@ -67,8 +68,7 @@ , backups , extraDevDeps , official - , enableTests - , runTests + , testsStatus , allowDebianSelfBuildDeps , binaryDebDescription @@ -248,10 +248,8 @@ -- reason to use this is because we don't yet know the name of the dev library package. , _official :: Bool -- ^ Whether this packaging is created by the Debian Haskell Group - , _enableTests :: Bool - -- ^ Include the test suites in the debianization if they exists - , _runTests :: Bool - -- ^ Prevent the test suite from being run during the package build + , _testsStatus :: TestsStatus + -- ^ Whether or not to build and/or run the test suite , _allowDebianSelfBuildDeps :: Bool -- ^ Normally self dependencies are filtered out of the debian -- build dependency list because they usually reflect @@ -311,6 +309,8 @@ , installFile :: InstallFile -- ^ The hint to install the server executable } deriving (Read, Show, Eq, Ord, Data, Typeable) +data TestsStatus = TestsDisable | TestsBuild | TestsRun deriving (Eq, Show, Data, Typeable) + makeDebInfo :: Flags -> DebInfo makeDebInfo fs = DebInfo @@ -364,8 +364,7 @@ , _backups = mempty , _extraDevDeps = mempty , _official = False - , _enableTests = True - , _runTests = True + , _testsStatus = TestsRun , _allowDebianSelfBuildDeps = False } diff --git a/src/Debian/Debianize/Files.hs b/src/Debian/Debianize/Files.hs --- a/src/Debian/Debianize/Files.hs +++ b/src/Debian/Debianize/Files.hs @@ -22,10 +22,11 @@ import Debian.Control.Common () import qualified Debian.Debianize.DebInfo as D (Atom(Install, InstallDir, Link), atomSet, changelog, compat, control, copyright, installInit, intermediateFiles, logrotateStanza, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, watch) import Debian.Debianize.Monad (DebianT) -import Debian.Debianize.Prelude (showDeps') +import Debian.Debianize.Prelude (escapeDebianWildcards, showDeps') import qualified Debian.Debianize.BinaryDebDescription as B (architecture, BinaryDebDescription, binaryPriority, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, PackageRelations, preDepends, provides, recommends, relations, replaces, suggests) import Debian.Debianize.CopyrightDescription (CopyrightDescription) import qualified Debian.Debianize.SourceDebDescription as S (binaryPackages, buildConflicts, buildConflictsIndep, buildDepends, buildDependsIndep, dmUploadAllowed, homepage, maintainer, priority, section, source, SourceDebDescription, standardsVersion, uploaders, vcsFields, VersionControlSpec(VCSArch, VCSBrowser, VCSBzr, VCSCvs, VCSDarcs, VCSGit, VCSHg, VCSMtn, VCSSvn), xDescription, XField(XField), XFieldDest(B, C, S), xFields) +import Debian.Policy (maintainerOfLastResort) import Debian.Pretty (PP(..), ppShow, prettyText, ppText, ppPrint) import Debian.Relation (BinPkgName(BinPkgName), Relations) import Distribution.PackageDescription (PackageDescription) @@ -82,7 +83,7 @@ installs = (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ use (D.atomSet)) where - doAtom (D.Install b frm dst) mp = Map.insertWith (++) (pathf b) [pack (frm <> " " <> dst)] mp + doAtom (D.Install b frm dst) mp = Map.insertWith (++) (pathf b) [pack (escapeDebianWildcards frm <> " " <> dst)] mp doAtom _ mp = mp pathf name = "debian" show (ppPrint name) ++ ".install" @@ -177,7 +178,7 @@ { unControl = (Paragraph ([Field ("Source", " " ++ (show . maybe empty ppPrint . view S.source $ src)), - Field ("Maintainer", " " <> (show . maybe empty ppPrint . view S.maintainer $ src))] ++ + Field ("Maintainer", " " <> (ppShow . either (const maintainerOfLastResort) id . view S.maintainer $ src))] ++ lField "Uploaders" (view S.uploaders src) ++ (case view S.dmUploadAllowed src of True -> [Field ("DM-Upload-Allowed", " yes")]; False -> []) ++ mField "Priority" (view S.priority src) ++ 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 @@ -18,7 +18,7 @@ import Data.Function (on) import Data.List as List (filter, intercalate, map, nub, null, unlines, maximumBy) import Data.Map as Map (delete, elems, insertWith, lookup, Map, toList) -import Data.Maybe (fromMaybe, isJust, isNothing, fromJust) +import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Monoid ((<>), mempty) import Data.Set as Set (difference, filter, fold, fromList, insert, map, null, Set, singleton, toList, union, unions) import Data.Set.Extra as Set (mapM_) @@ -31,15 +31,14 @@ import Debian.Debianize.Changelog (dropFutureEntries) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (debianName, debianNameBase) -import Debian.Debianize.DebInfo (rulesSettings) import Debian.Debianize.Goodies (backupAtoms, describe, execAtoms, serverAtoms, siteAtoms, watchAtom) import Debian.Debianize.InputDebian (dataTop, dataDest, inputChangeLog) -import Debian.Debianize.Monad as Monad (CabalT, liftCabal, unlessM) +import Debian.Debianize.Monad as Monad (CabalT, liftCabal) import Debian.Debianize.Prelude ((.?=)) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans () -import Debian.Policy (getCurrentDebianUser, getDebhelperCompatLevel, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, parseStandardsVersion, Section(..), SourceFormat(Native3)) +import Debian.Policy (getCurrentDebianUser, getDebhelperCompatLevel, haskellMaintainer, maintainerOfLastResort, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, parseStandardsVersion, Section(..), SourceFormat(Native3)) import Debian.Pretty (PP(..), ppShow) import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), Relation(Rel), Relations, SrcPkgName(SrcPkgName)) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..)) @@ -55,6 +54,7 @@ import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, executables, library, package)) import Prelude hiding (init, log, map, unlines, unlines, writeFile) import System.FilePath ((<.>), (), makeRelative, splitFileName, takeDirectory, takeFileName) +import System.IO (hPutStrLn, stderr) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) @@ -73,10 +73,12 @@ finalizeDebianization :: (MonadIO m, Functor m) => CabalT m () finalizeDebianization = do date <- liftIO getCurrentLocalRFC822Time + currentUser <- liftIO getCurrentDebianUser debhelperCompat <- liftIO getDebhelperCompatLevel - finalizeDebianization' date debhelperCompat + finalizeDebianization' date currentUser debhelperCompat vb <- use (A.debInfo . D.flags . verbosity) when (vb >= 3) (get >>= \ x -> liftIO (putStrLn ("\nFinalized Cabal Info: " ++ show x ++ "\n"))) + either (\e -> liftIO $ hPutStrLn stderr ("WARNING: " ++ e)) (\_ -> return ()) =<< use (A.debInfo . D.control . S.maintainer) -- | Now that we know the build and data directories, we can expand -- some atoms into sets of simpler atoms which can eventually be @@ -86,17 +88,18 @@ -- this function is not idempotent. (Exported for use in unit tests.) -- FIXME: we should be able to run this without a PackageDescription, change -- paramter type to Maybe PackageDescription and propagate down thru code -finalizeDebianization' :: (MonadIO m, Functor m) => String -> Maybe Int -> CabalT m () -finalizeDebianization' date debhelperCompat = +finalizeDebianization' :: (Monad m, Functor m) => String -> Maybe NameAddr -> Maybe Int -> CabalT m () +finalizeDebianization' date currentUser debhelperCompat = do -- In reality, hcs must be a singleton or many things won't work. But some day... hc <- use (A.debInfo . D.flags . compilerFlavor) pkgDesc <- use A.packageDescription - testsEnabled <- use (A.debInfo . D.enableTests) + testsStatus <- use (A.debInfo . D.testsStatus) let testsExist = not $ List.null $ Cabal.testSuites pkgDesc - when (testsExist && testsEnabled) $ - do (A.debInfo . rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes"]) - unlessM (use (A.debInfo . D.runTests)) $ (A.debInfo . D.rulesSettings) %= (++ ["DEB_BUILD_OPTIONS += nocheck"]) + case (testsExist, testsStatus) of + (True, D.TestsRun) -> (A.debInfo . D.rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes"]) + (True, D.TestsBuild) -> (A.debInfo . D.rulesSettings) %= (++ ["DEB_ENABLE_TESTS = yes", "DEB_BUILD_OPTIONS += nocheck"]) + _ -> return () finalizeSourceName B.HaskellSource checkOfficialSettings hc @@ -105,8 +108,8 @@ (A.debInfo . D.control . S.section) .?= Just (MainSection "haskell") (A.debInfo . D.control . S.priority) .?= Just Extra (A.debInfo . D.compat) .?= debhelperCompat - finalizeChangelog date - finalizeControl + finalizeChangelog date currentUser + finalizeControl currentUser finalizeRules -- T.license .?= Just (Cabal.license pkgDesc) expandAtoms @@ -219,10 +222,9 @@ -- 6. the Debian Haskell Group, @pkg-haskell-maintainers\@lists.alioth.debian.org@ -- -- -finalizeMaintainer :: MonadIO m => CabalT m () -finalizeMaintainer = do +finalizeMaintainer :: Monad m => Maybe NameAddr -> CabalT m () +finalizeMaintainer currentUser = do o <- use (A.debInfo . D.official) - currentUser <- liftIO getCurrentDebianUser pkgDesc <- use A.packageDescription maintainerOption <- use (A.debInfo . D.maintainerOption) uploadersOption <- use (A.debInfo . D.uploadersOption) @@ -240,30 +242,28 @@ _ -> return Nothing case o of True -> do - (A.debInfo . D.control . S.maintainer) .= Just haskellMaintainer + (A.debInfo . D.control . S.maintainer) .= Right haskellMaintainer (A.debInfo . D.control . S.uploaders) %= whenEmpty (maybe [] (: []) currentUser) False -> do - (A.debInfo . D.control . S.maintainer) .?= maintainerOption - (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString) - (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString') - (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'') + (A.debInfo . D.control . S.maintainer) %= either (\x -> maybe (Left x) Right maintainerOption) Right + (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString) Right + (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString') Right + (A.debInfo . D.control . S.maintainer) %= either (\_ -> parseMaintainer cabalMaintainerString'') Right -- Sometimes the maintainer is just an email, if it matches the author's email we can use it - (A.debInfo . D.control . S.maintainer) .?= (case parseMaintainer cabalAuthorString of - Right x | nameAddr_addr x == cabalMaintainerString -> Just x - _ -> Nothing) + (A.debInfo . D.control . S.maintainer) %= either (\e -> case parseMaintainer cabalAuthorString of + Right x | nameAddr_addr x == cabalMaintainerString -> Right x + Right _ -> Left e + Left x -> Left x) Right -- Sometimes the maintainer is just an email, try combining it with the author's name - (A.debInfo . D.control . S.maintainer) .?= (case parseMaintainer cabalAuthorString of - Right (NameAddr {nameAddr_name = Just name}) -> either (const Nothing) Just (parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">")) - _ -> Nothing) - (A.debInfo . D.control . S.maintainer) .?= currentUser - (A.debInfo . D.control . S.maintainer) .?= changelogSignature - x <- use (A.debInfo . D.control . S.maintainer) - when (isNothing x) - (do liftIO $ putStrLn ("Unable to construct a debian maintainer, using nobody . Cabal maintainer strings tried:\n " ++ - show cabalMaintainerString ++ ", " ++ show cabalMaintainerString' ++ ", " ++ show cabalMaintainerString'' ++ - ", currentUser: " ++ show currentUser) - return ()) - (A.debInfo . D.control . S.maintainer) .?= (either (const Nothing) Just $ parseMaintainer "nobody ") + (A.debInfo . D.control . S.maintainer) %= either (\e -> case parseMaintainer cabalAuthorString of + Right (NameAddr {nameAddr_name = Just name}) -> parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">") + Right _ -> Left e + Left x -> Left x) Right + (A.debInfo . D.control . S.maintainer) %= either (\e -> maybe (Left e) Right currentUser) Right + (A.debInfo . D.control . S.maintainer) %= either (\e -> maybe (Left e) Right changelogSignature) Right + (A.debInfo . D.control . S.maintainer) %= either (\_ -> Left ("Unable to construct a debian maintainer, using default. Cabal maintainer strings tried:\n " ++ + show cabalMaintainerString ++ ", " ++ show cabalMaintainerString' ++ ", " ++ show cabalMaintainerString'' ++ + ", currentUser: " ++ show currentUser)) Right (A.debInfo . D.control . S.uploaders) %= whenEmpty uploadersOption -- | If l is the empty list return d, otherwise return l. @@ -271,9 +271,9 @@ whenEmpty d [] = d whenEmpty _ l = l -finalizeControl :: (MonadIO m, Functor m) => CabalT m () -finalizeControl = - do finalizeMaintainer +finalizeControl :: (Monad m, Functor m) => Maybe NameAddr -> CabalT m () +finalizeControl currentUser = + do finalizeMaintainer currentUser Just src <- use (A.debInfo . D.sourcePackageName) (A.debInfo . D.control . S.source) .= Just src desc' <- describe @@ -284,19 +284,19 @@ -- source package name implied by the debianization. This means -- either adding an entry or modifying the latest entry (if its -- version number is the exact one in our debianization.) -finalizeChangelog :: (MonadIO m, Functor m) => String -> CabalT m () -finalizeChangelog date = - do finalizeMaintainer +finalizeChangelog :: (Monad m, Functor m) => String -> Maybe NameAddr -> CabalT m () +finalizeChangelog date currentUser = + do finalizeMaintainer currentUser ver <- debianVersion src <- use (A.debInfo . D.sourcePackageName) - Just debianMaintainer <- use (A.debInfo . D.control . S.maintainer) + debianMaintainer <- use (A.debInfo . D.control . S.maintainer) -- pkgDesc <- use T.packageDescription >>= return . maybe Nothing (either Nothing Just . parseMaintainer . Cabal.maintainer) cmts <- use (A.debInfo . D.comments) (A.debInfo . D.changelog) %= fmap (dropFutureEntries ver) let msg = "Initial release (Closes: #nnnn)" (A.debInfo . D.changelog) %= fixLog src ver cmts debianMaintainer msg where - fixLog :: Maybe SrcPkgName -> V.DebianVersion -> Maybe [[Text]] -> NameAddr -> Text -> Maybe ChangeLog -> Maybe ChangeLog + fixLog :: Maybe SrcPkgName -> V.DebianVersion -> Maybe [[Text]] -> Either String NameAddr -> Text -> Maybe ChangeLog -> Maybe ChangeLog -- Ensure that the package name is correct in the first log entry. fixLog src ver cmts _maint _ (Just (ChangeLog (entry : older))) | logVersion entry == ver = @@ -313,7 +313,7 @@ , logUrgency = "low" , logComments = List.unlines $ List.map ((" * " <>) . List.intercalate "\n " . List.map unpack) (fromMaybe [[msg]] cmts) - , logWho = ppShow maint + , logWho = either (\_ -> ppShow maintainerOfLastResort) ppShow maint , logDate = date } in -- Creating new log entry for version Just (ChangeLog (entry : maybe [] (\ (ChangeLog entries) -> entries) log)) @@ -357,7 +357,7 @@ , S.VCSDarcs $ "http://darcs.debian.org/pkg-haskell/" <> pack src ]) -putBuildDeps :: (MonadIO m, Functor m) => (Relations -> Relations) -> PackageDescription -> CabalT m () +putBuildDeps :: (Monad m, Functor m) => (Relations -> Relations) -> PackageDescription -> CabalT m () putBuildDeps finalizeRelations pkgDesc = do deps <- debianBuildDeps pkgDesc >>= return . finalizeRelations depsIndep <- debianBuildDepsIndep pkgDesc >>= return . finalizeRelations @@ -443,7 +443,7 @@ -- files, assign them to the packages returned by the -- utilsPackageNames lens, and make sure those packages are in the -- source deb description. -makeUtilsPackage :: forall m. (MonadIO m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () +makeUtilsPackage :: forall m. (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () makeUtilsPackage pkgDesc hc = do -- Files the cabal package expects to be installed -- Files that are already assigned to any binary deb @@ -504,7 +504,7 @@ (Nothing) -> D.execName i (Just s) -> s D.execName i -expandAtoms :: MonadIO m => CabalT m () +expandAtoms :: Monad m => CabalT m () expandAtoms = do hc <- use (A.debInfo . D.flags . compilerFlavor) case hc of diff --git a/src/Debian/Debianize/InputDebian.hs b/src/Debian/Debianize/InputDebian.hs --- a/src/Debian/Debianize/InputDebian.hs +++ b/src/Debian/Debianize/InputDebian.hs @@ -256,13 +256,13 @@ -- the path cabal assigns to datadir in the -- dist/build/autogen/Paths_packagename.hs module, or perhaps the path -- in the CABAL_DEBIAN_DATADIR environment variable. -dataDest :: MonadIO m => CabalT m FilePath +dataDest :: Monad m => CabalT m FilePath dataDest = do d <- use packageDescription return $ "usr/share" ((\ (PackageName x) -> x) $ pkgName $ Cabal.package d) -- | Where to look for the data-files -dataTop :: MonadIO m => CabalT m FilePath +dataTop :: Monad m => CabalT m FilePath dataTop = do d <- use packageDescription return $ case Cabal.dataDir d of diff --git a/src/Debian/Debianize/Monad.hs b/src/Debian/Debianize/Monad.hs --- a/src/Debian/Debianize/Monad.hs +++ b/src/Debian/Debianize/Monad.hs @@ -17,6 +17,7 @@ , DebianT , evalDebianT + , evalDebian , execDebianT , liftCabal @@ -57,6 +58,9 @@ evalDebianT :: Monad m => DebianT m a -> DebInfo -> m a evalDebianT = evalStateT + +evalDebian :: DebianT Identity a -> DebInfo -> a +evalDebian = evalState execDebianT :: Monad m => DebianT m () -> DebInfo -> m DebInfo execDebianT = execStateT diff --git a/src/Debian/Debianize/Optparse.hs b/src/Debian/Debianize/Optparse.hs --- a/src/Debian/Debianize/Optparse.hs +++ b/src/Debian/Debianize/Optparse.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} module Debian.Debianize.Optparse ( CommandLineOptions(..), BehaviorAdjustment, @@ -24,6 +25,7 @@ import Data.Maybe.Extended (nothingIf) import Data.Monoid ((<>)) import Debian.Debianize.BasicInfo +import Debian.Debianize.DebInfo (TestsStatus(..)) import Debian.Debianize.Monad import Debian.Debianize.Prelude (maybeRead) import Debian.Debianize.VersionSplits @@ -50,7 +52,6 @@ data HaddockStatus = HaddockEnabled | HaddockDisabled deriving Eq data ProfilingStatus = ProfilingEnabled | ProfilingDisabled deriving Eq data OfficialStatus = Official| NonOfficial deriving Eq -data TestsStatus = TestsDisable | TestsBuild | TestsRun newtype BuildDep = BuildDep Relations deriving Generic instance Newtype BuildDep newtype BuildDepIndep = BuildDepIndep Relations deriving Generic @@ -304,7 +305,7 @@ debianVersionP = O.option (Just . parseDebianVersion <$> O.str) m where m = O.help helpMsg <> O.long "deb-version" - <> O.metavar "VERSION" + <> O.metavar "DEBIANVERSION" <> O.value Nothing helpMsg = unlines [ "Specify the version number for the debian package.", @@ -316,7 +317,7 @@ m = O.help helpMsg <> O.long "revision" <> O.value Nothing - <> O.metavar "REVISION" + <> O.metavar "DEBIANREVISION" helpMsg = unlines [ "Add this string to the cabal version to get the debian version number.", "Debian policy says this must either be empty (--revision '')", @@ -329,7 +330,7 @@ <> O.long "source-package-name" <> O.short 's' <> O.value Nothing - <> O.metavar "NAME" + <> O.metavar "DEBIANNAME" helpMsg = 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", @@ -351,7 +352,7 @@ m = O.help helpMsg <> O.long "standards-version" <> O.value (parseStandardsVersion "3.9.6") - <> O.metavar "VERSION" + <> O.metavar "CABALVERSION" helpMsg = unlines [ "Claim compatibility to this version of the Debian policy", "(i.e. the value of the Standards-Version field)" @@ -361,7 +362,7 @@ buildDepP = many $ O.option (BuildDep <$> relationsR) m where m = O.help helpMsg <> O.long "build-dep" - <> O.metavar "RELATION" + <> O.metavar "DEBIANRELATIONS" helpMsg = unlines [ "Add a dependency relation to the `Build-Depends'", "field for this source package." @@ -371,7 +372,7 @@ buildDepIndepP = many $ O.option (BuildDepIndep <$> relationsR) m where m = O.help helpMsg <> O.long "build-dep-indep" - <> O.metavar "RELATION" + <> O.metavar "DEBIANRELATIONS" helpMsg = unlines [ "Add a dependency relation to the `Build-Depends-Indep'", "field for this source package." @@ -428,16 +429,18 @@ cabalDebMappingP = many $ O.option cabalDebMappingR m where m = O.help helpMsg <> O.long "dep-map" + <> O.metavar "CABAL:DEBIANBINARYPACKAGE" helpMsg = unlines [ "Specify what debian package name corresponds with a name that appears", "in the Extra-Library field of a cabal file,", - "e.g. --map-dep cryptopp=libcrypto-dev." + "e.g. --map-dep cryptopp:libcrypto-dev." ] execDebMappingP :: O.Parser [ExecDebMapping] execDebMappingP = many $ O.option (ExecDebMapping <$> mappingR) m where m = O.help helpMsg <> O.long "exec-map" + <> O.metavar "CABAL:DEBIANBINARYPACKAGE" helpMsg = unlines [ "Specify a mapping from the name appearing in the Build-Tool", "field of the cabal file to a debian binary package name,", @@ -448,7 +451,7 @@ cabalEpochMappingP = many $ O.option (cabalEpochMappingR) m where m = O.help helpMsg <> O.long "epoch-map" - <> O.metavar "PACKAGE=DIGIT" + <> O.metavar "CABALPACKAGE=DIGIT" helpMsg = unlines [ "Specify a mapping from the cabal package name to a digit to use", "as the debian package epoch number, e.g. --epoch-map HTTP=1" @@ -459,7 +462,7 @@ m = O.help helpMsg <> O.long "cabal-flags" <> O.long "cabal-flag" - <> O.metavar "NAME or -NAME" + <> O.metavar "CABALFLAG or -CABALFLAG" helpMsg = "Flags to pass to cabal configure with the --flags= option" @@ -538,7 +541,13 @@ ] ghcjsP :: O.Parser CompilerFlavor -ghcjsP = O.flag GHC GHCJS m where +ghcjsP = O.flag GHC +#if MIN_VERSION_Cabal(1,22,0) + GHCJS +#else + GHC +#endif + m where m = O.help helpMsg <> O.long "ghcjs" helpMsg = "Set compiler flavor to GHCJS." @@ -604,18 +613,7 @@ addExtra _extraReplaces B.replaces addExtra _extraRecommends B.recommends addExtra _extraSuggests B.suggests - case _tests of - -- FIXME: You can't run, but not build tests. It should be type-enforced. - TestsDisable -> do - D.enableTests .= False - D.runTests .= False - TestsBuild -> do - D.enableTests .= True - D.runTests .= False - TestsRun -> do - D.enableTests .= True - D.runTests .= True - + D.testsStatus .= _tests D.official .= (_official == Official) zoom D.control $ do S.section .= Just _sourceSection @@ -636,7 +634,4 @@ result = O.execParserPure prefs (commandLineOptionsParserInfo args) args parseProgramArguments :: IO CommandLineOptions -parseProgramArguments = defArgs >>= parseProgramArguments' - -defArgs :: IO [String] -defArgs = (++) <$> getArgs <*> (fromMaybe [] . (maybeRead =<<) <$> getEnv "CABALDEBIAN") +parseProgramArguments = getArgs >>= parseProgramArguments' 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 @@ -30,7 +30,7 @@ import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.InputDebian (inputDebianization) -import Debian.Debianize.Monad (DebianT, CabalT, evalDebianT, evalCabalT) +import Debian.Debianize.Monad (DebianT, CabalT, evalDebian, evalCabalT) import Debian.Debianize.Prelude (indent, replaceFile, zipMaps) import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Optparse @@ -38,7 +38,7 @@ import qualified Debian.Debianize.SourceDebDescription as S import Debian.Pretty (ppShow, ppPrint) import Prelude hiding (unlines, writeFile) -import System.Directory (createDirectoryIfMissing, doesFileExist, getPermissions, Permissions(executable), setPermissions) +import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, getPermissions, Permissions(executable), setPermissions) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeDirectory) import System.IO (hPutStrLn, stderr) @@ -56,26 +56,19 @@ -- in the debian subdirectory of this library. runDebianizeScript :: [String] -> IO Bool runDebianizeScript args = - -- getEnv "HOME" >>= \ home -> + getCurrentDirectory >>= \here -> doesFileExist "debian/Debianize.hs" >>= \ exists -> case exists of False -> return False True -> do let args' = ["debian/Debianize.hs"] ++ args - putEnvironmentArgs args - hPutStrLn stderr (showCommandForUser "runhaskell" args') + hPutStrLn stderr ("running external debianization script in " ++ show here ++ ":\n " ++ showCommandForUser "runhaskell" args') result <- readProcessWithExitCode "runhaskell" args' "" case result of (ExitSuccess, _, _) -> return True - (code, out, err) -> error ("runDebianizeScript: " ++ showCommandForUser "runhaskell" args' ++ " -> " ++ show code ++ + (code, out, err) -> error (" external debianization script failed:\n " ++ showCommandForUser "runhaskell" args' ++ " -> " ++ show code ++ "\n stdout: " ++ show out ++"\n stderr: " ++ show err) --- | Insert a value for CABALDEBIAN into the environment that the --- withEnvironment* functions above will find and use. E.g. --- putEnvironmentFlags ["--dry-run", "--validate"] (debianize defaultFlags) -putEnvironmentArgs :: [String] -> IO () -putEnvironmentArgs fs = setEnv "CABALDEBIAN" (show fs) True - -- | Perform whole debianization. You provide your customization, -- this function does everything else. performDebianization :: CabalT IO () -> IO () @@ -99,8 +92,8 @@ _ | view (D.flags . dryRun) new -> do inputDebianization old <- get - diff <- liftIO $ compareDebianization old new - liftIO $ putStrLn ("Debianization (dry run):\n" ++ if null diff then " No changes\n" else diff) + let diff = compareDebianization old new + liftIO $ putStrLn ("Debianization (dry run):\n" ++ if null diff then " No changes\n" else show diff) _ -> writeDebianization @@ -123,11 +116,11 @@ -- | Compare the old and new debianizations, returning a string -- describing the differences. -compareDebianization :: D.DebInfo -> D.DebInfo -> IO String +compareDebianization :: D.DebInfo -> D.DebInfo -> [String] compareDebianization old new = - do oldFiles <- evalDebianT debianizationFileMap (canonical old) - newFiles <- evalDebianT debianizationFileMap (canonical new) - return $ concat $ Map.elems $ zipMaps doFile oldFiles newFiles + let oldFiles = evalDebian debianizationFileMap (canonical old) + newFiles = evalDebian debianizationFileMap (canonical new) in + elems $ zipMaps doFile oldFiles newFiles where doFile :: FilePath -> Maybe Text -> Maybe Text -> Maybe String doFile path (Just _) Nothing = Just (path ++ ": Deleted\n") diff --git a/src/Debian/Debianize/Prelude.hs b/src/Debian/Debianize/Prelude.hs --- a/src/Debian/Debianize/Prelude.hs +++ b/src/Debian/Debianize/Prelude.hs @@ -37,6 +37,7 @@ , fromEmpty , fromSingleton , (.?=) + , escapeDebianWildcards ) where @@ -335,3 +336,9 @@ -- 2. Nothing happens if the current value isJust (.?=) :: Monad m => Lens' a (Maybe b) -> Maybe b -> StateT a m () l .?= mx = use l >>= assign l . maybe mx Just + +-- | This should probably be used in a lot of places. +escapeDebianWildcards :: String -> String +escapeDebianWildcards (c : more) | elem c "[]" = '\\' : c : escapeDebianWildcards more +escapeDebianWildcards (c : more) = c : escapeDebianWildcards more +escapeDebianWildcards "" = "" diff --git a/src/Debian/Debianize/SourceDebDescription.hs b/src/Debian/Debianize/SourceDebDescription.hs --- a/src/Debian/Debianize/SourceDebDescription.hs +++ b/src/Debian/Debianize/SourceDebDescription.hs @@ -44,7 +44,7 @@ = SourceDebDescription { _source :: Maybe SrcPkgName -- ^ - , _maintainer :: Maybe NameAddr + , _maintainer :: Either String NameAddr -- ^ , _changedBy :: Maybe NameAddr -- ^ @@ -85,7 +85,7 @@ newSourceDebDescription = SourceDebDescription { _source = Nothing - , _maintainer = Nothing + , _maintainer = Left "Maintainer not set" , _changedBy = Nothing , _uploaders = [] , _dmUploadAllowed = False @@ -106,7 +106,7 @@ newSourceDebDescription' src who = newSourceDebDescription { _source = Just src - , _maintainer = Just who } + , _maintainer = Right who } data VersionControlSpec = VCSBrowser Text diff --git a/src/Debian/Policy.hs b/src/Debian/Policy.hs --- a/src/Debian/Policy.hs +++ b/src/Debian/Policy.hs @@ -32,6 +32,7 @@ , Area(..) , parseUploaders , parseMaintainer + , maintainerOfLastResort , getCurrentDebianUser , haskellMaintainer , License(..) @@ -291,6 +292,12 @@ Right [y] -> Right y Right [] -> Left $ "Missing maintainer: " ++ show x Right ys -> Left $ "Too many maintainers: " ++ show ys + + +-- | Maintainer is a mandatory field, so we need a value we can use +-- when all else fails. +maintainerOfLastResort :: NameAddr +Right maintainerOfLastResort = parseMaintainer "nobody " -- | Official Debian license types as described in -- . diff --git a/test-data/artvaluereport2/input/debian/Debianize.hs b/test-data/artvaluereport2/input/debian/Debianize.hs --- a/test-data/artvaluereport2/input/debian/Debianize.hs +++ b/test-data/artvaluereport2/input/debian/Debianize.hs @@ -7,7 +7,8 @@ import Data.Set as Set (singleton, insert) import Data.Text as Text (intercalate) import Debian.Changes (ChangeLog(..)) -import Debian.Debianize -- (debianize, doBackups, doExecutable, doServer, doWebsite, inputChangeLog, inputDebianization, debianDefaultAtoms) +import Debian.Debianize +import Debian.Debianize.Finalize (debianize) import Debian.Debianize.Optparse (parseProgramArguments, CommandLineOptions(..)) import Debian.Pretty (ppShow) import Debian.Policy (databaseDirectory, PackageArchitectures(All), StandardsVersion(StandardsVersion)) @@ -26,7 +27,7 @@ old <- withCurrentDirectory "test-data/artvaluereport2/output" $ parseProgramArguments >>= \opts -> execDebianT inputDebianization (makeDebInfo (_flags opts)) -- The newest log entry gets modified when the Debianization is -- generated, it won't match so drop it for the comparison. - compareDebianization old ({-copyFirstLogEntry old $ -} view debInfo new) >>= putStr + putStr $ concat $ compareDebianization old $ view debInfo new where customize :: Maybe ChangeLog -> CabalT IO () customize log =