cabal-debian 4.36.2 → 4.38
raw patch · 7 files changed
+212/−167 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Debian.Debianize.Goodies: describe :: Monad m => CabalT m Text
- Debian.Debianize.Goodies: watchAtom :: PackageName -> Text
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.BuildDep
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.BuildDepIndep
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.CabalDebMapping
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.CabalEpochMapping
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.CabalFlagMapping
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.DevDep
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExecDebMapping
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraConflicts
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraDepends
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraProvides
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraRecommends
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraReplaces
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.ExtraSuggests
- Debian.Debianize.Optparse: instance Control.Newtype.Newtype Debian.Debianize.Optparse.Revision
+ Debian.Debianize.ExecAtoms: execAtoms :: BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
+ Debian.Debianize.Finalize: debianizeWebsite :: (MonadIO m, Functor m) => CabalT m () -> CabalT m ()
+ Debian.Debianize.Finalize: debianizeWith :: (MonadIO m, Functor m) => CabalT m () -> CabalT m () -> CabalT m ()
+ Debian.Debianize.Finalize: watchAtom :: PackageName -> Text
+ Debian.Debianize.Goodies: expandBackups :: Monad m => CabalT m ()
+ Debian.Debianize.Goodies: expandServer :: Monad m => CabalT m ()
+ Debian.Debianize.Goodies: expandWebsite :: Monad m => CabalT m ()
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.BuildDep
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.BuildDepIndep
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.CabalDebMapping
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.CabalEpochMapping
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.CabalFlagMapping
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.DevDep
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExecDebMapping
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraConflicts
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraDepends
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraProvides
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraRecommends
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraReplaces
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.ExtraSuggests
+ Debian.Debianize.Optparse: instance Control.Newtype.Generics.Newtype Debian.Debianize.Optparse.Revision
+ Debian.Debianize.Output: performDebianizationOfWebsite :: CabalT IO () -> IO ()
+ Debian.Debianize.Output: performDebianizationWith :: CabalT IO () -> CabalT IO () -> IO ()
Files
- CabalDebian.hs +2/−2
- cabal-debian.cabal +2/−1
- src/Debian/Debianize/BuildDependencies.hs +17/−19
- src/Debian/Debianize/ExecAtoms.hs +43/−0
- src/Debian/Debianize/Finalize.hs +111/−35
- src/Debian/Debianize/Goodies.hs +25/−107
- src/Debian/Debianize/Output.hs +12/−3
CabalDebian.hs view
@@ -1,5 +1,5 @@ import Debian.Debianize.Details (debianDefaults)-import Debian.Debianize.Output (performDebianization)+import Debian.Debianize.Output (performDebianizationOfWebsite) main :: IO ()-main = performDebianization debianDefaults+main = performDebianizationOfWebsite debianDefaults
cabal-debian.cabal view
@@ -1,5 +1,5 @@ Name: cabal-debian-Version: 4.36.2+Version: 4.38 Copyright: Copyright (c) 2007-2014, David Fox, Jeremy Shaw License: BSD3 License-File: LICENSE@@ -205,6 +205,7 @@ Debian.Debianize.DebianName Debian.Debianize.DebInfo Debian.Debianize.Details+ Debian.Debianize.ExecAtoms Debian.Debianize.Files Debian.Debianize.Finalize Debian.Debianize.Goodies
src/Debian/Debianize/BuildDependencies.hs view
@@ -123,15 +123,9 @@ debianBuildDeps pkgDesc = do hflavor <- use (A.debInfo . D.flags . compilerFlavor) let hcs = singleton hflavor -- vestigial- let hcTypePairsLibs =- fold union empty $- Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesLibs hc') hcs- let hcTypePairsBins =- fold union empty $- Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesBins hc') hcs- let hcTypePairsTests =+ let hcTypePairs = fold union empty $- Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypesTests hc') hcs+ Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypes hc') hcs libDeps <- allBuildDepends (maybe [] (return . libBuildInfo) (Cabal.library pkgDesc)) binDeps <- allBuildDepends (List.map buildInfo (Cabal.executables pkgDesc))@@ -145,9 +139,9 @@ testsStatus <- use (A.debInfo . D.testsStatus) cDeps <- nub . concat . concat <$> sequence- [ mapM (buildDependencies hcTypePairsLibs) libDeps- , mapM (buildDependencies hcTypePairsBins) binDeps- , mapM (buildDependencies hcTypePairsTests) (if testsStatus /= D.TestsDisable then testDeps else [])+ [ mapM (buildDependencies hcTypePairs) libDeps+ , mapM (buildDependencies hcTypePairs) binDeps+ , mapM (buildDependencies hcTypePairs) (if testsStatus /= D.TestsDisable then testDeps else []) ] bDeps <- use (A.debInfo . D.control . S.buildDepends)@@ -172,20 +166,24 @@ cDeps filterMissing xs where- hcPackageTypesLibs :: CompilerFlavor -> Set B.PackageType- hcPackageTypesLibs GHC = fromList [B.Development, B.Profiling]+ hcPackageTypes :: CompilerFlavor -> Set B.PackageType+ hcPackageTypes GHC = fromList [B.Development, B.Profiling] #if MIN_VERSION_Cabal(1,22,0)- hcPackageTypesLibs GHCJS = fromList [B.Development]+ hcPackageTypes GHCJS = fromList [B.Development] #endif- hcPackageTypesLibs hc = error $ "Unsupported compiler flavor: " ++ show hc+ hcPackageTypes hc = error $ "Unsupported compiler flavor: " ++ show hc - -- No point in installing profiling packages for the dependencies- -- of binaries and test suites+ -- No point in installing profiling packages for the+ -- dependencies of binaries and test suites. (I take it back,+ -- some executable builds fail if the profiling library isn't+ -- installed.)+#if 0 hcPackageTypesBins :: CompilerFlavor -> Set B.PackageType- hcPackageTypesBins _ = singleton B.Development+ hcPackageTypesBins GHC = singleton [B.Development, B.Profiling] hcPackageTypesTests :: CompilerFlavor -> Set B.PackageType- hcPackageTypesTests _ = singleton B.Development+ hcPackageTypesTests GHC = singleton [B.Development, B.Profiling]+#endif -- | Collect the dependencies required to build any packages that have -- architecture "all".
+ src/Debian/Debianize/ExecAtoms.hs view
@@ -0,0 +1,43 @@+-- | Things that seem like they could be clients of this library, but+-- are instead included as part of the library.+{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings #-}+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -ddump-minimal-imports #-}+module Debian.Debianize.ExecAtoms+ ( execAtoms+ ) where++import Control.Lens ( over, (%=) )+import Data.Maybe ( fromMaybe )+import Data.Set as Set ( insert )+import Data.Text as Text ( pack )+import qualified Debian.Debianize.DebInfo as D+ ( InstallFile(destName, destDir, execName, sourceDir),+ Atom(InstallTo, InstallCabalExecTo, Install, InstallCabalExec),+ rulesFragments,+ atomSet )+import Debian.Debianize.Monad ( CabalInfo, execCabalM )+import qualified Debian.Debianize.CabalInfo as A ( debInfo )+import qualified Debian.Debianize.BinaryDebDescription as B ()+import Debian.Pretty ( ppShow )+import Debian.Relation ( BinPkgName )+import System.FilePath ( (</>) )++execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo+execAtoms b ifile r =+ over (A.debInfo . D.rulesFragments) (Set.insert (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))) .+ fileAtoms b ifile $+ r++fileAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo+fileAtoms b installFile' r =+ fileAtoms' b (D.sourceDir installFile') (D.execName installFile') (D.destDir installFile') (D.destName installFile') r++fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> CabalInfo -> CabalInfo+fileAtoms' b sourceDir' execName' destDir' destName' r =+ case (sourceDir', execName' == destName') of+ (Nothing, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b execName' d)) r+ (Just s, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (s </> execName') d)) r+ (Nothing, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExecTo b execName' (d </> destName'))) r+ (Just s, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b (s </> execName') (d </> destName'))) r+ where+ d = fromMaybe "usr/bin" destDir'
src/Debian/Debianize/Finalize.hs view
@@ -2,7 +2,10 @@ {-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} module Debian.Debianize.Finalize ( debianize+ , debianizeWith+ , debianizeWebsite -- , finalizeDebianization -- external use deprecated - used in test script+ , watchAtom ) where @@ -16,10 +19,10 @@ import Control.Monad.State (get, modify) import Control.Monad.Trans (liftIO, MonadIO) import Data.ByteString.Lazy.UTF8 (fromString)-import Data.Char (toLower)+import Data.Char (isSpace, toLower) import Data.Digest.Pure.MD5 (md5) import Data.Function (on)-import Data.List as List (filter, intercalate, map, nub, null, unlines, maximumBy)+import Data.List as List (dropWhileEnd, filter, intercalate, map, nub, null, unlines, maximumBy) import Data.Map as Map (delete, elems, insertWith, lookup, Map, toList) import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Monoid ((<>))@@ -34,10 +37,11 @@ import Debian.Debianize.Changelog (dropFutureEntries) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (debianName, debianNameBase)-import Debian.Debianize.Goodies (backupAtoms, describe, execAtoms, serverAtoms, siteAtoms, watchAtom)+import Debian.Debianize.ExecAtoms (execAtoms)+import Debian.Debianize.Goodies (expandWebsite, expandServer, expandBackups) import Debian.Debianize.InputDebian (dataTop, dataDest, inputChangeLog) import Debian.Debianize.Monad as Monad (CabalT, liftCabal)-import Debian.Debianize.Prelude ((.?=))+import Debian.Debianize.Prelude ((.?=), stripWith) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.GHC (compilerPackageName)@@ -55,14 +59,14 @@ #endif #if MIN_VERSION_Cabal(2,0,0) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName, mkPackageName, unPackageName)-import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), FlagName, mkFlagName, unFlagName, maintainer, PackageDescription(testSuites))+import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), FlagName, mkFlagName, unFlagName, maintainer, PackageDescription(testSuites, description)) import Distribution.Types.UnqualComponentName import Distribution.Utils.ShortText #else import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName)) import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), FlagName(FlagName), maintainer, PackageDescription(testSuites)) #endif-import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, executables, library, package))+import Distribution.PackageDescription as Cabal (PackageDescription(dataFiles, description, executables, library, package, synopsis)) import Prelude hiding (init, log, map, unlines, unlines, writeFile) import System.Directory (doesFileExist) import System.FilePath ((<.>), (</>), makeRelative, splitFileName, takeDirectory, takeFileName)@@ -80,19 +84,28 @@ -- @customize@ and finalizes the debianization so it is ready to be -- output. debianize :: (MonadIO m, Functor m) => CabalT m () -> CabalT m ()-debianize customize =+debianize = debianizeWith (return ())++debianizeWebsite :: (MonadIO m, Functor m) => CabalT m () -> CabalT m ()+debianizeWebsite = debianizeWith (expandWebsite >> expandServer >> expandBackups)++-- | Pass a function with some additional work to do. I don't know+-- if this could be done by just summing it with customize - probably.+-- But I don't want to untangle this right now.+debianizeWith :: (MonadIO m, Functor m) => CabalT m () -> CabalT m () -> CabalT m ()+debianizeWith goodies customize = do liftCabal inputChangeLog customize- finalizeDebianization+ finalizeDebianization goodies -- | Do some light IO and call finalizeDebianization.-finalizeDebianization :: (MonadIO m, Functor m) => CabalT m ()-finalizeDebianization =+finalizeDebianization :: (MonadIO m, Functor m) => CabalT m () -> CabalT m ()+finalizeDebianization goodies = do date <- liftIO getCurrentLocalRFC822Time currentUser <- liftIO getCurrentDebianUser debhelperCompat <- liftIO getDebhelperCompatLevel setupExists <- or <$> mapM (liftIO . doesFileExist) ["Setup.hs", "Setup.lhs"]- finalizeDebianization' date currentUser debhelperCompat setupExists+ finalizeDebianization' goodies date currentUser debhelperCompat setupExists 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)@@ -105,8 +118,15 @@ -- 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 NameAddr -> Maybe Int -> Bool -> CabalT m ()-finalizeDebianization' date currentUser debhelperCompat setupExists =+finalizeDebianization' ::+ (MonadIO m, Functor m)+ => CabalT m ()+ -> String+ -> Maybe NameAddr+ -> Maybe Int+ -> Bool+ -> CabalT m ()+finalizeDebianization' goodies date currentUser debhelperCompat setupExists = 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@@ -131,7 +151,7 @@ finalizeControl currentUser finalizeRules -- T.license .?= Just (Cabal.license pkgDesc)- expandAtoms+ expandAtoms goodies -- Create the binary packages for the web sites, servers, backup packges, and other executables use (A.debInfo . D.executable) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList use (A.debInfo . D.backups) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList@@ -146,10 +166,19 @@ putBuildDeps (if allowSelfDeps then id else filterRelations debs) pkgDesc -- Sketchy - I think more things that need expanded could be generated by the code -- executed since the last expandAtoms. Anyway, should be idempotent.- expandAtoms+ expandAtoms goodies -- Turn atoms related to priority, section, and description into debianization elements -- finalizeDescriptions +watchAtom :: PackageName -> Text+#if MIN_VERSION_Cabal(2,0,0)+watchAtom pkgname =+ pack $ "version=3\nhttps://hackage.haskell.org/package/" ++ unPackageName pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n"+#else+watchAtom (PackageName pkgname) =+ pack $ "version=3\nhttps://hackage.haskell.org/package/" ++ pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n"+#endif+ -- | Compute the final values of the BinaryDebDescription record -- description fields from the cabal descriptions and the values that -- have already been set.@@ -307,6 +336,66 @@ (A.debInfo . D.control . S.xDescription) .?= Just desc' -- control %= (\ y -> y { D.source = Just src, D.maintainer = Just maint }) +describe :: Monad m => CabalT m Text+describe =+ do p <- use A.packageDescription+ return $+ debianDescriptionBase p {- <> "\n" <>+ case typ of+ Just B.Profiling ->+ Text.intercalate "\n"+ [" .",+ " This package provides a library for the Haskell programming language, compiled",+ " for profiling. See http:///www.haskell.org/ for more information on Haskell."]+ Just B.Development ->+ Text.intercalate "\n"+ [" .",+ " This package provides a library for the Haskell programming language.",+ " See http:///www.haskell.org/ for more information on Haskell."]+ Just B.Documentation ->+ Text.intercalate "\n"+ [" .",+ " This package provides the documentation for a library for the Haskell",+ " programming language.",+ " See http:///www.haskell.org/ for more information on Haskell." ]+ Just B.Exec ->+ Text.intercalate "\n"+ [" .",+ " An executable built from the " <> pack (display (pkgName (Cabal.package p))) <> " package."]+ {- ServerPackage ->+ Text.intercalate "\n"+ [" .",+ " A server built from the " <> pack (display (pkgName pkgId)) <> " package."] -}+ _ {-Utilities-} ->+ Text.intercalate "\n"+ [" .",+ " Files associated with the " <> pack (display (pkgName (Cabal.package p))) <> " package."]+ -- x -> error $ "Unexpected library package name suffix: " ++ show x+-}++-- | The Cabal package has one synopsis and one description field+-- for the entire package, while in a Debian package there is a+-- description field (of which the first line is synopsis) in+-- each binary package. So the cabal description forms the base+-- of the debian description, each of which is amended.+debianDescriptionBase :: PackageDescription -> Text+debianDescriptionBase p =+ pack $ List.intercalate "\n " $ (synop' : desc)+ where+ -- If we have a one line description and no synopsis, use+ -- the description as the synopsis.+ synop' = if List.null synop && length desc /= 1+ then "WARNING: No synopsis available for package " ++ ppShow (package p)+ else synop+ synop :: String+ -- I don't know why (unwords . words) was applied here. Maybe I'll find out when+ -- this version goes into production. :-/ Ok, now I know, because sometimes the+ -- short cabal description has more than one line.+ synop = List.intercalate " " $ fmap (dropWhileEnd isSpace) $ lines $ synopsis p+ desc :: [String]+ desc = List.map addDot . stripWith List.null $ fmap (dropWhileEnd isSpace) $ lines $ Cabal.description p+ addDot line = if List.null line then "." else line+ -- | Make sure there is a changelog entry with the version number and -- source package name implied by the debianization. This means -- either adding an entry or modifying the latest entry (if its@@ -559,8 +648,8 @@ (Nothing) -> D.execName i (Just s) -> s </> D.execName i -expandAtoms :: Monad m => CabalT m ()-expandAtoms =+expandAtoms :: Monad m => CabalT m () -> CabalT m ()+expandAtoms goodies = do hc <- use (A.debInfo . D.flags . compilerFlavor) case hc of GHC -> (A.debInfo . D.flags . cabalFlagAssignments) %= (Set.union (Set.fromList (flagList "--ghc")))@@ -581,9 +670,13 @@ expandInstallData dDest expandInstallTo expandFile+#if 1+ goodies+#else expandWebsite expandServer expandBackups+#endif expandExecutable where expandApacheSites :: Monad m => CabalT m ()@@ -611,7 +704,7 @@ (A.debInfo . D.rulesFragments) %= Set.insert (Text.unlines [ pack ("binary-fixup" </> ppShow b) <> "::"- , pack ("\t(cd " <> builddir </> name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <>+ , pack ("\t(cd " <> builddir </> name <> " && find -L " <> name <.> "jsexe" <> " -type f) |\\\n" <> "\t while read i; do install -Dp " <> builddir </> name </> "$$i debian" </> ppShow b </> makeRelative "/" dest </> "$$i; done\n") ]) #endif doAtom _ _ = return ()@@ -669,23 +762,6 @@ (A.debInfo . D.intermediateFiles) %= Set.insert (tmpPath, text) (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b tmpPath destDir') doAtom _ = return ()-- expandWebsite :: Monad m => CabalT m ()- expandWebsite =- do mp <- get >>= return . view (A.debInfo . D.website)- pkgDesc <- use A.packageDescription- List.mapM_ (\ (b, site) -> modify (siteAtoms pkgDesc b site)) (Map.toList mp)-- expandServer :: Monad m => CabalT m ()- expandServer =- do mp <- get >>= return . view (A.debInfo . D.serverInfo)- pkgDesc <- use A.packageDescription- List.mapM_ (\ (b, x) -> modify (serverAtoms pkgDesc b x False)) (Map.toList mp)-- expandBackups :: Monad m => CabalT m ()- expandBackups =- do mp <- get >>= return . view (A.debInfo . D.backups)- List.mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp) expandExecutable :: Monad m => CabalT m () expandExecutable =
src/Debian/Debianize/Goodies.hs view
@@ -4,12 +4,10 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Debian.Debianize.Goodies ( tightDependencyFixup- , doServer- , doWebsite- , doBackups+ , expandWebsite, doServer+ , expandServer, doWebsite+ , expandBackups, doBackups , doExecutable- , describe- , watchAtom , oldClckwrksSiteFlags , oldClckwrksServerFlags , siteAtoms@@ -20,32 +18,26 @@ ) where import Control.Lens-import Control.Monad.State (MonadState)-import Data.Char (isSpace)-import Data.List as List (dropWhileEnd, intercalate, intersperse, map)-import Data.Map as Map (insert, insertWith)-import Data.Maybe (fromMaybe)+import Control.Monad.State (MonadState(get), modify)+import Data.List as List ({-dropWhileEnd, intercalate,-} intersperse, map)+import Data.Map as Map (insert, insertWith, toList) import Data.Monoid ((<>)) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mappend) #endif import Data.Set as Set (insert, singleton, union)-import Data.Text as Text (pack, Text, unlines)+import Data.Text as Text (pack, {-Text,-} unlines) import qualified Debian.Debianize.DebInfo as D+import Debian.Debianize.ExecAtoms (execAtoms) import Debian.Debianize.Monad (CabalInfo, CabalT, DebianT, execCabalM)-import Debian.Debianize.Prelude (stripWith)+--import Debian.Debianize.Prelude (stripWith) import qualified Debian.Debianize.CabalInfo as A import qualified Debian.Debianize.BinaryDebDescription as B import Debian.Orphans () import Debian.Policy (apacheAccessLog, apacheErrorLog, apacheLogDirectory, databaseDirectory, dataDirectory, serverAccessLog, serverAppLog)-import Debian.Pretty (ppShow, ppText)+import Debian.Pretty (ppText) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel))-#if MIN_VERSION_Cabal(2,0,0)-import Distribution.Package (PackageName, unPackageName)-#else-import Distribution.Package (PackageName(PackageName))-#endif-import Distribution.PackageDescription as Cabal (PackageDescription(package, synopsis, description))+import Distribution.PackageDescription as Cabal (PackageDescription) import Distribution.Simple.Build.PathsModule (pkgPathEnvVar) import Prelude hiding (init, log, map, unlines, writeFile) import System.FilePath ((</>))@@ -102,66 +94,6 @@ (A.debInfo . D.binaryDebDescription bin . B.relations . B.depends) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]]) -- depends +++= (bin, Rel (BinPkgName "anacron") Nothing Nothing) -describe :: Monad m => CabalT m Text-describe =- do p <- use A.packageDescription- return $- debianDescriptionBase p {- <> "\n" <>- case typ of- Just B.Profiling ->- Text.intercalate "\n"- [" .",- " This package provides a library for the Haskell programming language, compiled",- " for profiling. See http:///www.haskell.org/ for more information on Haskell."]- Just B.Development ->- Text.intercalate "\n"- [" .",- " This package provides a library for the Haskell programming language.",- " See http:///www.haskell.org/ for more information on Haskell."]- Just B.Documentation ->- Text.intercalate "\n"- [" .",- " This package provides the documentation for a library for the Haskell",- " programming language.",- " See http:///www.haskell.org/ for more information on Haskell." ]- Just B.Exec ->- Text.intercalate "\n"- [" .",- " An executable built from the " <> pack (display (pkgName (Cabal.package p))) <> " package."]- {- ServerPackage ->- Text.intercalate "\n"- [" .",- " A server built from the " <> pack (display (pkgName pkgId)) <> " package."] -}- _ {-Utilities-} ->- Text.intercalate "\n"- [" .",- " Files associated with the " <> pack (display (pkgName (Cabal.package p))) <> " package."]- -- x -> error $ "Unexpected library package name suffix: " ++ show x--}---- | The Cabal package has one synopsis and one description field--- for the entire package, while in a Debian package there is a--- description field (of which the first line is synopsis) in--- each binary package. So the cabal description forms the base--- of the debian description, each of which is amended.-debianDescriptionBase :: PackageDescription -> Text-debianDescriptionBase p =- pack $ List.intercalate "\n " $ (synop' : desc)- where- -- If we have a one line description and no synopsis, use- -- the description as the synopsis.- synop' = if null synop && length desc /= 1- then "WARNING: No synopsis available for package " ++ ppShow (package p)- else synop- synop :: String- -- I don't know why (unwords . words) was applied here. Maybe I'll find out when- -- this version goes into production. :-/ Ok, now I know, because sometimes the- -- short cabal description has more than one line.- synop = intercalate " " $ map (dropWhileEnd isSpace) $ lines $ Cabal.synopsis p- desc :: [String]- desc = List.map addDot . stripWith null $ map (dropWhileEnd isSpace) $ lines $ Cabal.description p- addDot line = if null line then "." else line- oldClckwrksSiteFlags :: D.Site -> [String] oldClckwrksSiteFlags x = [ -- According to the happstack-server documentation this needs a trailing slash.@@ -173,15 +105,6 @@ "--base-uri", "http://" ++ D.hostname x ++ ":" ++ show (D.port x) ++ "/" , "--http-port", show (D.port x)] -watchAtom :: PackageName -> Text-#if MIN_VERSION_Cabal(2,0,0)-watchAtom pkgname =- pack $ "version=3\nhttps://hackage.haskell.org/package/" ++ unPackageName pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n"-#else-watchAtom (PackageName pkgname) =- pack $ "version=3\nhttps://hackage.haskell.org/package/" ++ pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n"-#endif- siteAtoms :: PackageDescription -> BinPkgName -> D.Site -> CabalInfo -> CabalInfo siteAtoms pkgDesc b site = execCabalM@@ -238,7 +161,6 @@ (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend 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"@@ -247,7 +169,6 @@ (A.debInfo . D.logrotateStanza) %= Map.insertWith mappend b (singleton (Text.unlines $ [ pack (apacheErrorLog b) <> " {"- , " copytruncate" , " weekly" , " rotate 5" , " compress"@@ -355,22 +276,19 @@ , D.sourceDir = Nothing , D.destDir = Just "/etc/cron.hourly" }) -execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo-execAtoms b ifile r =- over (A.debInfo . D.rulesFragments) (Set.insert (pack ("build" </> ppShow b ++ ":: build-ghc-stamp\n"))) .- fileAtoms b ifile $- r+expandWebsite :: Monad m => CabalT m ()+expandWebsite =+ do mp <- get >>= return . view (A.debInfo . D.website)+ pkgDesc <- use A.packageDescription+ mapM_ (\ (b, site) -> modify (siteAtoms pkgDesc b site)) (Map.toList mp) -fileAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo-fileAtoms b installFile' r =- fileAtoms' b (D.sourceDir installFile') (D.execName installFile') (D.destDir installFile') (D.destName installFile') r+expandServer :: Monad m => CabalT m ()+expandServer =+ do mp <- get >>= return . view (A.debInfo . D.serverInfo)+ pkgDesc <- use A.packageDescription+ mapM_ (\ (b, x) -> modify (serverAtoms pkgDesc b x False)) (Map.toList mp) -fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> CabalInfo -> CabalInfo-fileAtoms' b sourceDir' execName' destDir' destName' r =- case (sourceDir', execName' == destName') of- (Nothing, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b execName' d)) r- (Just s, True) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (s </> execName') d)) r- (Nothing, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExecTo b execName' (d </> destName'))) r- (Just s, False) -> execCabalM ((A.debInfo . D.atomSet) %= (Set.insert $ D.InstallTo b (s </> execName') (d </> destName'))) r- where- d = fromMaybe "usr/bin" destDir'+expandBackups :: Monad m => CabalT m ()+expandBackups =+ do mp <- get >>= return . view (A.debInfo . D.backups)+ mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp)
src/Debian/Debianize/Output.hs view
@@ -13,6 +13,8 @@ , compareDebianization , validateDebianization , performDebianization+ , performDebianizationOfWebsite+ , performDebianizationWith ) where import Control.Exception as E (throw)@@ -30,9 +32,10 @@ import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.InputDebian (inputDebianization)+import Debian.Debianize.Goodies (expandWebsite) import Debian.Debianize.Monad (DebianT, CabalT, evalDebian, evalCabalT) import Debian.Debianize.Prelude (indent, replaceFile, zipMaps)-import Debian.Debianize.Finalize (debianize)+import Debian.Debianize.Finalize (debianizeWith) import Debian.Debianize.Optparse import Debian.Debianize.BinaryDebDescription as B (canonical, package) import qualified Debian.Debianize.SourceDebDescription as S@@ -74,14 +77,20 @@ -- | Perform whole debianization. You provide your customization, -- this function does everything else. performDebianization :: CabalT IO () -> IO ()-performDebianization custom =+performDebianization = performDebianizationWith (return ())++performDebianizationOfWebsite :: CabalT IO () -> IO ()+performDebianizationOfWebsite = performDebianizationWith expandWebsite++performDebianizationWith :: CabalT IO () -> CabalT IO () -> IO ()+performDebianizationWith goodies custom = parseProgramArguments >>= \CommandLineOptions {..} -> do -- _ <- try (readProcessWithExitCode "apt-get" ["install", "-y", "--force-yes", hcDeb (view compilerFlavor _flags)] "") newCabalInfo _flags >>= either (error . ("peformDebianization - " ++)) (evalCabalT $ do handleBehaviorAdjustment _adjustment- debianize custom+ debianizeWith goodies custom finishDebianization) -- hcDeb :: CompilerFlavor -> String