packages feed

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 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