diff --git a/CabalDebian.hs b/CabalDebian.hs --- a/CabalDebian.hs +++ b/CabalDebian.hs @@ -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 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.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 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 @@ -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". diff --git a/src/Debian/Debianize/ExecAtoms.hs b/src/Debian/Debianize/ExecAtoms.hs new file mode 100644 --- /dev/null +++ b/src/Debian/Debianize/ExecAtoms.hs @@ -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' 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 @@ -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 = 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 @@ -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) 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 @@ -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