diff --git a/CabalDebian.hs b/CabalDebian.hs --- a/CabalDebian.hs +++ b/CabalDebian.hs @@ -16,16 +16,12 @@ 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 @@ -40,8 +36,8 @@ 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 (SubstVar debType) = substvars debType + finish Debianize = debianization (return ()) (return ()) >> doDebianizeAction 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: " diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -25,7 +25,7 @@ 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.Prelude ((%=), (+++=), (++=), (+=), (~=), withCurrentDirectory) import Debian.Debianize.Types as T import Debian.Debianize.Types.Atoms as T import qualified Debian.Debianize.Types.BinaryDebDescription as B @@ -213,10 +213,10 @@ test3 :: String -> Test test3 label = TestLabel label $ - TestCase (do let top = Top "test-data/haskell-devscripts" + TestCase (do let top = "test-data/haskell-devscripts" envset = EnvSet "/" "/" "/" atoms <- testAtoms - deb <- execDebT (inputDebianization top envset) atoms + deb <- withCurrentDirectory top (execDebT (inputDebianization envset) atoms) diff <- diffDebianizations (testDeb2 atoms) deb assertEqual label [] diff) where @@ -374,13 +374,13 @@ 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" + TestCase (do let inTop = "test-data/clckwrks-dot-com/input" + outTop = "test-data/clckwrks-dot-com/output" envset = EnvSet "/" "/" "/" atoms <- testAtoms - old <- execDebT (inputDebianization outTop envset) atoms + old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms) let log = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms (customize log)) atoms + new <- withCurrentDirectory inTop (execDebT (debianization defaultAtoms (customize log)) atoms) diff <- diffDebianizations old ({-copyFirstLogEntry old-} new) assertEqual label [] diff) where @@ -486,14 +486,14 @@ test5 :: String -> Test test5 label = TestLabel label $ - TestCase (do let inTop = (Top "test-data/creativeprompts/input") - outTop = (Top "test-data/creativeprompts/output") + TestCase (do let inTop = "test-data/creativeprompts/input" + outTop = "test-data/creativeprompts/output" envset = EnvSet "/" "/" "/" atoms <- testAtoms - old <- execDebT (inputDebianization outTop envset) atoms + old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms) let standards = getL T.standardsVersion old level = getL T.compat old - new <- execDebT (debianization inTop defaultAtoms (customize old level standards)) atoms + new <- withCurrentDirectory inTop (execDebT (debianization defaultAtoms (customize old level standards)) atoms) diff <- diffDebianizations old new assertEqual label [] diff) where @@ -584,13 +584,13 @@ test8 :: String -> Test test8 label = TestLabel label $ - TestCase ( do let inTop = Top "test-data/artvaluereport-data/input" - outTop = Top "test-data/artvaluereport-data/output" + TestCase ( do let inTop = "test-data/artvaluereport-data/input" + outTop = "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 + old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms) + log <- withCurrentDirectory inTop (evalDebT (inputChangeLog >> access T.changelog) atoms) + new <- withCurrentDirectory inTop (execDebT (debianization defaultAtoms (customize log)) atoms) diff <- diffDebianizations old new assertEqual label [] diff ) @@ -606,13 +606,13 @@ test9 :: String -> Test test9 label = TestLabel label $ - TestCase (do let inTop = Top "test-data/alex/input" - outTop = Top "test-data/alex/output" + TestCase (do let inTop = "test-data/alex/input" + outTop = "test-data/alex/output" envset = EnvSet "/" "/" "/" atoms <- testAtoms - old <- execDebT (inputDebianization outTop envset) atoms + old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms) let Just (ChangeLog (entry : _)) = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms + new <- withCurrentDirectory inTop (execDebT (debianization defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms) diff <- diffDebianizations old new assertEqual label [] diff) where @@ -644,13 +644,13 @@ test10 :: String -> Test test10 label = TestLabel label $ - TestCase (do let inTop = Top "test-data/archive/input" - outTop = Top "test-data/archive/output" + TestCase (do let inTop = "test-data/archive/input" + outTop = "test-data/archive/output" envset = EnvSet "/" "/" "/" atoms <- testAtoms - old <- execDebT (inputDebianization outTop envset) atoms + old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms) let Just (ChangeLog (entry : _)) = getL T.changelog old - new <- execDebT (debianization inTop defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms + new <- withCurrentDirectory inTop (execDebT (debianization defaultAtoms customize >> copyChangelogDate (logDate entry)) atoms) diff <- diffDebianizations old new assertEqual label [] diff) where diff --git a/cabal-debian.cabal b/cabal-debian.cabal --- a/cabal-debian.cabal +++ b/cabal-debian.cabal @@ -1,11 +1,11 @@ Name: cabal-debian -Version: 4.11 +Version: 4.15 License: BSD3 License-File: debian/copyright Author: David Fox Category: Debian, Distribution, System Maintainer: David Fox -Homepage: http://src.seereason.com/debian-tools/cabal-debian +Homepage: http://src.seereason.com/cabal-debian Build-Type: Simple Synopsis: Create a debianization for a cabal package Cabal-Version: >= 1.8 @@ -140,6 +140,10 @@ Default: False Manual: True +Flag ghcjs-support + Description: Pulls in Cabal-1.21, which includes support for the ghcjs compiler. + Default: True + -- flag local-debian -- Description: Link directly to the source of the debian library -- Default: False @@ -147,14 +151,13 @@ Source-Repository head type: darcs - location: http://src.seereason.com/debian-tools + location: http://src.seereason.com/cabal-debian Library Hs-Source-Dirs: src GHC-Options: -Wall -O2 Build-Depends: base < 5, - Cabal >= 1.9, containers, data-lens, data-lens-template, @@ -176,6 +179,10 @@ unix, Unixutils, utf8-string + if flag(ghcjs-support) + Build-Depends: Cabal >= 1.21 + else + Build-Depends: Cabal >= 1.9 Exposed-Modules: Data.Algorithm.Diff.Context Data.Algorithm.Diff.Pretty @@ -215,10 +222,18 @@ Hs-Source-Dirs: . Main-is: CabalDebian.hs ghc-options: -threaded -Wall -O2 - Build-Depends: base, Cabal, cabal-debian, data-lens, mtl + Build-Depends: base, cabal-debian, data-lens, mtl + if flag(ghcjs-support) + Build-Depends: Cabal >= 1.21 + else + Build-Depends: Cabal >= 1.9 Executable cabal-debian-tests Hs-Source-Dirs: . Main-is: Tests.hs ghc-options: -threaded -Wall -O2 - Build-Depends: base, Cabal, cabal-debian, containers, data-lens, debian, filepath, hsemail, HUnit, process, text + Build-Depends: base, cabal-debian, containers, data-lens, debian, filepath, hsemail, HUnit, process, text + if flag(ghcjs-support) + Build-Depends: Cabal >= 1.21 + else + Build-Depends: Cabal >= 1.9 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,40 @@ +haskell-cabal-debian (4.15) unstable; urgency=low + + * Don't hardcode the compiler name in makefile targets. + + -- David Fox Sat, 12 Jul 2014 12:15:10 -0700 + +haskell-cabal-debian (4.14) unstable; urgency=low + + * Map package name Cabal to debian package name cabal. + + -- David Fox Sat, 05 Jul 2014 20:27:21 -0700 + +haskell-cabal-debian (4.14) unstable; urgency=low + + * Map package name Cabal to debian package name cabal. + + -- David Fox Sat, 05 Jul 2014 20:27:21 -0700 + +haskell-cabal-debian (4.13) unstable; urgency=low + + * Add a flag for ghcjs support. + + -- David Fox Thu, 03 Jul 2014 12:05:21 -0700 + +haskell-cabal-debian (4.12) unstable; urgency=low + + * Remove the Top type and argument - use getWorkingDirectory instead. + + -- David Fox Sun, 29 Jun 2014 08:11:01 -0700 + +haskell-cabal-debian (4.11) unstable; urgency=low + + * Use MonadIO instead of IO for all signatures. This is so + we can more easily use cabal debian from a Shelly script. + + -- David Fox Sun, 29 Jun 2014 07:16:45 -0700 + haskell-cabal-debian (4.10.1) unstable; urgency=low * Fix a tail exception in builtIn. @@ -872,4 +909,3 @@ * Debianization generated by cabal-debian -- David Fox Sun, 18 Sep 2011 06:40:21 -0700 - 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 @@ -1,5 +1,5 @@ -- | Compute the debianization of a cabal package. -{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-} module Debian.Debianize.BuildDependencies ( debianBuildDeps , debianBuildDepsIndep @@ -23,10 +23,14 @@ 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, checkVersionReq) +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) +#if MIN_VERSION_Cabal(1,21,0) +import Distribution.Compiler (CompilerFlavor(GHC, GHCJS)) +#else import Distribution.Compiler (CompilerFlavor(GHC)) +#endif import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..)) @@ -85,11 +89,15 @@ 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 && cfl == GHC then [anyrel "ghc-prof"] else []) ++ - cDeps + anyrel "cdbs"] ++ + (case cfl of + GHC -> [anyrel "ghc"] ++ if prof then [anyrel "ghc-prof"] else [] +#if MIN_VERSION_Cabal(1,21,0) + GHCJS -> [anyrel "ghcjs"] +#endif + x -> error ("Unsupported compiler flavor: " ++ show x)) ++ + bDeps ++ + cDeps filterMissing xs where cabalDeps = @@ -281,20 +289,31 @@ 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 []) ++ + 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 (which, if pver is Nothing, will certainly + -- result in an error which needs to be corrected in + -- the packaging.) + (if isJust pver && (checkVersionReq req pver || (dname == naiveDebianName && conflictsWithHC 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 []) + -- compiler doesn't conflict with the package's + -- debian name. + (if isNothing pver || dname /= naiveDebianName || not (conflictsWithHC 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 + + -- FIXME: we are assuming here that ghc conflicts with all the + -- library packages it provides but it no longer conflicts with + -- libghc-cabal-dev. We can now check these conflicts using the + -- new functions in Bundled. + conflictsWithHC (BinPkgName "libghc-cabal-dev") = False + conflictsWithHC (BinPkgName "libghc-cabal-prof") = False + conflictsWithHC (BinPkgName "libghc-cabal-doc") = False + conflictsWithHC _ = True {- doBundled :: MonadIO m => 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 @@ -4,23 +4,28 @@ {-# LANGUAGE CPP, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} module Debian.Debianize.Bundled ( builtIn + -- * Utilities + , aptCacheShowPkg + , aptCacheProvides + , aptCacheDepends + , aptCacheConflicts + , aptVersions ) where -import Control.Applicative ((<$>)) import Control.DeepSeq (force) import Control.Exception (try, SomeException) import Data.Char (toLower) import Data.Function (on) -import Data.Function.Memoize (memoize2) +import Data.Function.Memoize (memoize2, memoize3) 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 (BinPkgName(..), parseRelations) import Debian.Relation.ByteString() -import Debian.Version (DebianVersion, parseDebianVersion) +import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion) import Distribution.Simple.Compiler (CompilerFlavor(..), {-PackageDB(GlobalPackageDB), compilerFlavor-}) import Distribution.Package (PackageIdentifier(..), PackageName(..) {-, Dependency(..)-}) import System.IO.Unsafe (unsafePerformIO) @@ -37,7 +42,7 @@ -- 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 + f $ builtIn' splits hc root where f :: (DebianVersion, [PackageIdentifier]) -> Maybe Version f (hcv, ids) = case map pkgVersion (filter (\ i -> pkgName i == lib) ids) of @@ -47,21 +52,15 @@ -- | 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' :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> (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 + -- Find out what library versions are provided by the latest version + -- of the compiler. + case aptCacheProvides root hcname of [] -> error $ "No versions of " ++ show hc ++ " (" ++ show hcname ++ ") in " ++ show root - ((v, pids) : _) -> return (v, pids) + ((v, pids) : _) -> (v, mapMaybe (parsePackageID . unBinPkgName) 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. @@ -69,13 +68,49 @@ -- 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 + 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 + +aptCacheShowPkg :: FilePath -> String -> Either SomeException String +aptCacheShowPkg = + memoize2 (\ root hcname -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["showpkg", hcname] "")))) + where chroot "/" = id - chroot _ = useEnv root (return . force) + chroot root = useEnv root (return . force) + +aptCacheProvides :: FilePath -> String -> [(DebianVersion, [BinPkgName])] +aptCacheProvides root hcname = + let lns = lines . either (\ (e :: SomeException) -> error $ "builtIn: " ++ show e) id $ aptCacheShowPkg root hcname + hcs = map words $ takeBetween (isPrefixOf "Provides:") (isPrefixOf "Reverse Provides:") lns + hcs' = reverse . sortBy (compare `on` fst) . map doHCVersion $ hcs in + hcs' + where + doHCVersion :: [String] -> (DebianVersion, [BinPkgName]) + doHCVersion (versionString : "-" : deps) = (parseDebianVersion versionString, map BinPkgName deps) + doHCVersion x = error $ "Unexpected output from apt-cache: " ++ show x + +aptCacheDepends :: FilePath -> String -> String -> Either SomeException String +aptCacheDepends = + memoize3 (\ root hcname ver -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["depends", hcname ++ "=" ++ ver] "")))) + where + chroot "/" = id + chroot root = useEnv root (return . force) + +aptCacheConflicts :: FilePath -> String -> DebianVersion -> [BinPkgName] +aptCacheConflicts root hcname ver = + either (\ _ -> []) (mapMaybe doLine . lines) (aptCacheDepends root hcname (show (prettyDebianVersion ver))) + where + doLine s = case s =~ "^[ ]*Conflicts:[ ]*<(.*)>$" :: (String, String, String, [String]) of + (_, _, _, [name]) -> Just (BinPkgName name) + _ -> Nothing + +aptVersions :: FilePath -> String -> [DebianVersion] +aptVersions root hcname = + either (\ _ -> []) (map parseDebianVersion . filter (/= "") . map (takeWhile (/= ' ')) . takeWhile (not . isPrefixOf "Reverse Depends:") . drop 1 . dropWhile (not . isPrefixOf "Versions:") . lines) (aptCacheShowPkg root hcname) takeBetween :: (a -> Bool) -> (a -> Bool) -> [a] -> [a] takeBetween startPred endPred = takeWhile (not . endPred) . dropWhile startPred . dropWhile (not . startPred) 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 @@ -19,6 +19,7 @@ debianDefaultAtoms = do T.epochMap ++= (PackageName "HaXml", 1) T.epochMap ++= (PackageName "HTTP", 1) + mapCabal (PackageName "Cabal") (DebBase "cabal") mapCabal (PackageName "parsec") (DebBase "parsec3") splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] []) mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2") 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 @@ -30,7 +30,6 @@ import Debian.Debianize.Monad as Monad (DebT) 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, 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)) @@ -55,12 +54,12 @@ -- 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 :: (MonadIO m, Functor m) => Top -> DebT m () -> DebT m () -> DebT m () -debianization top init customize = +debianization :: (MonadIO m, Functor m) => DebT m () -> DebT m () -> DebT m () +debianization init customize = do compileEnvironmentArgs compileCommandlineArgs - inputCabalization top - inputChangeLog top + inputCabalization + inputChangeLog inputMaintainer init customize @@ -338,7 +337,7 @@ -- If any files belong in the utils packages, make sure they exist when (not (Set.null utilsData && Set.null utilsExec)) (Set.mapM_ (\ p -> do -- This is really for all binary debs except the libraries - I'm not sure why - T.rulesFragments += (pack ("build" show (pretty p) ++ ":: build-ghc-stamp")) + T.rulesFragments += (pack ("build" show (pretty p) ++ ":: build-$(HC)-stamp")) T.binaryArchitectures p ~?= Just (if Set.null utilsExec then All else Any) T.binarySection p ~?= Just (MainSection "misc") binaryPackageRelations p B.Utilities) utilsPackages) 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 @@ -335,7 +335,7 @@ -- FIXME - use Atoms execAtoms :: BinPkgName -> T.InstallFile -> Atoms -> Atoms execAtoms b ifile r = - modL T.rulesFragments (Set.insert (pack ("build" show (pretty b) ++ ":: build-ghc-stamp"))) . + modL T.rulesFragments (Set.insert (pack ("build" show (pretty b) ++ ":: build-$(HC)-stamp"))) . fileAtoms b ifile $ r 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 @@ -39,8 +39,7 @@ license, licenseFile, copyright, changelog, installInit, postInst, postRm, preInst, preRm, 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)) +import Debian.Debianize.Prelude (getDirectoryContents', readFileMaybe, read', intToVerbosity', (~=), (~?=), (+=), (++=), (+++=)) import Debian.Debianize.Types.Atoms (EnvSet(dependOS)) import Debian.GHC (newestAvailableCompilerId) import Debian.Orphans () @@ -64,7 +63,7 @@ import Distribution.Verbosity (Verbosity) import Prelude hiding (readFile, lines, words, break, null, log, sum, (.)) -- import qualified Prelude (lines) -import System.Directory (doesFileExist) +import System.Directory (doesFileExist, getCurrentDirectory) import System.Exit (ExitCode(..)) import System.FilePath ((), takeExtension, dropExtension) import System.Posix.Files (setFileCreationMask) @@ -73,25 +72,25 @@ -- import System.Unix.Chroot (useEnv) -- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) -inputDebianization :: MonadIO m => Top -> EnvSet -> DebT m () -inputDebianization top envset = +inputDebianization :: MonadIO m => EnvSet -> DebT m () +inputDebianization envset = do -- Erase any the existing information hc <- access T.compilerFlavor let atoms = T.makeAtoms hc envset put atoms - (ctl, _) <- inputSourceDebDescription top - inputAtomsFromDirectory top + (ctl, _) <- inputSourceDebDescription + inputAtomsFromDirectory control ~= ctl -- | Try to input a file and if successful add it to the debianization. -inputDebianizationFile :: MonadIO m => Top -> FilePath -> DebT m () -inputDebianizationFile top path = - do inputAtomsFromDirectory top - liftIO (readFileMaybe (unTop top path)) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text)) +inputDebianizationFile :: MonadIO m => FilePath -> DebT m () +inputDebianizationFile path = + do inputAtomsFromDirectory + liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text)) -inputSourceDebDescription :: MonadIO m => Top -> DebT m (S.SourceDebDescription, [Field]) -inputSourceDebDescription top = - do paras <- liftIO $ parseControlFromFile (unTop top "debian/control") >>= either (error . show) (return . unControl) +inputSourceDebDescription :: MonadIO m => DebT m (S.SourceDebDescription, [Field]) +inputSourceDebDescription = + do paras <- liftIO $ parseControlFromFile "debian/control" >>= either (error . show) (return . unControl) case paras of [] -> error "Missing source paragraph" [_] -> error "Missing binary paragraph" @@ -195,24 +194,24 @@ yes "no" = False yes x = error $ "Expecting yes or no: " ++ x -inputChangeLog :: MonadIO m => Top -> DebT m () -inputChangeLog top = - do log <- liftIO $ tryIOError (readFile (unTop top "debian/changelog") >>= return . parseChangeLog . unpack) +inputChangeLog :: MonadIO m => DebT m () +inputChangeLog = + do log <- liftIO $ tryIOError (readFile "debian/changelog" >>= return . parseChangeLog . unpack) changelog ~?= either (\ _ -> Nothing) Just log -inputAtomsFromDirectory :: MonadIO m => Top -> DebT m () -- .install files, .init files, etc. -inputAtomsFromDirectory top = +inputAtomsFromDirectory :: MonadIO m => DebT m () -- .install files, .init files, etc. +inputAtomsFromDirectory = do findFiles - doFiles (unTop top "debian/cabalInstall") + doFiles ("./debian/cabalInstall") where -- Find regular files in the debian/ or in debian/source/format/ and -- add them to the debianization. findFiles :: MonadIO m => DebT m () findFiles = - liftIO (getDirectoryContents' (unTop top "debian")) >>= + liftIO (getDirectoryContents' ("debian")) >>= return . (++ ["source/format"]) >>= - liftIO . filterM (doesFileExist . ((unTop top "debian") )) >>= \ names -> - mapM_ (inputAtoms (unTop top "debian")) names + liftIO . filterM (doesFileExist . (("debian") )) >>= \ names -> + mapM_ (inputAtoms ("debian")) names doFiles :: MonadIO m => FilePath -> DebT m () doFiles tmp = do sums <- liftIO $ getDirectoryContents' tmp `catchIOError` (\ _ -> return []) @@ -273,15 +272,16 @@ readDir :: Monad m => BinPkgName -> Text -> DebT m () readDir p line = installDir +++= (p, singleton (unpack line)) -inputCabalization :: (MonadIO m, Functor m) => Top -> DebT m () -inputCabalization top = +inputCabalization :: (MonadIO m, Functor m) => DebT m () +inputCabalization = do hc <- access T.compilerFlavor vb <- access verbosity >>= return . intToVerbosity' flags <- access cabalFlagAssignments 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) + ePkgDesc <- liftIO $ inputCabalization' vb flags mcid + either (\ deps -> liftIO getCurrentDirectory >>= \ here -> + error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps) (\ pkgDesc -> do packageDescription ~= Just pkgDesc -- This will contain either the contents of the file given in @@ -291,11 +291,11 @@ #if MIN_VERSION_Cabal(1,19,0) licenseFileText <- liftIO $ case Cabal.licenseFiles pkgDesc of [] -> return Nothing - (path : _) -> readFileMaybe (unTop top path) -- better than nothing + (path : _) -> readFileMaybe path -- better than nothing #else licenseFileText <- liftIO $ case Cabal.licenseFile pkgDesc of "" -> return Nothing - path -> readFileMaybe (unTop top path) + path -> readFileMaybe path #endif licenseFile ~?= licenseFileText copyright ~?= (case Cabal.copyright pkgDesc of @@ -303,9 +303,8 @@ s -> Just (pack s))) ePkgDesc -inputCabalization' :: Top -> Verbosity -> Set (FlagName, Bool) -> CompilerId -> IO (Either [Dependency] PackageDescription) -inputCabalization' top vb flags cid = - withCurrentDirectory (unTop top) $ do +inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> CompilerId -> IO (Either [Dependency] PackageDescription) +inputCabalization' vb flags cid = do descPath <- defaultPackageDesc vb genPkgDesc <- readPackageDescription vb descPath case finalizePackageDescription (toList flags) (const True) (Platform buildArch buildOS) cid [] genPkgDesc of 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 @@ -25,13 +25,12 @@ import Data.Maybe (fromMaybe) 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) import Debian.Debianize.Options (putEnvironmentArgs) -import Debian.Debianize.Prelude (indent, replaceFile, withCurrentDirectory, zipMaps) +import Debian.Debianize.Prelude (indent, replaceFile, zipMaps) import qualified Debian.Debianize.Types as T import qualified Debian.Debianize.Types.BinaryDebDescription as B (package) import qualified Debian.Debianize.Types.SourceDebDescription as S (source) @@ -70,27 +69,27 @@ -- | Depending on the options in @atoms@, either validate, describe, -- or write the generated debianization. -doDebianizeAction :: (MonadIO m, Functor m) => Top -> EnvSet -> DebT m () -doDebianizeAction top envset = +doDebianizeAction :: (MonadIO m, Functor m) => EnvSet -> DebT m () +doDebianizeAction envset = do new <- get case () of _ | getL T.validate new -> - do inputDebianization top envset + do inputDebianization envset old <- get return $ validateDebianization old new _ | getL T.dryRun new -> - do inputDebianization top envset + do inputDebianization envset old <- get diff <- liftIO $ compareDebianization old new liftIO $ putStr ("Debianization (dry run):\n" ++ diff) - _ -> writeDebianization top + _ -> writeDebianization --- | Write the files of the debianization @d@ to the directory @top@. -writeDebianization :: (MonadIO m, Functor m) => Top -> DebT m () -writeDebianization top = +-- | Write the files of the debianization @d@ to ./debian +writeDebianization :: (MonadIO m, Functor m) => DebT m () +writeDebianization = do files <- debianizationFileMap - 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}) + liftIO $ mapM_ (uncurry doFile) (Map.toList files) + liftIO $ getPermissions "debian/rules" >>= setPermissions "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 @@ -24,7 +24,6 @@ import Debian.Debianize.Input (inputCabalization) import Debian.Debianize.Monad (DebT) import Debian.Debianize.Prelude ((!), buildDebVersionMap, cond, DebMap, debOfFile, diffFile, dpkgFileMap, replaceFile, showDeps, modifyM) -import Debian.Debianize.Types (Top) import qualified Debian.Debianize.Types.Atoms as T import Debian.Orphans () import Debian.Pretty (pretty) @@ -60,11 +59,10 @@ -- these we can determine the source package name, and from that the -- documentation package name. substvars :: (MonadIO m, Functor m) => - Top - -> T.DebType -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc + T.DebType -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc -> DebT m () -substvars top debType = - do inputCabalization top +substvars debType = + do inputCabalization debVersions <- liftIO buildDebVersionMap modifyM (liftIO . libPaths debVersions) control <- liftIO $ readFile "debian/control" >>= either (error . show) return . parseControl "debian/control" 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 @@ -1,8 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} module Debian.Debianize.Types - ( Top(..) + ( -- * Modes of operation - , verbosity + verbosity , dryRun , debAction , cabalFlagAssignments @@ -116,7 +116,6 @@ ) where import Control.Category ((.)) -import Data.Generics (Typeable) import Data.Lens.Lazy (Lens, iso, getL) import Data.Set as Set (Set) import Data.Text (Text) @@ -130,11 +129,6 @@ import Prelude hiding (init, init, log, log, unlines, (.)) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr) --- | This is a special filepath that represents the top of a directory --- tree. For a cabal package this directory would contain the .cabal --- file, for a debian package it would contain the debian directory. -newtype Top = Top {unTop :: FilePath} deriving (Eq, Ord, Show, Typeable) - -- | Not exported - binaryDebDescription :: BinPkgName -> Lens Atoms B.BinaryDebDescription binaryDebDescription b = maybeLens (B.newBinaryDebDescription b) (iso id id) . listElemLens ((== b) . getL B.package) . S.binaryPackages . control @@ -153,8 +147,8 @@ essential b = B.essential . binaryDebDescription b -- | -relations :: BinPkgName -> Lens Atoms B.PackageRelations -relations b = B.relations . binaryDebDescription b +-- relations :: BinPkgName -> Lens Atoms B.PackageRelations +-- relations b = B.relations . binaryDebDescription b -- | The Depends: relations for each binary deb - depends :: BinPkgName -> Lens Atoms Relations diff --git a/test-data/alex/output/debian/rules b/test-data/alex/output/debian/rules --- a/test-data/alex/output/debian/rules +++ b/test-data/alex/output/debian/rules @@ -1,6 +1,7 @@ #!/usr/bin/make -f DEB_CABAL_PACKAGE = alex +HC = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk diff --git a/test-data/archive/output/debian/rules b/test-data/archive/output/debian/rules --- a/test-data/archive/output/debian/rules +++ b/test-data/archive/output/debian/rules @@ -1,6 +1,7 @@ #!/usr/bin/make -f DEB_CABAL_PACKAGE = seereason-darcs-backups +HC = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk diff --git a/test-data/artvaluereport-data/output/debian/rules b/test-data/artvaluereport-data/output/debian/rules --- a/test-data/artvaluereport-data/output/debian/rules +++ b/test-data/artvaluereport-data/output/debian/rules @@ -1,6 +1,7 @@ #!/usr/bin/make -f DEB_CABAL_PACKAGE = artvaluereport-data +HC = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk diff --git a/test-data/clckwrks-dot-com/output/debian/rules b/test-data/clckwrks-dot-com/output/debian/rules --- a/test-data/clckwrks-dot-com/output/debian/rules +++ b/test-data/clckwrks-dot-com/output/debian/rules @@ -1,6 +1,7 @@ #!/usr/bin/make -f DEB_CABAL_PACKAGE = clckwrks-dot-com +HC = ghc DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups diff --git a/test-data/creativeprompts/output/debian/rules b/test-data/creativeprompts/output/debian/rules --- a/test-data/creativeprompts/output/debian/rules +++ b/test-data/creativeprompts/output/debian/rules @@ -1,6 +1,7 @@ #!/usr/bin/make -f DEB_CABAL_PACKAGE = creativeprompts +HC = ghc include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk