cabal-debian 4.20.1 → 4.23.1

raw patch · 50 files changed

+2918/−3096 lines, 50 filesdep +data-defaultPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default

API changes (from Hackage documentation)

Files

• CabalDebian.hs +16/−14
• LICENSE +31/−0
• Tests.hs +199/−197
• cabal-debian.cabal +14/−10
• changelog +36/−0
• debian/Debianize.hs +37/−73
• debian/changelog +56/−0
• debian/copyright +0/−40
• src/Debian/Debianize.hs +54/−26
• src/Debian/Debianize/BasicInfo.hs +153/−0
• src/Debian/Debianize/BinaryDebDescription.hs +140/−0
• src/Debian/Debianize/BuildDependencies.hs +97/−88
• src/Debian/Debianize/Bundled.hs +10/−10
• src/Debian/Debianize/CabalInfo.hs +116/−0
• src/Debian/Debianize/CopyrightDescription.hs +244/−0
• src/Debian/Debianize/DebInfo.hs +402/−0
• src/Debian/Debianize/DebianName.hs +21/−18
• src/Debian/Debianize/Details.hs +14/−11
• src/Debian/Debianize/Files.hs +48/−42
• src/Debian/Debianize/Finalize.hs +268/−227
• src/Debian/Debianize/Goodies.hs +76/−79
• src/Debian/Debianize/Input.hs +0/−363
• src/Debian/Debianize/InputCabal.hs +77/−0
• src/Debian/Debianize/InputDebian.hs +261/−0
• src/Debian/Debianize/Interspersed.hs +1/−1
• src/Debian/Debianize/Monad.hs +42/−25
• src/Debian/Debianize/Options.hs +80/−114
• src/Debian/Debianize/Output.hs +27/−28
• src/Debian/Debianize/Prelude.hs +35/−26
• src/Debian/Debianize/SourceDebDescription.hs +136/−0
• src/Debian/Debianize/SubstVars.hs +41/−51
• src/Debian/Debianize/Types.hs +0/−272
• src/Debian/Debianize/Types/Atoms.hs +0/−760
• src/Debian/Debianize/Types/BinaryDebDescription.hs +0/−140
• src/Debian/Debianize/Types/CopyrightDescription.hs +0/−162
• src/Debian/Debianize/Types/SourceDebDescription.hs +0/−136
• src/Debian/Debianize/VersionSplits.hs +7/−7
• src/Debian/GHC.hs +3/−3
• src/Debian/Orphans.hs +17/−34
• src/Debian/Policy.hs +16/−12
• test-data/alex/output/debian/copyright +20/−14
• test-data/archive/output/debian/copyright +2/−7
• test-data/artvaluereport-data/output/debian/copyright +4/−0
• test-data/artvaluereport2/input/debian/Debianize.hs +50/−44
• test-data/artvaluereport2/output/debian/artvaluereport2-development.install +13/−13
• test-data/artvaluereport2/output/debian/artvaluereport2-production.install +13/−13
• test-data/artvaluereport2/output/debian/artvaluereport2-staging.install +13/−13
• test-data/artvaluereport2/output/debian/copyright +4/−0
• test-data/clckwrks-dot-com/output/debian/copyright +21/−15
• test-data/creativeprompts/output/debian/copyright +3/−8

@@ -6,37 +6,39 @@ -- function directly, many sophisticated configuration options cannot -- be accessed using the command line interface. +import Control.Category ((.)) import Control.Monad.Trans (MonadIO, liftIO) import Data.Lens.Lazy (access) import Data.List as List (unlines)-import Debian.Debianize.Details (debianDefaultAtoms)+import Debian.Debianize.BasicInfo (DebAction(Debianize, SubstVar, Usage), debAction, newFlags)+import Debian.Debianize.CabalInfo (newCabalInfo, debInfo)+import Debian.Debianize.DebInfo (flags)+import Debian.Debianize.Details (debianDefaults) import Debian.Debianize.Finalize (debianize)-import Debian.Debianize.Monad (DebT, evalDebT)+import Debian.Debianize.Monad (CabalT, evalCabalT, liftCabal) import Debian.Debianize.Options (options) import Debian.Debianize.Output (doDebianizeAction) import Debian.Debianize.SubstVars (substvars)-import Debian.Debianize.Types.Atoms (DebAction(Debianize, SubstVar, Usage), EnvSet(EnvSet), debAction, newAtoms)-import Prelude hiding (unlines, writeFile, init)+import Prelude hiding (unlines, writeFile, init, (.)) import System.Console.GetOpt (OptDescr, usageInfo) import System.Environment (getProgName)  main :: IO ()-main = cabalDebianMain debianDefaultAtoms+main = cabalDebianMain debianDefaults  -- | The main function for the cabal-debian executable.-cabalDebianMain :: (MonadIO m, Functor m) => DebT m () -> m ()+cabalDebianMain :: (MonadIO m, Functor m) => CabalT m () -> m () cabalDebianMain init =     -- This picks up the options required to decide what action we are     -- taking.  Much of this will be repeated in the call to debianize.-    do atoms <- newAtoms-       evalDebT (do debianize init-                    action <- access debAction-                    finish action) atoms+    do atoms <- liftIO $ newFlags >>= newCabalInfo+       evalCabalT (do debianize init+                      action <- access (debAction . flags . debInfo)+                      finish action) atoms     where-      envset = EnvSet "/" "/" "/"-      finish :: forall m. (MonadIO m, Functor m) => DebAction -> DebT m ()+      finish :: forall m. (MonadIO m, Functor m) => DebAction -> CabalT m ()       finish (SubstVar debType) = substvars debType-      finish Debianize = doDebianizeAction envset+      finish Debianize = liftCabal doDebianizeAction       finish Usage = do           progName <- liftIO getProgName           let info = unlines [ "Typical usage is to cd to the top directory of the package's unpacked source and run: "@@ -50,4 +52,4 @@                              , "reason I recommend either using a pristine unpacked directory each time, or else"                              , "using a revision control system to revert the package to a known state before running."                              , "The following additional options are available:" ]-          liftIO $ putStrLn (usageInfo info (options :: [OptDescr (DebT m ())]))+          liftIO $ putStrLn (usageInfo info (options :: [OptDescr (CabalT m ())]))

@@ -0,0 +1,31 @@+The packageing was adjusted to Debian conventions by Joachim Breitner+<nomeata@debian.org> on Sat, 01 May 2010 21:16:18 +0200, and is licenced under+the same terms as the package itself.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++   * Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.++   * Redistributions in binary form must reproduce the above+     copyright notice, this list of conditions and the following+     disclaimer in the documentation and/or other materials provided+     with the distribution.++   * The names of contributors may not be used to endorse or promote+     products derived from this software without specific prior+     written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -10,27 +10,29 @@ import Data.Algorithm.Diff.Context (contextDiff) import Data.Algorithm.Diff.Pretty (prettyDiff) import Data.Function (on)-import Data.Lens.Lazy (access, getL, setL)+import Data.Lens.Lazy (getL, setL) import Data.List (sortBy) import Data.Map as Map (differenceWithKey, intersectionWithKey) import qualified Data.Map as Map (elems, Map, toList)+import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mconcat, mempty)-import Data.Set as Set (fromList, singleton, union)+import Data.Set as Set (fromList, union, insert) import Data.Text as Text (intercalate, split, Text, unlines, unpack) import Data.Version (Version(Version)) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..), parseEntry)+import Debian.Debianize.BasicInfo (compilerFlavor, newFlags)+import qualified Debian.Debianize.BinaryDebDescription as B+import Debian.Debianize.CabalInfo as A+import Debian.Debianize.CopyrightDescription import Debian.Debianize.DebianName (mapCabal, splitCabal)+import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap)-import Debian.Debianize.Finalize (debianize, finalizeDebianization)+import Debian.Debianize.Finalize (debianize {-, finalizeDebianization-}) import Debian.Debianize.Goodies (doBackups, doExecutable, doServer, doWebsite, tightDependencyFixup)-import Debian.Debianize.Input (inputChangeLog, inputDebianization, inputCabalization)-import Debian.Debianize.Monad (DebT, evalDebT, execDebM, execDebT)+import Debian.Debianize.InputDebian (inputDebianization)+import Debian.Debianize.Monad (CabalT, evalCabalT, execCabalM, execCabalT, liftCabal, execDebianT, DebianT, evalDebianT) import Debian.Debianize.Prelude ((%=), (++=), (+=), (~=), withCurrentDirectory)-import Debian.Debianize.Types as T-import Debian.Debianize.Types.Atoms as T-import qualified Debian.Debianize.Types.BinaryDebDescription as B-import Debian.Debianize.Types.CopyrightDescription-import qualified Debian.Debianize.Types.SourceDebDescription as S+import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Pretty (ppDisplay) import Debian.Policy (databaseDirectory, PackageArchitectures(All), PackagePriority(Extra), parseMaintainer, Section(MainSection), SourceFormat(Native3), StandardsVersion(..), getDebhelperCompatLevel, getDebianStandardsVersion, License(..))@@ -48,10 +50,10 @@ import Text.PrettyPrint.HughesPJClass (pPrint, text, Doc)  -- | A suitable defaultAtoms value for the debian repository.-defaultAtoms :: Monad m => DebT m ()+defaultAtoms :: Monad m => CabalT m () defaultAtoms =-    do T.epochMap ++= (PackageName "HaXml", 1)-       T.epochMap ++= (PackageName "HTTP", 1)+    do A.epochMap ++= (PackageName "HaXml", 1)+       A.epochMap ++= (PackageName "HTTP", 1)        mapCabal (PackageName "parsec") (DebBase "parsec3")        splitCabal (PackageName "parsec") (DebBase "parsec2") (Version [3] [])        mapCabal (PackageName "QuickCheck") (DebBase "quickcheck2")@@ -59,36 +61,36 @@        mapCabal (PackageName "gtk2hs-buildtools") (DebBase "gtk2hs-buildtools")  -- | Force the compiler version to 7.6 to get predictable outputs-testAtoms :: IO Atoms-testAtoms = ghc763 <$> T.newAtoms+testAtoms :: IO CabalInfo+testAtoms = newFlags >>= newCabalInfo >>= return . ghc763     where-      ghc763 :: Atoms -> Atoms-      ghc763 atoms = setL T.compilerFlavors (singleton GHC) atoms+      ghc763 :: CabalInfo -> CabalInfo+      ghc763 atoms = setL (compilerFlavor . D.flags . A.debInfo) GHC atoms  -- | Create a Debianization based on a changelog entry and a license -- value.  Uses the currently installed versions of debhelper and -- debian-policy to set the compatibility levels.-newDebianization :: Monad m => ChangeLog -> Maybe Int -> Maybe StandardsVersion -> DebT m ()+newDebianization :: Monad m => ChangeLog -> Maybe Int -> Maybe StandardsVersion -> CabalT m () newDebianization (ChangeLog (WhiteSpace {} : _)) _ _ = error "defaultDebianization: Invalid changelog entry" newDebianization (log@(ChangeLog (entry : _))) level standards =-    do T.changelog ~= Just log-       T.compat ~= level-       T.source ~= Just (SrcPkgName (logPackage entry))-       (S.maintainer . T.control) ~= either error Just (parseMaintainer (logWho entry))-       T.standardsVersion ~= standards+    do (D.changelog . A.debInfo) ~= Just log+       (D.compat . A.debInfo) ~= level+       (S.source . D.control . A.debInfo) ~= Just (SrcPkgName (logPackage entry))+       (S.maintainer . D.control . A.debInfo) ~= either error Just (parseMaintainer (logWho entry))+       (S.standardsVersion . D.control . A.debInfo) ~= standards newDebianization _ _ _ = error "Invalid changelog" -newDebianization' :: Monad m => Maybe Int -> Maybe StandardsVersion -> DebT m ()+newDebianization' :: Monad m => Maybe Int -> Maybe StandardsVersion -> CabalT m () newDebianization' level standards =-    do T.compat ~= level-       T.standardsVersion ~= standards+    do (D.compat . A.debInfo) ~= level+       (S.standardsVersion . D.control . A.debInfo) ~= standards  tests :: Test tests = TestLabel "Debianization Tests" (TestList [-- 1 and 2 do not input a cabal package - we're not ready to                                                    -- debianize without a cabal package.                                                    {- test1 "test1",                                                    test2 "test2", -}-                                                   test3 "test3",+                                                   -- test3 "test3", -- not a cabal package                                                    test4 "test4 - test-data/clckwrks-dot-com",                                                    test5 "test5 - test-data/creativeprompts",                                                    test6 "test6 - test-data/artvaluereport2",@@ -101,55 +103,56 @@ issue23 :: String -> Test issue23 label =     TestLabel label $-    TestCase (do atoms <- testAtoms-                 actual <- withCurrentDirectory "test-data/alex/input" $-                           evalDebT (do inputCabalization-                                        T.changelog ~= Just (ChangeLog [testEntry])-                                        T.compat ~= Just 9-                                        T.official ~= True-                                        Map.toList <$> debianizationFileMap) atoms+    TestCase (withCurrentDirectory "test-data/alex/input" $+              do atoms <- testAtoms+                 actual <- evalCabalT (do (D.changelog . A.debInfo) ~= Just (ChangeLog [testEntry])+                                          (D.compat . A.debInfo) ~= Just 9+                                          (D.official . A.debInfo) ~= True+                                          Map.toList <$> liftCabal debianizationFileMap) atoms                  assertEqual label                    []                    actual) +#if 0 test1 :: String -> Test test1 label =     TestLabel label $     TestCase (do level <- getDebhelperCompatLevel                  standards <- getDebianStandardsVersion :: IO (Maybe StandardsVersion)                  atoms <- testAtoms-                 deb <- execDebT+                 deb <- execCabalT                           (do -- let top = Top "."                               defaultAtoms                               newDebianization (ChangeLog [testEntry]) level standards-                              copyright %= (\ c -> c { _summaryLicense = Just BSD_3_Clause })+                              (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause }))                               -- inputCabalization top                               finalizeDebianization)                           atoms-                 diff <- diffDebianizations (testDeb1 atoms) deb+                 diff <- diffDebianizations (getL debInfo (testDeb1 atoms)) (getL debInfo deb)                  assertEqual label [] diff)     where-      testDeb1 :: Atoms -> Atoms+      testDeb1 :: CabalInfo -> CabalInfo       testDeb1 atoms =-          execDebM+          execCabalM             (do defaultAtoms                 newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1)))-                rulesHead %= (const (Just (Text.unlines $+                (D.rulesHead . debInfo) %= (const (Just (Text.unlines $                                                 [ "#!/usr/bin/make -f"                                                 , ""                                                 , "include /usr/share/cdbs/1/rules/debhelper.mk"                                                 , "include /usr/share/cdbs/1/class/hlibrary.mk" ])))-                compat ~= Just 9 -- This will change as new version of debhelper are released-                copyright %= (\ c -> c { _summaryLicense = Just BSD_3_Clause })-                T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"})-                (S.maintainer . T.control) ~= Just (NameAddr (Just "David Fox") "dsf@seereason.com")-                T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1)) -- This will change as new versions of debian-policy are released-                T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing],+                (D.compat . debInfo) ~= Just 9 -- This will change as new version of debhelper are released+                (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause }))+                (S.source . D.control . debInfo) ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"})+                (S.maintainer . D.control . debInfo) ~= Just (NameAddr (Just "David Fox") "dsf@seereason.com")+                (S.standardsVersion . D.control . debInfo) ~= Just (StandardsVersion 3 9 3 (Just 1)) -- This will change as new versions of debian-policy are released+                (S.buildDepends . D.control . debInfo) %=+                                  (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing],                                        [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing],                                        [Rel (BinPkgName "cdbs") Nothing Nothing],                                        [Rel (BinPkgName "ghc") Nothing Nothing],                                        [Rel (BinPkgName "ghc-prof") Nothing Nothing]])-                T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]]))+                (S.buildDependsIndep . D.control . debInfo) %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]]))             atoms       log = ChangeLog [Entry { logPackage = "haskell-cabal-debian"                              , logVersion = buildDebianVersion Nothing "2.6.2" Nothing@@ -165,37 +168,38 @@     TestCase (do level <- getDebhelperCompatLevel                  standards <- getDebianStandardsVersion                  atoms <- testAtoms-                 deb <- execDebT+                 deb <- execCabalT                           (do -- let top = Top "."                               defaultAtoms                               newDebianization (ChangeLog [testEntry]) level standards-                              copyright %= (\ c -> c { _summaryLicense = Just BSD_3_Clause })+                              (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause }))                               -- inputCabalization top                               finalizeDebianization)                           atoms-                 diff <- diffDebianizations (expect atoms) deb+                 diff <- diffDebianizations (getL debInfo (expect atoms)) (getL debInfo deb)                  assertEqual label [] diff)     where       expect atoms =-          execDebM+          execCabalM             (do defaultAtoms                 newDebianization log (Just 9) (Just (StandardsVersion 3 9 3 (Just 1)))-                rulesHead %= (const (Just (Text.unlines $+                (D.rulesHead . debInfo) %= (const (Just (Text.unlines $                                                 ["#!/usr/bin/make -f",                                                  "",                                                  "include /usr/share/cdbs/1/rules/debhelper.mk",                                                  "include /usr/share/cdbs/1/class/hlibrary.mk"])))-                compat ~= Just 9-                copyright %= (\ c -> c { _summaryLicense = Just BSD_3_Clause })-                T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"})-                (S.maintainer . T.control) ~= Just (NameAddr {nameAddr_name = Just "David Fox", nameAddr_addr = "dsf@seereason.com"})-                T.standardsVersion ~= Just (StandardsVersion 3 9 3 (Just 1))-                T.buildDepends %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing],+                (D.compat . debInfo) ~= Just 9+                (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryLicense = Just BSD_3_Clause }))+                (S.source . D.control . debInfo) ~= Just (SrcPkgName {unSrcPkgName = "haskell-cabal-debian"})+                (S.maintainer . D.control . debInfo) ~= Just (NameAddr {nameAddr_name = Just "David Fox", nameAddr_addr = "dsf@seereason.com"})+                (S.standardsVersion . D.control . debInfo) ~= Just (StandardsVersion 3 9 3 (Just 1))+                (S.buildDepends . D.control . debInfo)+                               %= (++ [[Rel (BinPkgName "debhelper") (Just (GRE (parseDebianVersion ("7.0" :: String)))) Nothing],                                        [Rel (BinPkgName "haskell-devscripts") (Just (GRE (parseDebianVersion ("0.8" :: String)))) Nothing],                                        [Rel (BinPkgName "cdbs") Nothing Nothing],                                        [Rel (BinPkgName "ghc") Nothing Nothing],                                        [Rel (BinPkgName "ghc-prof") Nothing Nothing]])-                T.buildDependsIndep %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]]))+                (S.buildDependsIndep . D.control . debInfo) %= (++ [[Rel (BinPkgName "ghc-doc") Nothing Nothing]]))             atoms       log = ChangeLog [Entry {logPackage = "haskell-cabal-debian",                               logVersion = Debian.Version.parseDebianVersion ("2.6.2" :: String),@@ -205,6 +209,7 @@                                                              "    files that were supposed to be installed into packages."],                               logWho = "David Fox <dsf@seereason.com>",                               logDate = "Thu, 20 Dec 2012 06:49:25 -0800"}]+#endif  testEntry :: ChangeLogEntry testEntry =@@ -220,20 +225,21 @@ test3 :: String -> Test test3 label =     TestLabel label $-    TestCase (do let top = "test-data/haskell-devscripts"-                     envset = EnvSet "/" "/" "/"-                 atoms <- testAtoms-                 deb <- withCurrentDirectory top (execDebT (inputDebianization envset) atoms)-                 diff <- diffDebianizations (testDeb2 atoms) deb+    TestCase (let top = "test-data/haskell-devscripts" in+              withCurrentDirectory top $+              do atoms <- testAtoms+                 deb <- (execCabalT (liftCabal inputDebianization) atoms)+                 diff <- diffDebianizations (getL debInfo (testDeb2 atoms)) (getL debInfo deb)                  assertEqual label [] diff)     where-      testDeb2 :: Atoms -> Atoms+      testDeb2 :: CabalInfo -> CabalInfo       testDeb2 atoms =-          execDebM+          execCabalM             (do defaultAtoms                 newDebianization log (Just 7) (Just (StandardsVersion 3 9 4 Nothing))-                T.sourceFormat ~= Just Native3-                T.rulesHead ~= Just (Text.unlines  ["#!/usr/bin/make -f",+                (D.sourceFormat . debInfo) ~= Just Native3+                (D.rulesHead . debInfo) ~=+                               Just (Text.unlines  ["#!/usr/bin/make -f",                                                     "# -*- makefile -*-",                                                     "",                                                     "# Uncomment this to turn on verbose mode.",@@ -277,20 +283,20 @@                                                     "\trm -f $(manpages)",                                                     "",                                                     ""])-                T.compat ~= Just 7-                T.copyright %= \ c -> c { _summaryComment = Just "This package was debianized by John Goerzen <jgoerzen@complete.org> on\nWed,  6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n" }-                T.source ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"})-                (S.maintainer . T.control) ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"})-                (S.uploaders . T.control) ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}]-                T.sourcePriority ~= Just Extra-                T.sourceSection ~= Just (MainSection "haskell")-                T.buildDepends %= (++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]])-                T.buildDependsIndep %=  (++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]])-                T.standardsVersion ~= Just (StandardsVersion 3 9 4 Nothing)-                T.vcsFields %= Set.union (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts"+                (D.compat . debInfo) ~= Just 7+                (D.copyright . debInfo) %= (Just . id . fromMaybe (readCopyrightDescription "This package was debianized by John Goerzen <jgoerzen@complete.org> on\nWed,  6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n"))+                (S.source . D.control . debInfo) ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"})+                (S.maintainer . D.control . debInfo) ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"})+                (S.uploaders . D.control . debInfo) ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}]+                (S.priority . D.control . debInfo) ~= Just Extra+                (S.section . D.control . debInfo) ~= Just (MainSection "haskell")+                (S.buildDepends . D.control . debInfo) %= (++ [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing]])+                (S.buildDependsIndep . D.control . debInfo) %=  (++ [[Rel (BinPkgName {unBinPkgName = "perl"}) Nothing Nothing]])+                (S.standardsVersion . D.control . debInfo) ~= Just (StandardsVersion 3 9 4 Nothing)+                (S.vcsFields . D.control . debInfo) %= Set.union (Set.fromList [ S.VCSBrowser "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-devscripts"                                                        , S.VCSDarcs "http://darcs.debian.org/pkg-haskell/haskell-devscripts"])-                T.binaryArchitectures (BinPkgName "haskell-devscripts") ~= Just All-                T.debianDescription (BinPkgName "haskell-devscripts") ~=+                (B.architecture . D.binaryDebDescription (BinPkgName "haskell-devscripts") . debInfo)  ~= Just All+                (B.description . D.binaryDebDescription (BinPkgName "haskell-devscripts") . debInfo) ~=                    Just                      (intercalate "\n"   ["Tools to help Debian developers build Haskell packages",                                           " This package provides a collection of scripts to help build Haskell",@@ -302,7 +308,7 @@                                           " interpreter, generate appropriate postinst/prerm files for each one,",                                           " generate appropriate substvars entries for each one, and install the",                                           " package in the Debian temporary area as part of the build process."])-                T.depends (BinPkgName "haskell-devscripts") ~=+                (B.depends . B.relations . D.binaryDebDescription (BinPkgName "haskell-devscripts") . debInfo) ~=                      [ [Rel (BinPkgName {unBinPkgName = "dctrl-tools"}) Nothing Nothing]                      , [Rel (BinPkgName {unBinPkgName = "debhelper"}) Nothing Nothing]                      , [Rel (BinPkgName {unBinPkgName = "dh-buildinfo"}) Nothing Nothing]@@ -381,41 +387,42 @@ test4 :: String -> Test test4 label =     TestLabel label $-    TestCase (do let inTop = "test-data/clckwrks-dot-com/input"-                     outTop = "test-data/clckwrks-dot-com/output"-                     envset = EnvSet "/" "/" "/"-                 atoms <- testAtoms-                 old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms)-                 let log = getL T.changelog old-                 new <- withCurrentDirectory inTop (execDebT (debianize (defaultAtoms >> customize log)) atoms)-                 diff <- diffDebianizations old ({-copyFirstLogEntry old-} new)+    TestCase (do let outTop = "test-data/clckwrks-dot-com/output"+                 let inTop = "test-data/clckwrks-dot-com/input"+                 atoms <- withCurrentDirectory inTop $ testAtoms+                 old <- withCurrentDirectory outTop $ do+                          execCabalT (liftCabal inputDebianization) atoms+                 let log = getL (D.changelog . debInfo) old+                 new <- withCurrentDirectory inTop $ do+                          execCabalT (debianize (defaultAtoms >> customize log)) atoms+                 diff <- diffDebianizations (getL debInfo old) (getL debInfo ({-copyFirstLogEntry old-} new))                  assertEqual label [] diff)     where-      customize :: Maybe ChangeLog -> DebT IO ()+      customize :: Maybe ChangeLog -> CabalT IO ()       customize log =-          do T.changelog ~= log-             tight+          do (D.changelog . debInfo) ~= log+             liftCabal tight              fixRules              doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups"              doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production"))-             T.revision ~= Nothing-             T.missingDependencies += (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")-             T.sourceFormat ~= Just Native3-             T.homepage ~= Just "http://www.clckwrks.com/"+             (D.revision . A.debInfo) ~= Nothing+             (D.missingDependencies . A.debInfo) += (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")+             (D.sourceFormat . debInfo) ~= Just Native3+             (S.homepage . D.control . debInfo) ~= Just "http://www.clckwrks.com/"              newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing)) {-       customize log = modifyM (lift . customize' log)-      customize' :: Maybe ChangeLog -> Atoms -> IO Atoms+      customize' :: Maybe ChangeLog -> CabalInfo -> IO CabalInfo       customize' log atoms =-          execDebT (newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing))) .+          execCabalT (newDebianization' (Just 7) (Just (StandardsVersion 3 9 4 Nothing))) .           modL T.control (\ y -> y {T.homepage = Just "http://www.clckwrks.com/"}) .           setL T.sourceFormat (Just Native3) .           modL T.missingDependencies (insert (BinPkgName "libghc-clckwrks-theme-clckwrks-doc")) .           setL T.revision Nothing .-          execDebM (doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production"))) .-          execDebM (doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups") .+          execCabalM (doWebsite (BinPkgName "clckwrks-dot-com-production") (theSite (BinPkgName "clckwrks-dot-com-production"))) .+          execCabalM (doBackups (BinPkgName "clckwrks-dot-com-backups") "clckwrks-dot-com-backups") .           fixRules .-          execDebM tight .+          execCabalM tight .           setL T.changelog log -}       -- A log entry gets added when the Debianization is generated,@@ -423,7 +430,7 @@       serverNames = map BinPkgName ["clckwrks-dot-com-production"] -- , "clckwrks-dot-com-staging", "clckwrks-dot-com-development"]       -- Insert a line just above the debhelper.mk include       fixRules =-          rulesSettings %= (++ ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups"])+          (D.rulesSettings . debInfo) %= (++ ["DEB_SETUP_GHC_CONFIGURE_ARGS = -fbackups"]) {-           mapAtoms f deb           where@@ -440,21 +447,21 @@                                            (BinPkgName "libghc-clckwrks-plugin-bugs-dev", BinPkgName "haskell-clckwrks-plugin-bugs-utils"),                                            (BinPkgName "libghc-clckwrks-dev", BinPkgName "haskell-clckwrks-utils")]) serverNames -      theSite :: BinPkgName -> T.Site+      theSite :: BinPkgName -> D.Site       theSite deb =-          Site { domain = hostname'-               , serverAdmin = "logic@seereason.com"-               , server = theServer deb }-      theServer :: BinPkgName -> Server+          D.Site { D.domain = hostname'+                 , D.serverAdmin = "logic@seereason.com"+                 , D.server = theServer deb }+      theServer :: BinPkgName -> D.Server       theServer deb =-          Server { hostname =+          D.Server { D.hostname =                        case deb of                          BinPkgName "clckwrks-dot-com-production" -> hostname'                          _ -> hostname'-                 , port = portNum deb-                 , headerMessage = "Generated by clckwrks-dot-com/Setup.hs"-                 , retry = "60"-                 , serverFlags =+                 , D.port = portNum deb+                 , D.headerMessage = "Generated by clckwrks-dot-com/Setup.hs"+                 , D.retry = "60"+                 , D.serverFlags =                      [ "--http-port", show (portNum deb)                      , "--hide-port"                      , "--hostname", hostname'@@ -465,11 +472,11 @@                      , "--jstree-path", jstreePath                      , "--json2-path",json2Path                      ]-                 , installFile =-                     InstallFile { execName   = "clckwrks-dot-com-server"-                                 , destName   = ppDisplay deb-                                 , sourceDir  = Nothing-                                 , destDir    = Nothing }+                 , D.installFile =+                     D.InstallFile { D.execName   = "clckwrks-dot-com-server"+                                   , D.destName   = ppDisplay deb+                                   , D.sourceDir  = Nothing+                                   , D.destDir    = Nothing }                  }       hostname' = "clckwrks.com"       portNum :: BinPkgName -> Int@@ -490,60 +497,60 @@     TestLabel label $     TestCase (do let inTop = "test-data/creativeprompts/input"                      outTop = "test-data/creativeprompts/output"-                     envset = EnvSet "/" "/" "/"-                 atoms <- testAtoms-                 old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms)-                 let standards = getL T.standardsVersion old-                     level = getL T.compat old-                 new <- withCurrentDirectory inTop (execDebT (debianize (defaultAtoms >> customize old level standards)) atoms)-                 diff <- diffDebianizations old new+                 atoms <- withCurrentDirectory inTop testAtoms+                 old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo+                 let standards = getL (S.standardsVersion . D.control) old+                     level = getL D.compat old+                 new <- withCurrentDirectory inTop (execCabalT (debianize (defaultAtoms >> customize old level standards)) atoms)+                 diff <- diffDebianizations old (getL debInfo new)                  assertEqual label [] diff)     where       customize old level standards =-          do T.utilsPackageNameBase ~= Just "creativeprompts-data"+          do (D.utilsPackageNameBase . A.debInfo) ~= Just "creativeprompts-data"              newDebianization' level standards-             T.changelog ~= (getL T.changelog old)+             (D.changelog . debInfo) ~= (getL D.changelog old)              doWebsite (BinPkgName "creativeprompts-production") (theSite (BinPkgName "creativeprompts-production"))              doServer (BinPkgName "creativeprompts-development") (theServer (BinPkgName "creativeprompts-development"))              doBackups (BinPkgName "creativeprompts-backups") "creativeprompts-backups"-             T.execMap ++= ("trhsx", [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])-             mapM_ (\ b -> T.depends b %= \ deps -> deps ++ [[anyrel (BinPkgName "markdown")]])+             (D.execMap . A.debInfo) ++= ("trhsx", [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])+             mapM_ (\ b -> (B.depends . B.relations . D.binaryDebDescription b . debInfo) %= \ deps -> deps ++ [[anyrel (BinPkgName "markdown")]])                    [(BinPkgName "creativeprompts-production"), (BinPkgName "creativeprompts-development")]-             T.debianDescription (BinPkgName "creativeprompts-development") ~=+             (B.description . D.binaryDebDescription (BinPkgName "creativeprompts-development") . debInfo) ~=                    Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server"                                             , "  Testing version of the blog server, runs on port"                                             , "  8000 with HTML validation turned on." ])-             T.debianDescription (BinPkgName "creativeprompts-data") ~=+             (B.description . D.binaryDebDescription (BinPkgName "creativeprompts-data") . debInfo) ~=                    Just (intercalate "\n" [ "creativeprompts.com data files"                                             , "  Static data files for creativeprompts.com"])-             T.debianDescription (BinPkgName "creativeprompts-production") ~=+             (B.description . D.binaryDebDescription (BinPkgName "creativeprompts-production") . debInfo) ~=                    Just (intercalate "\n" [ "Configuration for running the creativeprompts.com server"                                             , "  Production version of the blog server, runs on port"                                             , "  9021 with HTML validation turned off." ])-             T.debianDescription (BinPkgName "creativeprompts-backups") ~=+             (B.description . D.binaryDebDescription (BinPkgName "creativeprompts-backups") . debInfo) ~=                    Just (intercalate "\n" [ "backup program for creativeprompts.com"                                             , "  Install this somewhere other than creativeprompts.com to run automated"                                             , "  backups of the database."])-             T.binaryArchitectures (BinPkgName "creativeprompts-production") ~= Just All-             T.binaryArchitectures (BinPkgName "creativeprompts-data") ~= Just All-             T.binaryArchitectures (BinPkgName "creativeprompts-development") ~= Just All-             T.sourceFormat ~= Just Native3+             (B.architecture . D.binaryDebDescription (BinPkgName "creativeprompts-production") . debInfo) ~= Just All+             (B.architecture . D.binaryDebDescription (BinPkgName "creativeprompts-data") . debInfo) ~= Just All+             (B.architecture . D.binaryDebDescription (BinPkgName "creativeprompts-development") . debInfo) ~= Just All+             (D.sourceFormat . debInfo) ~= Just Native3 -      theSite :: BinPkgName -> Site+      theSite :: BinPkgName -> D.Site       theSite deb =-          Site { domain = hostname'-               , serverAdmin = "logic@seereason.com"-               , server = theServer deb }-      theServer :: BinPkgName -> Server+          D.Site { D.domain = hostname'+                 , D.serverAdmin = "logic@seereason.com"+                 , D.server = theServer deb }+      theServer :: BinPkgName -> D.Server       theServer deb =-          Server { hostname =+          D.Server+                 { D.hostname =                        case deb of                          BinPkgName "clckwrks-dot-com-production" -> hostname'                          _ -> hostname'-                 , port = portNum deb-                 , headerMessage = "Generated by creativeprompts-dot-com/debian/Debianize.hs"-                 , retry = "60"-                 , serverFlags =+                 , D.port = portNum deb+                 , D.headerMessage = "Generated by creativeprompts-dot-com/debian/Debianize.hs"+                 , D.retry = "60"+                 , D.serverFlags =                      [ "--http-port", show (portNum deb)                      , "--hide-port"                      , "--hostname", hostname'@@ -554,11 +561,11 @@                      , "--jstree-path", jstreePath                      , "--json2-path",json2Path                      ]-                 , installFile =-                     InstallFile { execName   = "creativeprompts-server"-                                 , destName   = ppDisplay deb-                                 , sourceDir  = Nothing-                                 , destDir    = Nothing }+                 , D.installFile =+                     D.InstallFile { D.execName   = "creativeprompts-server"+                                 , D.destName   = ppDisplay deb+                                 , D.sourceDir  = Nothing+                                 , D.destDir    = Nothing }                  }       hostname' = "creativeprompts.com"       portNum :: BinPkgName -> Int@@ -580,7 +587,7 @@ test7 :: String -> Test test7 label =     TestLabel label $-    TestCase (do new <- readProcessWithExitCode "runhaskell" ["-isrc", "-DMIN_VERSION_Cabal(a,b,c)=1", "debian/Debianize.hs"] ""+    TestCase (do new <- readProcessWithExitCode "runhaskell" ["-isrc", "-DMIN_VERSION_Cabal(a,b,c)=1", "debian/Debianize.hs", "--executable=cabal-debian", "--executable=cabal-debian-tests", "--standards-version=3.9.3", "--native"] ""                  assertEqual label (ExitSuccess, "", "Ignored: debian/cabal-debian.1\nIgnored: debian/cabal-debian.manpages\n") new)  test8 :: String -> Test@@ -588,21 +595,19 @@     TestLabel label $     TestCase ( do let inTop = "test-data/artvaluereport-data/input"                       outTop = "test-data/artvaluereport-data/output"-                      envset = EnvSet "/" "/" "/"-                  atoms <- testAtoms-                  old <- withCurrentDirectory outTop (execDebT (inputDebianization envset) atoms)-                  log <- withCurrentDirectory inTop (evalDebT (inputChangeLog >> access T.changelog) atoms)-                  new <- withCurrentDirectory inTop (execDebT (debianize (defaultAtoms >> customize log)) atoms)-                  diff <- diffDebianizations old new+                  (old :: D.DebInfo) <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo+                  let log = getL D.changelog old+                  new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize log))+                  diff <- diffDebianizations old (getL debInfo new)                   assertEqual label [] diff              )     where       customize Nothing = error "Missing changelog"       customize (Just log) =-          do T.buildDepends %= (++ [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])-             T.homepage ~= Just "http://artvaluereportonline.com"-             T.sourceFormat ~= Just Native3-             T.changelog ~= Just log+          do (S.buildDepends . D.control . debInfo) %= (++ [[Rel (BinPkgName "haskell-hsx-utils") Nothing Nothing]])+             (S.homepage . D.control . debInfo) ~= Just "http://artvaluereportonline.com"+             (D.sourceFormat . debInfo) ~= Just Native3+             (D.changelog . debInfo) ~= Just log              newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing))  test9 :: String -> Test@@ -610,17 +615,15 @@     TestLabel label $     TestCase (do let inTop = "test-data/alex/input"                      outTop = "test-data/alex/output"-                     envset = EnvSet "/" "/" "/"-                 atoms <- testAtoms-                 new <- withCurrentDirectory inTop (execDebT (debianize (defaultAtoms >> customize)) atoms)-                 let Just (ChangeLog (entry : _)) = getL T.changelog new-                 old <- withCurrentDirectory outTop (execDebT (inputDebianization envset >> copyChangelogDate (logDate entry)) atoms)-                 diff <- diffDebianizations old new+                 new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize))+                 let Just (ChangeLog (entry : _)) = getL (D.changelog . debInfo) new+                 old <- withCurrentDirectory outTop $ newFlags >>= execDebianT (inputDebianization >> copyChangelogDate (logDate entry)) . D.makeDebInfo+                 diff <- diffDebianizations old (getL debInfo new)                  assertEqual label [] diff)     where       customize =           do newDebianization' (Just 7) (Just (StandardsVersion 3 9 3 Nothing))-             mapM_ (\ name -> T.installData (BinPkgName "alex") name name)+             mapM_ (\ name -> (D.atomSet . debInfo) %= (Set.insert $ D.InstallData (BinPkgName "alex") name name))                    [ "AlexTemplate"                    , "AlexTemplate-debug"                    , "AlexTemplate-ghc"@@ -635,41 +638,40 @@                    , "AlexWrapper-posn"                    , "AlexWrapper-posn-bytestring"                    , "AlexWrapper-strict-bytestring"]-             T.homepage ~= Just "http://www.haskell.org/alex/"-             T.sourceFormat ~= Just Native3-             T.debVersion ~= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String))+             (S.homepage . D.control . debInfo) ~= Just "http://www.haskell.org/alex/"+             (D.sourceFormat . debInfo) ~= Just Native3+             (D.debVersion . A.debInfo) ~= Just (parseDebianVersion ("3.0.2-1~hackage1" :: String))              doExecutable (BinPkgName "alex")-                          (InstallFile {execName = "alex", destName = "alex", sourceDir = Nothing, destDir = Nothing})+                          (D.InstallFile {D.execName = "alex", D.destName = "alex", D.sourceDir = Nothing, D.destDir = Nothing})              -- Bootstrap dependency-             T.buildDepends %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]])+             (S.buildDepends . D.control . debInfo) %= (++ [[Rel (BinPkgName "alex") Nothing Nothing]])  test10 :: String -> Test test10 label =     TestLabel label $     TestCase (do let inTop = "test-data/archive/input"                      outTop = "test-data/archive/output"-                     envset = EnvSet "/" "/" "/"-                 atoms <- testAtoms-                 new <- withCurrentDirectory inTop (execDebT (debianize (defaultAtoms >> customize)) atoms)-                 let Just (ChangeLog (entry : _)) = getL T.changelog new-                 old <- withCurrentDirectory outTop (execDebT (inputDebianization envset >> copyChangelogDate (logDate entry)) atoms)-                 diff <- diffDebianizations old new+                 old <- withCurrentDirectory outTop $ newFlags >>= execDebianT inputDebianization . D.makeDebInfo+                 let Just (ChangeLog (entry : _)) = getL D.changelog old+                 new <- withCurrentDirectory inTop $ newFlags >>= newCabalInfo >>= execCabalT (debianize (defaultAtoms >> customize >> (liftCabal $ copyChangelogDate $ logDate entry)))+                 diff <- diffDebianizations old (getL debInfo new)                  assertEqual label [] diff)     where-      customize :: DebT IO ()+      customize :: CabalT IO ()       customize =-          do T.sourcePackageName ~= Just (SrcPkgName "seereason-darcs-backups")-             T.compat ~= Just 5-             T.standardsVersion ~= Just (StandardsVersion 3 8 1 Nothing)-             (S.maintainer . T.control) ~= either (const Nothing) Just (parseMaintainer "David Fox <dsf@seereason.com>")-             T.depends (BinPkgName "seereason-darcs-backups") %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])-             T.sourceSection ~= Just (MainSection "haskell")-             T.utilsPackageNameBase ~= Just "seereason-darcs-backups"-             T.installCabalExec (BinPkgName "seereason-darcs-backups") "seereason-darcs-backups" "/etc/cron.hourly"+          do (D.sourceFormat . A.debInfo) ~= Just Native3+             (D.sourcePackageName . A.debInfo) ~= Just (SrcPkgName "seereason-darcs-backups")+             (D.compat . debInfo) ~= Just 5+             (S.standardsVersion . D.control . debInfo) ~= Just (StandardsVersion 3 8 1 Nothing)+             (S.maintainer . D.control . debInfo) ~= either (const Nothing) Just (parseMaintainer "David Fox <dsf@seereason.com>")+             (B.depends . B.relations . D.binaryDebDescription (BinPkgName "seereason-darcs-backups") . debInfo) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])+             (S.section . D.control . debInfo) ~= Just (MainSection "haskell")+             (D.utilsPackageNameBase . A.debInfo) ~= Just "seereason-darcs-backups"+             (D.atomSet . debInfo) %= (Set.insert $ D.InstallCabalExec (BinPkgName "seereason-darcs-backups") "seereason-darcs-backups" "/etc/cron.hourly") -copyChangelogDate :: Monad m => String -> DebT m ()+copyChangelogDate :: Monad m => String -> DebianT m () copyChangelogDate date =-    T.changelog %= (\ (Just (ChangeLog (entry : older))) -> Just (ChangeLog (entry {logDate = date} : older)))+    D.changelog %= (\ (Just (ChangeLog (entry : older))) -> Just (ChangeLog (entry {logDate = date} : older)))  data Change k a     = Created k a@@ -687,10 +689,10 @@       combine1 k a b = if a == b then Unchanged k a else Modified k a b       combine2 _ _ _ = Nothing -diffDebianizations :: Atoms -> Atoms -> IO String -- [Change FilePath T.Text]+diffDebianizations :: D.DebInfo -> D.DebInfo -> IO String -- [Change FilePath T.Text] diffDebianizations old new =-    do old' <- evalDebT (sortBinaryDebs >> debianizationFileMap) old-       new' <- evalDebT (sortBinaryDebs >> debianizationFileMap) new+    do old' <- evalDebianT (sortBinaryDebs >> debianizationFileMap) old+       new' <- evalDebianT (sortBinaryDebs >> debianizationFileMap) new        return $ show $ mconcat $ map prettyChange $ filter (not . isUnchanged) $ diffMaps old' new'     where       isUnchanged (Unchanged _ _) = True@@ -710,8 +712,8 @@           prettyDiff (text ("old" </> p)) (text ("new" </> p)) (text . unpack)                      (contextDiff 2 (split (== '\n') a) (split (== '\n') b)) -sortBinaryDebs :: DebT IO ()-sortBinaryDebs = T.binaryPackages %= sortBy (compare `on` getL B.package)+sortBinaryDebs :: DebianT IO ()+sortBinaryDebs = (S.binaryPackages . D.control) %= sortBy (compare `on` getL B.package)  main :: IO () main = runTestTT tests >>= putStrLn . show

@@ -1,8 +1,8 @@ Name:           cabal-debian-Version:        4.20.1+Version:        4.23.1 Copyright:      Copyright (c) 2007-2014, David Fox, Jeremy Shaw License:        BSD3-License-File:   debian/copyright+License-File:   LICENSE Author:         David Fox <dsf@seereason.com> Category:       Debian, Distribution, System Maintainer:     David Fox <dsf@seereason.com>@@ -156,6 +156,7 @@    base < 5,    Cabal >= 1.9,    containers,+   data-default,    data-lens,    data-lens-template,    deepseq,@@ -186,27 +187,30 @@    Debian.GHC    Debian.Policy    Distribution.Version.Invert+   Debian.Debianize.BasicInfo+   Debian.Debianize.BinaryDebDescription    Debian.Debianize.BuildDependencies    Debian.Debianize.Bundled+   Debian.Debianize.CabalInfo    Debian.Debianize.Changelog+   Debian.Debianize.CopyrightDescription    Debian.Debianize.DebianName+   Debian.Debianize.DebInfo    Debian.Debianize.Details    Debian.Debianize.Files    Debian.Debianize.Finalize    Debian.Debianize.Goodies-   Debian.Debianize.Input+   Debian.Debianize.InputCabal+   Debian.Debianize.InputDebian    Debian.Debianize.Interspersed    Debian.Debianize.Monad    Debian.Debianize.Options    Debian.Debianize.Output    Debian.Debianize.Prelude+   Debian.Debianize.SourceDebDescription    Debian.Debianize.SubstVars-   Debian.Debianize.Types-   Debian.Debianize.Types.Atoms-   Debian.Debianize.Types.BinaryDebDescription-   Debian.Debianize.Types.CopyrightDescription-   Debian.Debianize.Types.SourceDebDescription    Debian.Debianize.VersionSplits+   Paths_cabal_debian  Other-Modules:    Debian.Orphans  if flag(local-debian)@@ -222,7 +226,7 @@  Build-Depends: base, Cabal >= 1.9, data-lens, mtl, pretty  if flag(local-debian)    Hs-Source-Dirs: src, debian-haskell-   Build-depends: bytestring, containers, data-lens-template, deepseq, Diff, directory, exceptions, filepath, hsemail, ListLike, memoize, network, network-uri, old-locale, parsec, prettyclass, process, process-extras, pureMD5, regex-compat, regex-tdfa, set-extra, syb, template-haskell, text, time, unix, Unixutils, utf8-string+   Build-depends: bytestring, containers, data-default, data-lens-template, deepseq, Diff, directory, exceptions, filepath, hsemail, ListLike, memoize, network, network-uri, old-locale, parsec, prettyclass, process, process-extras, pureMD5, regex-compat, regex-tdfa, set-extra, syb, template-haskell, text, time, unix, Unixutils, utf8-string  else    Build-depends: debian >= 3.85, cabal-debian @@ -233,6 +237,6 @@  Build-Depends: base, Cabal >= 1.9, containers, data-lens, filepath, hsemail, HUnit, prettyclass, process, text  if flag(local-debian)    Hs-Source-Dirs: src, debian-haskell-   Build-depends: bytestring, containers, data-lens-template, deepseq, Diff, directory, exceptions, filepath, hsemail, ListLike, memoize, mtl, network, network-uri, old-locale, parsec, pretty, prettyclass, process, process-extras, pureMD5, regex-compat, regex-tdfa, set-extra, syb, template-haskell, text, time, unix, Unixutils, utf8-string+   Build-depends: bytestring, containers, data-default, data-lens-template, deepseq, Diff, directory, exceptions, filepath, hsemail, ListLike, memoize, mtl, network, network-uri, old-locale, parsec, pretty, prettyclass, process, process-extras, pureMD5, regex-compat, regex-tdfa, set-extra, syb, template-haskell, text, time, unix, Unixutils, utf8-string  else    Build-depends: debian >= 3.85, cabal-debian

@@ -1,3 +1,39 @@+haskell-cabal-debian (4.22) unstable; urgency=low++  * Big module reorganization for more type safety.++ -- David Fox <dsf@seereason.com>  Tue, 03 Feb 2015 13:22:29 -0800++haskell-cabal-debian (4.21.1) unstable; urgency=low++  * Fix --buildenvdir command line option.+  * Add an option for cabal flags++ -- David Fox <dsf@seereason.com>  Fri, 30 Jan 2015 13:46:08 -0800++haskell-cabal-debian (4.21) unstable; urgency=low++  * Split the enormous Atoms record into three layers - the innermost is+    Flags, which contains information obtained from the command line+    arguments.  Flags is also the argument to the inputCabalization+    function, which inputs a Cabal PackageDescription.  The Flags record+    is embedded in a DebInfo, which holds information related to the+    Debianization only.  The DebInfo and the PackageDescription are used+    to build the old Atoms record.  DebInfo is the state value of the+    DebianT monad, while Atoms is the state value of the CabalT monad.++    The point of all this is to ensure that a PackageDescription exists+    before we start converting the Cabalization to a Debianization.++ -- David Fox <dsf@seereason.com>  Thu, 29 Jan 2015 12:29:52 -0800++haskell-cabal-debian (4.20.2) unstable; urgency=low++  * Do not lowercase the package name when constructing the data file+    destination directory (/usr/share/<packagename>).++ -- David Fox <dsf@seereason.com>  Fri, 16 Jan 2015 05:45:23 -0800+ haskell-cabal-debian (4.20.1) unstable; urgency=low    * Fix a bug in the computation of the debian maintainer field

@@ -7,31 +7,39 @@ -- -- Be sure to run it with the local-debian flag turned off! +import Control.Category ((.)) import Control.Exception (throw) import Control.Monad.State (get)+import Data.Default (def) import Data.Lens.Lazy (getL, access) import Data.List (intercalate)+import Data.Map as Map (insert)+import Data.Maybe (fromMaybe) import Data.Monoid (mempty)-import Data.Set (singleton)+import Data.Set as Set (singleton, insert) import Data.Text as Text (Text, pack) import Debian.Changes (ChangeLog(ChangeLog))+import Debian.Debianize+{- import Debian.Debianize (inputChangeLog, inputDebianization) import Debian.Debianize.Details (debianDefaultAtoms) import Debian.Debianize.Finalize (debianize)+import Debian.Debianize.InputCabalPackageDescription (newFlags) import Debian.Debianize.Types as T-    (changelog, compat, conflicts, control, depends, debianDescription, homepage,+    (changelog, compat, conflicts, control, depends, debianDescription, homepage, packageDescription,      installCabalExec, sourceFormat, standardsVersion, utilsPackageNameBase, copyright, xDescription)-import Debian.Debianize.Types.Atoms as T (Atoms, newAtoms, EnvSet(EnvSet))-import Debian.Debianize.Monad (Atoms, DebT, execDebT, evalDebT, execDebM)+import Debian.Debianize.Types.Atoms as T (Atoms, newAtoms, DebInfo, debInfo, makeDebInfo, atomSet, Atom(..))+import Debian.Debianize.Monad (Atoms, CabalT, execCabalT, evalCabalT, execDebianT, liftCabal) import Debian.Debianize.Output (compareDebianization) import Debian.Debianize.Prelude ((~=), (~?=), (%=), (+=), (++=)) import Debian.Debianize.Types.CopyrightDescription (CopyrightDescription(..), FilesOrLicenseDescription(..), newCopyrightDescription) import Debian.Debianize.Types.SourceDebDescription (SourceDebDescription) import Debian.Policy (SourceFormat(Native3), StandardsVersion(StandardsVersion), License(OtherLicense))+-} import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel), VersionReq(SLT, GRE), Relations, parseRelations) import Debian.Version (parseDebianVersion) import Distribution.Compiler(CompilerFlavor(GHC))-import Prelude hiding (log)+import Prelude hiding (log, (.)) import System.Directory (copyFile)  main :: IO ()@@ -42,13 +50,13 @@        -- This is both a debianization script and a unit test - it        -- makes sure the debianization generated matches the one        -- checked into version control.-       log <- newAtoms >>= evalDebT (inputChangeLog >> access changelog)-       old <- newAtoms >>= execDebT (inputDebianization (T.EnvSet "/" "/" "/"))-       new <- newAtoms >>= execDebT (debianize (do debianDefaultAtoms-                                                   changelog ~?= log-                                                   customize-                                                   copyFirstLogEntry old))-       diff <- compareDebianization old new+       log <- newFlags >>= newCabalInfo >>= evalCabalT (liftCabal inputChangeLog >> access (changelog . debInfo))+       old <- newFlags >>= execDebianT inputDebianization . makeDebInfo+       new <- newFlags >>= newCabalInfo >>= execCabalT (debianize (do debianDefaults+                                                                      (changelog . debInfo) ~?= log+                                                                      customize+                                                                      copyFirstLogEntry old))+       diff <- compareDebianization old (getL debInfo new)        case diff of          "" -> return ()          s -> error $ "Debianization mismatch:\n" ++ s@@ -56,78 +64,34 @@        -- just make sure it matches:        -- writeDebianization "." new     where-      customize :: Monad m => DebT m ()+      customize :: Monad m => CabalT m ()       customize =-          do sourceFormat ~= Just Native3-             standardsVersion ~= Just (StandardsVersion 3 9 3 Nothing)-             compat ~= Just 9-             utilsPackageNameBase ~= Just "cabal-debian"-             copyright %= copyrightFn-             conflicts (BinPkgName "cabal-debian") %= (++ (rels "haskell-debian-utils (<< 3.59)"))-             depends (BinPkgName "cabal-debian") %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)"))-             depends (BinPkgName "libghc-cabal-debian-dev") %= (++ (rels "debian-policy"))-             installCabalExec (BinPkgName "cabal-debian-tests") "cabal-debian-tests" "/usr/bin"-             installCabalExec (BinPkgName "cabal-debian") "cabal-debian" "/usr/bin"-             utilsPackageNameBase ~= Just "cabal-debian"+          do (sourceFormat . debInfo) ~= Just Native3+             (standardsVersion . control . debInfo) ~= Just (StandardsVersion 3 9 3 Nothing)+             (compat . debInfo) ~= Just 9+             (utilsPackageNameBase . debInfo) ~= Just "cabal-debian"+             -- (copyright . debInfo) %= (Just . copyrightFn . fromMaybe def)+             -- (conflicts . relations . binaryDebDescription (BinPkgName "cabal-debian") . debInfo) %= (++ (rels "haskell-debian-utils (<< 3.59)"))+             (depends . relations . binaryDebDescription (BinPkgName "cabal-debian") . debInfo) %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)"))+             (depends . relations . binaryDebDescription (BinPkgName "libghc-cabal-debian-dev") . debInfo) %= (++ (rels "debian-policy"))+             (executable . debInfo) %= (Map.insert (BinPkgName "cabal-debian-tests") (InstallFile "cabal-debian-tests" Nothing Nothing "cabal-debian-tests"))+             (atomSet . debInfo) %= (Set.insert $ InstallCabalExec (BinPkgName "cabal-debian") "cabal-debian" "usr/bin")+             (utilsPackageNameBase . debInfo) ~= Just "cabal-debian"              -- extraDevDeps (BinPkgName "debian-policy")-             homepage ~= Just (pack "https://github.com/ddssff/cabal-debian")+             (homepage . control . debInfo) ~= Just (pack "https://github.com/ddssff/cabal-debian")  rels :: String -> Relations rels = either (throw . userError . show) id . parseRelations --- | Demonstrates the structure of the new copyright type.-copyrightFn :: CopyrightDescription -> CopyrightDescription-copyrightFn =-    const $ newCopyrightDescription-                    { _filesAndLicenses =       [FilesDescription { _filesPattern = "*"-                                                                  , _filesCopyright = pack (unlines [ "Copyright (c) 2007, David Fox"-                                                                                                    , "Copyright (c) 2007, Jeremy Shaw" ])-                                                                  , _filesLicense = OtherLicense "Proprietary"-                                                                  , _filesComment = Just $ pack $ unlines-                                                                                    [ "All rights reserved."-                                                                                    , ""-                                                                                    , "The packageing was adjusted to Debian conventions by Joachim Breitner"-                                                                                    , "<nomeata@debian.org> on Sat, 01 May 2010 21:16:18 +0200, and is licenced under"-                                                                                    , "the same terms as the package itself.."-                                                                                    , ""-                                                                                    , "Redistribution and use in source and binary forms, with or without"-                                                                                    , "modification, are permitted provided that the following conditions are"-                                                                                    , "met:"-                                                                                    , ""-                                                                                    , "    * Redistributions of source code must retain the above copyright"-                                                                                    , "      notice, this list of conditions and the following disclaimer."-                                                                                    , ""-                                                                                    , "    * Redistributions in binary form must reproduce the above"-                                                                                    , "      copyright notice, this list of conditions and the following"-                                                                                    , "      disclaimer in the documentation and/or other materials provided"-                                                                                    , "      with the distribution."-                                                                                    , ""-                                                                                    , "    * The names of contributors may not be used to endorse or promote"-                                                                                    , "      products derived from this software without specific prior"-                                                                                    , "      written permission."-                                                                                    , ""-                                                                                    , "THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS"-                                                                                    , "\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT"-                                                                                    , "LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR"-                                                                                    , "A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT"-                                                                                    , "OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,"-                                                                                    , "SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT"-                                                                                    , "LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,"-                                                                                    , "DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY"-                                                                                    , "THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT"-                                                                                    , "(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE"-                                                                                    , "OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." ] }]-                    , _summaryComment = Just $ pack "This package is not part of the Debian GNU/Linux distribution." }- -- | This copies the first log entry of deb1 into deb2.  Because the -- debianization process updates that log entry, we need to undo that -- update in order to get a clean comparison.-copyFirstLogEntry :: Monad m => Atoms -> DebT m ()+copyFirstLogEntry :: Monad m => DebInfo -> CabalT m () copyFirstLogEntry src =     do dst <- get-       let Just (ChangeLog (hd1 : _)) = getL T.changelog src-           Just (ChangeLog (_ : tl2)) = getL T.changelog dst-       changelog ~= Just (ChangeLog (hd1 : tl2))+       let Just (ChangeLog (hd1 : _)) = getL changelog src+           Just (ChangeLog (_ : tl2)) = getL (changelog . debInfo) dst+       (changelog . debInfo) ~= Just (ChangeLog (hd1 : tl2)) {-     get >>= \ dst ->  copyFirstLogEntry :: Atoms -> Atoms -> Atoms

@@ -1,3 +1,59 @@+haskell-cabal-debian (4.23.1) unstable; urgency=low++  * ifdefs for Cabal-1.18, 1.20, and 1.22, ghc-7.6, and 7.8.++ -- David Fox <dsf@seereason.com>  Sun, 08 Feb 2015 23:21:07 -0800++haskell-cabal-debian (4.23) unstable; urgency=low++  * Add DEB_ENABLE_TESTS = yes to rules file when appropriate+  * Add test suite build dependencies when appropriate+  * Add --no-test-suite option+  * Add --allow-debian-self-build-deps+  * Filter out self dependencies in the debian package space, not the+    cabal package space.+  * Fix generation of machine readable debian/copyright files+  * Use the homepage value found in the cabal file+  * Add travis build file++ -- David Fox <dsf@seereason.com>  Fri, 06 Feb 2015 06:25:08 -0800++haskell-cabal-debian (4.22) unstable; urgency=low++  * Big module reorganization for more type safety.++ -- David Fox <dsf@seereason.com>  Tue, 03 Feb 2015 13:22:29 -0800++haskell-cabal-debian (4.21.1) unstable; urgency=low++  * Fix --buildenvdir command line option.+  * Add an option for cabal flags++ -- David Fox <dsf@seereason.com>  Fri, 30 Jan 2015 13:46:08 -0800++haskell-cabal-debian (4.21) unstable; urgency=low++  * Split the enormous Atoms record into three layers - the innermost is+    Flags, which contains information obtained from the command line+    arguments.  Flags is also the argument to the inputCabalization+    function, which inputs a Cabal PackageDescription.  The Flags record+    is embedded in a DebInfo, which holds information related to the+    Debianization only.  The DebInfo and the PackageDescription are used+    to build the old Atoms record.  DebInfo is the state value of the+    DebianT monad, while Atoms is the state value of the CabalT monad.++    The point of all this is to ensure that a PackageDescription exists+    before we start converting the Cabalization to a Debianization.++ -- David Fox <dsf@seereason.com>  Thu, 29 Jan 2015 12:29:52 -0800++haskell-cabal-debian (4.20.2) unstable; urgency=low++  * Do not lowercase the package name when constructing the data file+    destination directory (/usr/share/<packagename>).++ -- David Fox <dsf@seereason.com>  Fri, 16 Jan 2015 05:45:23 -0800+ haskell-cabal-debian (4.20.1) unstable; urgency=low    * Fix a bug in the computation of the debian maintainer field

@@ -1,40 +0,0 @@-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/-Comment: This package is not part of the Debian GNU/Linux distribution.--Files: *-Copyright: Copyright (c) 2007, David Fox- Copyright (c) 2007, Jeremy Shaw-License: Proprietary-Comment: All rights reserved.-- The packageing was adjusted to Debian conventions by Joachim Breitner- <nomeata@debian.org> on Sat, 01 May 2010 21:16:18 +0200, and is licenced under- the same terms as the package itself..-- Redistribution and use in source and binary forms, with or without- modification, are permitted provided that the following conditions are- met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * The names of contributors may not be used to endorse or promote-      products derived from this software without specific prior-      written permission.-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -3,7 +3,7 @@ -- You can either run the @cabal-debian --debianize@, or -- for more power and flexibility you can put a @Debianize.hs@ script in -- the package's @debian@ subdirectory.--- 'Debian.Debianize.Atoms' value and pass it to the+-- 'Debian.Debianize.CabalInfo' value and pass it to the -- 'Debian.Debianize.debianize' function.  The -- 'Debian.Debianize.callDebianize' function retrieves extra arguments -- from the @CABALDEBIAN@ environment variable and calls@@ -101,7 +101,35 @@    VersionSplits.hs -} module Debian.Debianize-    ( Debian.Debianize.Finalize.debianize+    ( -- * Collect information about desired debianization+      module Debian.Debianize.BasicInfo+    , module Debian.Debianize.DebInfo+    , module Debian.Debianize.SourceDebDescription+    , module Debian.Debianize.BinaryDebDescription+    , module Debian.Debianize.CopyrightDescription+    , module Debian.Debianize.CabalInfo+      -- * State monads to carry the collected information, command line options+    , module Debian.Debianize.Monad+    , module Debian.Debianize.Options+      -- * Functions for maping Cabal name and version number to Debian name+    , module Debian.Debianize.DebianName+      -- * Specific details about the particular packages and versions in the Debian repo+    , module Debian.Debianize.Details+      -- * Functions to configure some useful packaging idioms - web server packages,+      -- tight install dependencies, etc.+    , module Debian.Debianize.Goodies+      -- * IO functions for reading debian or cabal packaging info+    , module Debian.Debianize.InputDebian+    , module Debian.Debianize.InputCabal+      -- * Finish computing the debianization and output the result+    , module Debian.Debianize.Finalize+    , module Debian.Debianize.Output+      -- * Utility functions+    , module Debian.Debianize.Prelude+    , module Debian.Debianize.VersionSplits+    , module Debian.Policy+{-+    , Debian.Debianize.Finalize.debianize     , Debian.Debianize.Finalize.finalizeDebianization      , Debian.Debianize.Output.doDebianizeAction@@ -119,12 +147,9 @@     , Debian.Debianize.Goodies.doWebsite     , Debian.Debianize.Goodies.doBackups -    , Debian.Debianize.Input.inputDebianization-    , Debian.Debianize.Input.inputDebianizationFile-    , Debian.Debianize.Input.inputChangeLog--    -- * Deb monad - 'Debian.Debianize.Monad'-    , DebT, runDebT, execDebT, evalDebT, DebM, runDebM, execDebM, evalDebM+    , Debian.Debianize.InputDebian.inputDebianization+    , Debian.Debianize.InputDebian.inputDebianizationFile+    , Debian.Debianize.InputDebian.inputChangeLog      , Debian.Debianize.DebianName.mapCabal     , Debian.Debianize.DebianName.splitCabal@@ -137,6 +162,7 @@     , Debian.Debianize.Prelude.buildDebVersionMap     , Debian.Debianize.Prelude.dpkgFileMap     , Debian.Debianize.Prelude.debOfFile+    -- * Lens operators     , (~=)     , (~?=)     , (%=)@@ -144,23 +170,25 @@     , (++=)     , (+++=) -    -- * TBD--    , module Debian.Debianize.Types-    , module Debian.Debianize.Types.Atoms-    , module Debian.Policy+-}     ) where -import Debian.Debianize.DebianName-import Debian.Debianize.Details-import Debian.Debianize.Finalize-import Debian.Debianize.Goodies-import Debian.Debianize.Input-import Debian.Debianize.Monad-import Debian.Debianize.Prelude-import Debian.Debianize.Types-import Debian.Debianize.Types.Atoms-import Debian.Debianize.Options-import Debian.Debianize.Output-import Debian.Debianize.SubstVars-import Debian.Policy+import Debian.Debianize.CabalInfo -- (debianNameMap, debInfo, epochMap, newAtoms, packageDescription, PackageInfo, packageInfo, showAtoms)+import Debian.Debianize.BasicInfo+import Debian.Debianize.BinaryDebDescription+import Debian.Debianize.CopyrightDescription+import Debian.Debianize.DebInfo -- (Atom(..), atomSet, changelog, compat, control, copyright, DebInfo, file, flags, install, installCabalExec, installCabalExecTo, installData, installDir, installInit, installTo, intermediateFiles, link, logrotateStanza, makeDebInfo, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, warning, watch, apacheSite, backups, buildDir, comments, debVersion, execMap, executable, extraDevDeps, extraLibMap, InstallFile(..), maintainerOption, missingDependencies, noDocumentationLibrary, noProfilingLibrary, official, omitLTDeps, omitProfVersionDeps, revision, Server(..), serverInfo, Site(..), sourceArchitectures, sourcePackageName, uploadersOption, utilsPackageNameBase, website, xDescription, overrideDebianNameBase)+import Debian.Debianize.DebianName (mapCabal, splitCabal, remapCabal)+import Debian.Debianize.Details (debianDefaults)+import Debian.Debianize.Finalize (debianize)+import Debian.Debianize.Goodies -- (doBackups, doExecutable, doServer, doWebsite, tightDependencyFixup)+import Debian.Debianize.InputDebian (inputChangeLog, inputDebianization, inputDebianizationFile)+import Debian.Debianize.InputCabal (inputCabalization)+import Debian.Debianize.Monad (CabalM, CabalT, evalCabalM, evalCabalT, execCabalM, execCabalT, runCabalM, runCabalT, DebianT, execDebianT, evalDebianT, liftCabal)+import Debian.Debianize.Options (compileArgs)+import Debian.Debianize.Output (compareDebianization, describeDebianization, doDebianizeAction, runDebianizeScript, validateDebianization, writeDebianization)+import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), buildDebVersionMap, debOfFile, dpkgFileMap, withCurrentDirectory, (~=), (~?=))+import Debian.Debianize.SourceDebDescription+import Debian.Debianize.SubstVars (substvars)+import Debian.Debianize.VersionSplits (DebBase(DebBase))+import Debian.Policy (accessLogBaseName, apacheAccessLog, apacheErrorLog, apacheLogDirectory, appLogBaseName, Area(..), databaseDirectory, debianPackageVersion, errorLogBaseName, fromCabalLicense, getCurrentDebianUser, getDebhelperCompatLevel, getDebianStandardsVersion, haskellMaintainer, License(..), PackageArchitectures(..), PackagePriority(..), parseMaintainer, parsePackageArchitectures, parseStandardsVersion, parseUploaders, readLicense, readPriority, readSection, readSourceFormat, Section(..), serverAccessLog, serverAppLog, serverLogDirectory, SourceFormat(..), StandardsVersion(..), toCabalLicense)

@@ -0,0 +1,153 @@+-- | The basic information required to load a Cabal or Debian package description.+{-# LANGUAGE CPP, DeriveDataTypeable, TemplateHaskell #-}+module Debian.Debianize.BasicInfo+    ( -- * Types+      Flags(..)+    , EnvSet(..)+    , DebAction(..)+    , DebType(..)+      -- * Lenses+    , verbosity+    , dryRun+    , validate+    , debAction+    , compilerFlavor+    , cabalFlagAssignments+    , buildEnv+      -- * State Monad+    , flagOptions+    , newFlags+    ) where++import Control.Applicative ((<$>))+import Control.Category ((.))+import Control.Monad.State (StateT, execStateT)+import Control.Monad.Trans (MonadIO)+import Data.Char (toLower, toUpper)+import Data.Default (Default(def))+import Data.Generics (Data, Typeable)+import Data.Lens.Template (nameMakeLens)+import Data.Monoid (Monoid(..))+import Data.Set as Set (fromList, Set, union)+import Debian.Debianize.Prelude ((%=), read', (~=))+import Debian.Orphans ()+import Distribution.Compiler (CompilerFlavor(..))+import Distribution.PackageDescription as Cabal (FlagName(FlagName))+import Prelude hiding ((.), break, lines, log, null, readFile, sum)+import System.Console.GetOpt (ArgDescr(ReqArg, NoArg), ArgOrder(Permute), getOpt, OptDescr(Option))+import System.Environment (getArgs)+import System.FilePath ((</>))+import Text.Read (readMaybe)++-- | This record supplies enough information to locate and load a debianization+-- or a cabal file from the IO monad.+data Flags = Flags+    {+      verbosity_ :: Int+    -- ^ Run with progress messages at the given level of verboseness.+    , dryRun_ :: Bool+    -- ^ Don't write any files or create any directories, just explain+    -- what would have been done.+    , validate_ :: Bool+    -- ^ Fail if the debianization already present doesn't match the+    -- one we are going to generate closely enough that it is safe to+    -- debianize during the run of dpkg-buildpackage, when Setup+    -- configure is run.  Specifically, the version number in the top+    -- changelog entry must match, and the sets of package names in+    -- the control file must match.+    , debAction_ :: DebAction+    -- ^ What to do - Usage, Debianize or Substvar+    , compilerFlavor_ :: CompilerFlavor+    -- ^ Which compiler should we generate library packages for?  In theory a single+    -- deb could handle multiple compiler flavors, but the support tools are not ready+    -- for this as of right now (28 Jan 2015.)+    , cabalFlagAssignments_ :: Set (FlagName, Bool)+    -- ^ Flags to pass to Cabal function finalizePackageDescription,+    -- this can be used to control the flags in the cabal file.  It+    -- can be supplied to the cabal-debian binary using the --flags+    -- option.+    , buildEnv_ :: EnvSet+    -- ^ Directory containing the build environment for which the+    -- debianization will be generated.  This determines which+    -- compiler will be available, which in turn determines which+    -- basic libraries can be provided by the compiler.  By default+    -- all the paths in EnvSet are "/".+    } deriving (Eq, Ord, Show, Data, Typeable)++data EnvSet = EnvSet+    { cleanOS :: FilePath  -- ^ The output of the debootstrap command+    , dependOS :: FilePath -- ^ An environment with build dependencies installed+    , buildOS :: FilePath  -- ^ An environment where we have built a package+    } deriving (Eq, Ord, Show, Data, Typeable)++data DebAction = Usage | Debianize | SubstVar DebType deriving (Read, Show, Eq, Ord, Data, Typeable)++-- | A redundant data type, too lazy to expunge.+data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable)++instance Default Flags where+    def = Flags+          { verbosity_ = 1+          , debAction_ = Debianize+          , dryRun_ = False+          , validate_ = False+          , compilerFlavor_ = GHC+          , cabalFlagAssignments_ = mempty+          , buildEnv_ = EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}+          }++-- Build the lenses+$(let f s = case s of+              (_ : _) | last s == '_' -> Just (init s)+              _ -> Nothing in+  nameMakeLens ''Flags f)++-- | Command line options which build a function that modifies a+-- state monad value of type 'Flags'+flagOptions :: MonadIO m => [OptDescr (StateT Flags m ())]+flagOptions =+    [ Option "v" ["verbose"] (ReqArg (\ s -> verbosity ~= (read' (\ s' -> error $ "verbose: " ++ show s') s :: Int)) "number")+             "Change the amount of progress messages generated",+      Option "n" ["dry-run", "compare"] (NoArg (dryRun ~= True))+             "Just compare the existing debianization to the one we would generate.",+      Option "h?" ["help"] (NoArg (debAction ~= Usage))+             "Show this help text",+      Option "" ["ghc"] (NoArg (compilerFlavor ~= GHC)) "Generate packages for GHC - same as --with-compiler GHC",+#if MIN_VERSION_Cabal(1,22,0)+      Option "" ["ghcjs"] (NoArg (compilerFlavor ~= GHCJS)) "Generate packages for GHCJS - same as --with-compiler GHCJS",+#endif+      Option "" ["hugs"] (NoArg (compilerFlavor ~= Hugs)) "Generate packages for Hugs - same as --with-compiler GHC",+      Option "" ["with-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)+                                                        (\ hc -> compilerFlavor ~= hc)+                                                        (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")+             (unlines [ "Generate packages for this CompilerFlavor" ]),+      Option "f" ["flags"] (ReqArg (\ fs -> cabalFlagAssignments %= (Set.union (Set.fromList (flagList fs)))) "FLAGS")+      -- Option "f" ["flags"] (ReqArg (\ fs p -> foldl (\ p' x -> p' {cabalFlagAssignments_ = Set.insert x (cabalFlagAssignments_ p')}) p (flagList fs)) "FLAGS")+             (unlines [ "Flags to pass to the finalizePackageDescription function in"+                      , "Distribution.PackageDescription.Configuration when loading the cabal file."]),+      Option "" ["debianize"] (NoArg (debAction ~= Debianize))+             "Deprecated - formerly used to get what is now the normal benavior.",+      Option "" ["substvar"] (ReqArg (\ name -> debAction ~= (SubstVar (read' (\ s -> error $ "substvar: " ++ show s) name))) "Doc, Prof, or Dev")+             (unlines [ "With this option no debianization is generated.  Instead, the list"+                      , "of dependencies required for the dev, prof or doc package (depending"+                      , "on the argument) is printed to standard output.  These can be added"+                      , "to the appropriate substvars file.  (This is an option whose use case"+                      , "is lost in the mists of time.)"]),+      Option "" ["buildenvdir"] (ReqArg (\ s -> buildEnv ~= EnvSet {cleanOS = s </> "clean", dependOS = s </> "depend", buildOS = s </> "build"}) "PATH")+             "Directory containing the three build environments, clean, depend, and build.",+      Option "f" ["cabal-flags"] (ReqArg (\ s -> cabalFlagAssignments %= (Set.union (fromList (flagList s)))) "FLAG FLAG ...")+             "Flags to pass to cabal configure with the --flags= option "+      ]++-- Lifted from Distribution.Simple.Setup, since it's not exported.+flagList :: String -> [(FlagName, Bool)]+flagList = map tagWithValue . words+  where tagWithValue ('-':name) = (FlagName (map toLower name), False)+        tagWithValue name       = (FlagName (map toLower name), True)++-- | Use 'flagOptions' to build a new 'Flags' value from the command+-- line arguments in the environment.+newFlags :: IO Flags+newFlags = do+  (fns, _, _) <- getOpt Permute flagOptions <$> getArgs+  execStateT (sequence fns) def

@@ -0,0 +1,140 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell #-}+{-# OPTIONS -Wall #-}+module Debian.Debianize.BinaryDebDescription+    ( Canonical(canonical)+    , BinaryDebDescription+    , newBinaryDebDescription+    , package+    , description+    , packageType+    , architecture+    , binarySection+    , binaryPriority+    , essential+    , relations++    , PackageType(..)++    , PackageRelations+    , newPackageRelations+    , depends+    , recommends+    , suggests+    , preDepends+    , breaks+    , conflicts+    , provides+    , replaces+    , builtUsing+    ) where++import Data.Function (on)+import Data.Generics (Data, Typeable)+import Data.Lens.Template (makeLenses)+import Data.List (sort, sortBy)+import Data.Monoid (Monoid(..))+import Data.Text (Text)+import Debian.Policy (PackageArchitectures, PackagePriority, Section)+import Debian.Relation (BinPkgName, Relations)+import Prelude hiding ((.))++class Canonical a where+    canonical :: a -> a++-- | This type represents a section of the control file other than the+-- first, which in turn represent one of the binary packages or debs+-- produced by this debianization.+data BinaryDebDescription+    = BinaryDebDescription+      { _package :: BinPkgName+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package>+      , _packageType :: Maybe PackageType+      , _architecture :: Maybe PackageArchitectures+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Architecture>+      , _binarySection :: Maybe Section+      , _binaryPriority :: Maybe PackagePriority+      , _essential :: Maybe Bool+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Essential>+      , _description :: Maybe Text+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Description>+      , _relations :: PackageRelations+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>+      } deriving (Eq, Ord, Read, Show, Data, Typeable)++-- ^ The different types of binary debs we can produce from a haskell package+data PackageType+    = Development   -- ^ The libghc-foo-dev package.+    | Profiling     -- ^ The libghc-foo-prof package.+    | Documentation -- ^ The libghc-foo-doc package.+    | Exec          -- ^ A package related to a particular executable, perhaps+                    -- but not necessarily a server.+    | Utilities     -- ^ A package that holds the package's data files+                    -- and any executables not assigned to other+                    -- packages.+    | Source        -- ^ The source package (not a binary deb actually.)+    | HaskellSource -- ^ The source package of a haskell library (add+                    -- prefix haskell- to source package name.)+    | Cabal         -- ^ This is used to construct the value for+                    -- DEB_CABAL_PACKAGE in the rules file+    deriving (Eq, Ord, Show, Read, Data, Typeable)++-- ^ Package interrelationship information.+data PackageRelations+    = PackageRelations+      { _depends :: Relations+      , _recommends :: Relations+      , _suggests :: Relations+      , _preDepends :: Relations+      , _breaks :: Relations+      , _conflicts :: Relations+      , _provides :: Relations+      , _replaces :: Relations+      , _builtUsing :: Relations+      } deriving (Eq, Ord, Read, Show, Data, Typeable)++instance Canonical [BinaryDebDescription] where+    canonical xs = sortBy (compare `on` _package) (map canonical xs)++instance Canonical BinaryDebDescription where+    canonical x = x {_relations = canonical (_relations x)}++instance Canonical PackageRelations where+    canonical x = x { _depends = canonical (_depends x)+                    , _recommends = canonical (_recommends x)+                    , _suggests = canonical (_suggests x)+                    , _preDepends = canonical (_preDepends x)+                    , _breaks = canonical (_breaks x)+                    , _conflicts = canonical (_conflicts x)+                    , _provides = canonical (_provides x)+                    , _replaces = canonical (_replaces x)+                    , _builtUsing = canonical (_builtUsing x) }++instance Canonical Relations where+    canonical xss = sort xss++newBinaryDebDescription :: BinPkgName -> BinaryDebDescription+newBinaryDebDescription name =+    BinaryDebDescription+      { _package = name+      , _packageType = Nothing+      , _architecture = Nothing+      , _binarySection = Nothing+      , _binaryPriority = Nothing+      , _essential = Nothing+      , _description = mempty+      , _relations = newPackageRelations }++newPackageRelations :: PackageRelations+newPackageRelations =+    PackageRelations+      { _depends = []+      , _recommends = []+      , _suggests = []+      , _preDepends = []+      , _breaks = []+      , _conflicts = []+      , _provides = []+      , _replaces = []+      , _builtUsing = [] }++$(makeLenses [''BinaryDebDescription, ''PackageRelations])

@@ -6,35 +6,38 @@     ) where  import Control.Applicative ((<$>))+import Control.Category ((.)) import Control.Monad.State (MonadState(get)) import Control.Monad.Trans (MonadIO) import Data.Char (isSpace, toLower) import Data.Function (on) import Data.Lens.Lazy (access, getL)-import Data.List as List (filter, map, minimumBy, nub)+import Data.List as List (filter, groupBy, map, minimumBy, nub, sortBy) import Data.Map as Map (lookup, Map) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)-import Data.Set as Set (Set, member, toList, fromList, map, fold, union, empty)+import Data.Set as Set (empty, fold, fromList, map, member, Set, singleton, toList, union) import Data.Version (showVersion, Version)+import Debian.Debianize.BasicInfo (buildEnv, compilerFlavor, EnvSet(dependOS)) import Debian.Debianize.Bundled (builtIn)+import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (mkPkgName, mkPkgName')-import Debian.Debianize.Monad as Monad (Atoms, DebT)-import qualified Debian.Debianize.Types as T (buildDepends, buildDependsIndep, debianNameMap, epochMap, execMap, extraLibMap, missingDependencies, noDocumentationLibrary, noProfilingLibrary, omitProfVersionDeps)-import Debian.Debianize.Types.Atoms (EnvSet(dependOS), buildEnv, compilerFlavors)-import qualified Debian.Debianize.Types.BinaryDebDescription as B (PackageType(Development, Documentation, Profiling))+import Debian.Debianize.Monad as Monad (CabalInfo, CabalT)+import qualified Debian.Debianize.BinaryDebDescription as B+import qualified Debian.Debianize.CabalInfo as A+import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (packageRangesFromVersionSplits) import Debian.Orphans ()-import Debian.Relation (BinPkgName(..), Relation(..), Relations, checkVersionReq)+import Debian.Relation (BinPkgName(..), checkVersionReq, Relation(..), Relations) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..), Relations, VersionReq(EEQ, GRE, LTE, SGR, SLT)) import Debian.Version (DebianVersion, parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..))-import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))+import Distribution.Package (Dependency(..), PackageName(PackageName)) import Distribution.PackageDescription (PackageDescription)-import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..))-import qualified Distribution.PackageDescription as Cabal (PackageDescription(buildDepends, executables, package))+import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(..), BuildInfo(buildTools, extraLibs, pkgconfigDepends), Executable(..), TestSuite(..))+import qualified Distribution.PackageDescription as Cabal (PackageDescription(buildDepends, executables, testSuites)) import Distribution.Version (anyVersion, asVersionIntervals, earlierVersion, foldVersionRange', fromVersionIntervals, intersectVersionRanges, isNoVersion, laterVersion, orEarlierVersion, orLaterVersion, toVersionIntervals, unionVersionRanges, VersionRange, withinVersion) import Distribution.Version.Invert (invertVersionRange)-import Prelude hiding (init, log, map, unlines, unlines, writeFile)+import Prelude hiding ((.), init, log, map, unlines, unlines, writeFile) import System.Directory (findExecutable) import System.Exit (ExitCode(ExitSuccess)) import System.IO.Unsafe (unsafePerformIO)@@ -47,13 +50,19 @@   | ExtraLibs Relations     deriving (Eq, Show) --- | In cabal a self dependency probably means the library is needed--- while building the executables.  In debian it would mean that the--- package needs an earlier version of itself to build, so we use this--- to filter such dependencies out.-selfDependency :: PackageIdentifier -> Dependency_ -> Bool-selfDependency pkgId (BuildDepends (Dependency name _)) = name == pkgName pkgId-selfDependency _ _ = False+-- | Naive conversion of Cabal build dependencies to Debian+-- dependencies will usually result in a self dependency, due to the+-- fact that a Cabal executable often depends on the associated+-- library to build.  Due to the fact that Debian build dependencies+-- are global to the package, this results in unwanted self+-- dependencies, which usually need to be filtered out.+-- Unfortunately, some Debian packages actually do depend on an+-- earlier version of themselves to build (e.g. most compilers.)  So a+-- command line option is probably necessary.+--+-- selfDependency :: PackageIdentifier -> Dependency_ -> Bool+-- selfDependency pkgId (BuildDepends (Dependency name _)) = name == pkgName pkgId+-- selfDependency _ _ = False  unboxDependency :: Dependency_ -> Maybe Dependency unboxDependency (BuildDepends d) = Just d@@ -63,30 +72,51 @@  -- |Debian packages don't have per binary package build dependencies, -- so we just gather them all up here.-allBuildDepends :: Monad m => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> DebT m [Dependency_]-allBuildDepends buildDepends' buildTools' pkgconfigDepends' extraLibs' =-    do atoms <- get-       return $ nub $ List.map BuildDepends buildDepends' ++-                      List.map BuildTools buildTools' ++-                      List.map PkgConfigDepends pkgconfigDepends' ++-                      [ExtraLibs (fixDeps atoms extraLibs')]+allBuildDepends :: Monad m => Bool -> PackageDescription -> CabalT m [Dependency_]+allBuildDepends noTestSuite pkgDesc =+    allBuildDepends'+      (mergeCabalDependencies $+       Cabal.buildDepends pkgDesc +++            concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc) +++            (if noTestSuite then [] else concatMap (Cabal.targetBuildDepends . Cabal.testBuildInfo) $ filter Cabal.testEnabled $ (Cabal.testSuites pkgDesc)))+      (mergeCabalDependencies $ concatMap buildTools $ allBuildInfo pkgDesc)+      (mergeCabalDependencies $ concatMap pkgconfigDepends $ allBuildInfo pkgDesc)+      (concatMap extraLibs . allBuildInfo $ pkgDesc) >>=+    return {- . List.filter (not . selfDependency (Cabal.package pkgDesc)) -}     where-      fixDeps :: Atoms -> [String] -> Relations+      allBuildDepends' :: Monad m => [Dependency] -> [Dependency] -> [Dependency] -> [String] -> CabalT m [Dependency_]+      allBuildDepends' buildDepends' buildTools' pkgconfigDepends' extraLibs' =+          do atoms <- get+             return $ nub $ List.map BuildDepends buildDepends' +++                            List.map BuildTools buildTools' +++                            List.map PkgConfigDepends pkgconfigDepends' +++                            [ExtraLibs (fixDeps atoms extraLibs')]++      fixDeps :: CabalInfo -> [String] -> Relations       fixDeps atoms xs =           concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ List.map toLower cab ++ "-dev")) Nothing Nothing]]-                                        (Map.lookup cab (getL T.extraLibMap atoms))) xs+                                        (Map.lookup cab (getL (D.extraLibMap . A.debInfo) atoms))) xs +-- | Take the intersection of all the dependencies on a given package name+mergeCabalDependencies :: [Dependency] -> [Dependency]+mergeCabalDependencies =+    List.map (foldl1 (\ (Dependency name range1) (Dependency _ range2) -> Dependency name (intersectVersionRanges range1 range2))) . groupBy ((==) `on` dependencyPackage) . sortBy (compare `on` dependencyPackage)+    where+      dependencyPackage (Dependency x _) = x+ -- The haskell-cdbs package contains the hlibrary.mk file with -- the rules for building haskell packages.-debianBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> DebT m D.Relations+debianBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDeps pkgDesc =-    do hcs <- access compilerFlavors+    do hc <- access (compilerFlavor . D.flags . A.debInfo)+       let hcs = singleton hc -- vestigial        let hcTypePairs =                fold union empty $-                  Set.map (\ hc -> Set.map (hc,) $ hcPackageTypes hc) hcs-       cDeps <- cabalDeps hcTypePairs-       bDeps <- access T.buildDepends-       prof <- not <$> access T.noProfilingLibrary+                  Set.map (\ hc' -> Set.map (hc',) $ hcPackageTypes hc') hcs+       noTestSuite <- access (D.noTestSuite . A.debInfo)+       cDeps <- allBuildDepends noTestSuite pkgDesc >>= mapM (buildDependencies hcTypePairs) >>= return . {-nub .-} concat+       bDeps <- access (S.buildDepends . D.control . A.debInfo)+       prof <- not <$> access (D.noProfilingLibrary . A.debInfo)        let xs = nub $ [[D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion ("7.0" :: String)))) Nothing],                        [D.Rel (D.BinPkgName "haskell-devscripts") (Just (D.GRE (parseDebianVersion ("0.8" :: String)))) Nothing],                        anyrel "cdbs"] ++@@ -95,84 +125,63 @@                                               then [anyrel "ghc-prof"]                                               else []                        else []) ++-#if MIN_VERSION_Cabal(1,21,0)+#if MIN_VERSION_Cabal(1,22,0)                       (if member GHCJS hcs then [anyrel "ghcjs"] else []) ++ #endif                        bDeps ++                        cDeps        filterMissing xs     where-      cabalDeps hcTypePairs =-          do deps <- allBuildDepends-                          (Cabal.buildDepends pkgDesc ++ concatMap (Cabal.targetBuildDepends . Cabal.buildInfo) (Cabal.executables pkgDesc))-                          (concatMap buildTools . allBuildInfo $ pkgDesc)-                          (concatMap pkgconfigDepends . allBuildInfo $ pkgDesc)-                          (concatMap extraLibs . allBuildInfo $ pkgDesc)-             mapM (buildDependencies hcTypePairs) (List.filter (not . selfDependency (Cabal.package pkgDesc)) deps) >>= return . concat       hcPackageTypes :: CompilerFlavor -> Set B.PackageType       hcPackageTypes GHC = fromList [B.Development, B.Profiling]-#if MIN_VERSION_Cabal(1,21,0)+#if MIN_VERSION_Cabal(1,22,0)       hcPackageTypes GHCJS = fromList [B.Development] #endif       hcPackageTypes hc = error $ "Unsupported compiler flavor: " ++ show hc  -debianBuildDepsIndep :: (MonadIO m, Functor m) => PackageDescription -> DebT m D.Relations+debianBuildDepsIndep :: (MonadIO m, Functor m) => PackageDescription -> CabalT m D.Relations debianBuildDepsIndep pkgDesc =-    do hcs <- access compilerFlavors-       doc <- get >>= return . not . getL T.noDocumentationLibrary-       bDeps <- get >>= return . getL T.buildDependsIndep-       cDeps <- cabalDeps+    do hc <- access (compilerFlavor . D.flags . A.debInfo)+       let hcs = singleton hc -- vestigial+       doc <- not <$> access (D.noDocumentationLibrary . A.debInfo)+       noTestSuite <- access (D.noTestSuite . A.debInfo)+       bDeps <- access (S.buildDependsIndep . D.control . A.debInfo)+       cDeps <- allBuildDepends noTestSuite pkgDesc >>= mapM docDependencies        let xs = nub $ if doc                       then (if member GHC hcs then [anyrel "ghc-doc"] else []) ++-#if MIN_VERSION_Cabal(1,21,0)+#if MIN_VERSION_Cabal(1,22,0)                            (if member GHCJS hcs then [anyrel "ghcjs"] else []) ++ #endif                            bDeps ++ concat cDeps                       else []        filterMissing xs-    where-      cabalDeps =-          do deps <- allBuildDepends-                           (Cabal.buildDepends pkgDesc) (concatMap buildTools . allBuildInfo $ pkgDesc)-                           (concatMap pkgconfigDepends . allBuildInfo $ pkgDesc) (concatMap extraLibs . allBuildInfo $ pkgDesc)-             let deps' = List.filter (not . selfDependency (Cabal.package pkgDesc)) deps-             mapM docDependencies deps'-{--      cabalDeps deb =-          concat . List.map (\ x -> evalDebM (docDependencies x) deb)-                     $ List.filter (not . selfDependency (Cabal.package pkgDesc))-                     $ evalDebM-                         (allBuildDepends-                           (Cabal.buildDepends pkgDesc) (concatMap buildTools . allBuildInfo $ pkgDesc)-                           (concatMap pkgconfigDepends . allBuildInfo $ pkgDesc) (concatMap extraLibs . allBuildInfo $ pkgDesc))-                         deb--}  -- | The documentation dependencies for a package include the -- documentation package for any libraries which are build -- dependencies, so we have access to all the cross references.-docDependencies :: (MonadIO m, Functor m) => Dependency_ -> DebT m D.Relations+docDependencies :: (MonadIO m, Functor m) => Dependency_ -> CabalT m D.Relations docDependencies (BuildDepends (Dependency name ranges)) =-    do hcs <- access compilerFlavors-       omitProfDeps <- access T.omitProfVersionDeps-       concat <$> mapM (\ hc -> dependencies hc B.Documentation name ranges omitProfDeps) (toList hcs)+    do hc <- access (compilerFlavor . D.flags . A.debInfo)+       let hcs = singleton hc -- vestigial+       omitProfDeps <- access (D.omitProfVersionDeps . A.debInfo)+       concat <$> mapM (\ hc' -> dependencies hc' B.Documentation name ranges omitProfDeps) (toList hcs) docDependencies _ = return []  -- | The Debian build dependencies for a package include the profiling -- libraries and the documentation packages, used for creating cross -- references.  Also the packages associated with extra libraries.-buildDependencies :: (MonadIO m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> DebT m D.Relations+buildDependencies :: (MonadIO m, Functor m) => Set (CompilerFlavor, B.PackageType) -> Dependency_ -> CabalT m D.Relations buildDependencies hcTypePairs (BuildDepends (Dependency name ranges)) =-    access T.omitProfVersionDeps >>= \ omitProfDeps ->+    access (D.omitProfVersionDeps . A.debInfo) >>= \ omitProfDeps ->     concat <$> mapM (\ (hc, typ) -> dependencies hc typ name ranges omitProfDeps) (toList hcTypePairs) buildDependencies _ dep@(ExtraLibs _) =-    do mp <- access T.execMap+    do mp <- access (D.execMap . A.debInfo)        return $ concat $ adapt mp dep buildDependencies _ dep =     case unboxDependency dep of       Just (Dependency _name _ranges) ->-          do mp <- get >>= return . getL T.execMap+          do mp <- get >>= return . getL (D.execMap . A.debInfo)              return $ concat $ adapt mp dep       Nothing ->           return []@@ -217,9 +226,9 @@ -- | Turn a cabal dependency into debian dependencies.  The result -- needs to correspond to a single debian package to be installed, -- so we will return just an OrRelation.-dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> DebT m Relations+dependencies :: MonadIO m => CompilerFlavor -> B.PackageType -> PackageName -> VersionRange -> Bool -> CabalT m Relations dependencies hc typ name cabalRange omitProfVersionDeps =-    do nameMap <- access T.debianNameMap+    do nameMap <- access A.debianNameMap        -- Compute a list of alternative debian dependencies for        -- satisfying a cabal dependency.  The only caveat is that        -- we may need to distribute any "and" dependencies implied@@ -289,18 +298,18 @@           -> PackageName           -> CompilerFlavor           -> [D.Relation]-          -> DebT m [D.Relation]+          -> CabalT m [D.Relation] doBundled typ name hc rels =     mapM doRel rels >>= return . concat     where       -- If a library is built into the compiler, this is the debian       -- package name the compiler will conflict with.       comp = D.Rel (compilerPackageName hc typ) Nothing Nothing-      doRel :: MonadIO m => D.Relation -> DebT m [D.Relation]+      doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation]       doRel rel@(D.Rel dname req _) = do         -- gver <- access ghcVersion-        splits <- access T.debianNameMap-        root <- access buildEnv >>= return . dependOS+        splits <- access A.debianNameMap+        root <- access (buildEnv . D.flags . A.debInfo) >>= return . dependOS         -- Look at what version of the package is provided by the compiler.         atoms <- get         -- What version of this package (if any) does the compiler provide?@@ -331,7 +340,7 @@       compilerPackageName GHC B.Profiling = D.BinPkgName "ghc-prof"       compilerPackageName GHC B.Development = D.BinPkgName "ghc"       compilerPackageName GHC _ = D.BinPkgName "ghc" -- whatevs-#if MIN_VERSION_Cabal(1,21,0)+#if MIN_VERSION_Cabal(1,22,0)       compilerPackageName GHCJS B.Documentation = D.BinPkgName "ghcjs"       compilerPackageName GHCJS B.Profiling = error "Profiling not supported for GHCJS"       compilerPackageName GHCJS B.Development = D.BinPkgName "ghcjs"@@ -353,23 +362,23 @@              B.PackageType  -- Documentation, Profiling, Development...           -> PackageName    -- Cabal package name           -> [D.Relation]   -- Original set of debian dependencies-          -> DebT m [D.Relation] -- Modified debian dependencies accounting for the packages the compiler provides+          -> CabalT m [D.Relation] -- Modified debian dependencies accounting for the packages the compiler provides doBundled hc typ name rels =     concat <$> mapM doRel rels     where-      doRel :: MonadIO m => D.Relation -> DebT m [D.Relation]+      doRel :: MonadIO m => D.Relation -> CabalT m [D.Relation]       doRel rel@(D.Rel dname req _) = do         hc <- access -}  -- Convert a cabal version to a debian version, adding an epoch number if requested-debianVersion' :: Monad m => PackageName -> Version -> DebT m DebianVersion+debianVersion' :: Monad m => PackageName -> Version -> CabalT m DebianVersion debianVersion' name v =     do atoms <- get-       return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.epochMap atoms)) ++ showVersion v)+       return $ parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL A.epochMap atoms)) ++ showVersion v) -debianVersion'' :: Atoms -> PackageName -> Version -> DebianVersion-debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL T.epochMap atoms)) ++ showVersion v)+debianVersion'' :: CabalInfo -> PackageName -> Version -> DebianVersion+debianVersion'' atoms name v = parseDebianVersion (maybe "" (\ n -> show n ++ ":") (Map.lookup name (getL A.epochMap atoms)) ++ showVersion v)  data Rels a = And {unAnd :: [Rels a]} | Or {unOr :: [Rels a]} | Rel' {unRel :: a} deriving Show @@ -382,7 +391,7 @@ canonical (And rels) = And $ concatMap (unAnd . canonical) rels canonical (Or rels) = And . List.map Or $ sequence $ List.map (concat . List.map unOr . unAnd . canonical) $ rels -filterMissing :: Monad m => [[Relation]] -> DebT m [[Relation]]+filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]] filterMissing rels =     get >>= \ atoms -> return $-    List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (getL T.missingDependencies atoms)))) rels)+    List.filter (/= []) (List.map (List.filter (\ (Rel name _ _) -> not (Set.member name (getL (D.missingDependencies . A.debInfo) atoms)))) rels)

@@ -13,26 +13,26 @@     ) where  import Control.DeepSeq (force)-import Control.Exception (try, SomeException)+import Control.Exception (SomeException, try) import Data.Char (toLower) import Data.Function (on) import Data.Function.Memoize (memoize2, memoize3)-import Data.List (sortBy, isPrefixOf)+import Data.List (isPrefixOf, sortBy) import Data.Map as Map (Map)-import Data.Maybe (mapMaybe, listToMaybe)-import Data.Version (Version(..), parseVersion)-import Debian.Debianize.VersionSplits (DebBase(DebBase), VersionSplits, cabalFromDebian')-import Debian.GHC ({- Memoizable instances -})+import Data.Maybe (listToMaybe, mapMaybe)+import Data.Version (parseVersion, Version(..))+import Debian.Debianize.VersionSplits (cabalFromDebian', DebBase(DebBase), VersionSplits)+import Debian.GHC () import Debian.Relation (BinPkgName(..))-import Debian.Relation.ByteString()+import Debian.Relation.ByteString () import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion)-import Distribution.Simple.Compiler (CompilerFlavor(..), {-PackageDB(GlobalPackageDB), compilerFlavor-})-import Distribution.Package (PackageIdentifier(..), PackageName(..) {-, Dependency(..)-})+import Distribution.Package (PackageIdentifier(..), PackageName(..))+import Distribution.Simple.Compiler (CompilerFlavor(..)) import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess) import System.Unix.Chroot (useEnv)-import Text.Regex.TDFA ((=~)) import Text.ParserCombinators.ReadP (readP_to_S)+import Text.Regex.TDFA ((=~))  -- | Find out what version, if any, of a cabal library is built into -- the newest version of haskell compiler hc in environment root.  For

@@ -0,0 +1,116 @@+-- | This module holds a long list of lenses that access the Atoms+-- record, the record that holds the input data from which the+-- debianization is to be constructed.+{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings, TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+module Debian.Debianize.CabalInfo+    ( -- * Types+      CabalInfo+    , PackageInfo(PackageInfo, cabalName, devDeb, docDeb, profDeb)+      -- * Lenses+    , packageDescription+    , debInfo+    , debianNameMap+    , epochMap+    , packageInfo+      -- * Builder+    , newCabalInfo+    ) where++import Control.Category ((.))+import Control.Monad (unless)+import Control.Monad.State (execStateT)+import Control.Monad.Trans (liftIO)+import Data.Generics (Data, Typeable)+import Data.Lens.Lazy (access)+import Data.Lens.Template (nameMakeLens)+import Data.List as List (init, null)+import Data.Map as Map (Map)+import Data.Monoid (Monoid(..))+import Data.Text as Text (null, pack, strip)+import Debian.Debianize.BasicInfo (Flags)+import Debian.Debianize.DebInfo as D (control, copyright, DebInfo, makeDebInfo, noTestSuite, rulesSettings)+import Debian.Debianize.BinaryDebDescription (Canonical(canonical))+import Debian.Debianize.CopyrightDescription (defaultCopyrightDescription)+import Debian.Debianize.InputCabal (inputCabalization)+import Debian.Debianize.Prelude ((~=), (%=))+import Debian.Debianize.SourceDebDescription as S (homepage)+import Debian.Debianize.VersionSplits (VersionSplits)+import Debian.Orphans ()+import Debian.Relation (BinPkgName)+import Debian.Version (DebianVersion)+import Distribution.Package (PackageName)+import Distribution.PackageDescription as Cabal (PackageDescription(homepage, testSuites))+import Prelude hiding ((.), init, init, log, log, null)++-- This enormous record is a mistake - instead it should be an Atom+-- type with lots of constructors, and the Atoms type is a set of+-- these.  Then we can cruise through the atom set converting the+-- elements into other simpler elements until they elements are all+-- simple enough to convert directly into a debianization.  At the+-- moment I really need this for the Install atoms, so I will try to+-- convert just that portion of the type to this new scheme.++-- | Bits and pieces of information about the mapping from cabal package+-- names and versions to debian package names and versions.  In essence,+-- an 'Atoms' value represents a package's debianization.  The lenses in+-- this module are used to get and set the values hidden in this Atoms+-- value.  Many of the values should be left alone to be set when the+-- debianization is finalized.+data CabalInfo+    = CabalInfo+      { packageDescription_ :: PackageDescription+      -- ^ The result of reading a cabal configuration file.+      , debInfo_ :: DebInfo+      -- ^ Information required to represent a non-cabal debianization.+      , debianNameMap_ :: Map PackageName VersionSplits+      -- ^ Mapping from cabal package name and version to debian source+      -- package name.  This allows different ranges of cabal versions to+      -- map to different debian source package names.+      , epochMap_ :: Map PackageName Int+      -- ^ Specify epoch numbers for the debian package generated from a+      -- cabal package.  Example: @EpochMapping (PackageName "HTTP") 1@.+      , packageInfo_ :: Map PackageName PackageInfo+      -- ^ Supply some info about a cabal package.+      } deriving (Show, Data, Typeable)++data PackageInfo = PackageInfo { cabalName :: PackageName+                               , devDeb :: Maybe (BinPkgName, DebianVersion)+                               , profDeb :: Maybe (BinPkgName, DebianVersion)+                               , docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable)++$(let f s = case s of+              (_ : _) | last s == '_' -> Just (init s)+              _ -> Nothing in+  nameMakeLens ''CabalInfo f)++instance Canonical CabalInfo where+    canonical x = x {debInfo_ = canonical (debInfo_ x)}++-- | Given the 'Flags' value read the cabalization and build a new+-- 'CabalInfo' record.+newCabalInfo :: Flags -> IO CabalInfo+newCabalInfo flags' = do+  pkgDesc <- inputCabalization flags'+  copyrt <- liftIO $ defaultCopyrightDescription pkgDesc+  execStateT+    (do (copyright . debInfo) ~= Just copyrt+        (S.homepage . control . debInfo) ~= case strip (pack (Cabal.homepage pkgDesc)) of+                                              x | Text.null x -> Nothing+                                              x -> Just x+        noTests <- access (noTestSuite . debInfo)+        unless (List.null (Cabal.testSuites pkgDesc) || noTests)+               (do (rulesSettings . debInfo) %= (++ ["DEB_ENABLE_TESTS = yes", "DEB_BUILD_OPTIONS += nocheck"])+                   -- ...+               ))+    (makeCabalInfo flags' pkgDesc)++makeCabalInfo :: Flags -> PackageDescription -> CabalInfo+makeCabalInfo fs pkgDesc =+    CabalInfo+      { packageDescription_ = pkgDesc+      , epochMap_ = mempty+      , packageInfo_ = mempty+      , debianNameMap_ = mempty+      , debInfo_ = makeDebInfo fs+      }

@@ -0,0 +1,244 @@+-- | <https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/>+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, TupleSections #-}+module Debian.Debianize.CopyrightDescription+    ( CopyrightDescription(..)+    , FilesOrLicenseDescription(..)+    -- * Lenses+    , format+    , upstreamName+    , upstreamContact+    , upstreamSource+    , disclaimer+    , summaryComment+    , summaryLicense+    , summaryCopyright+    , filesAndLicenses+    , filesPattern+    , filesCopyright+    , filesLicense+    , filesComment+    , license+    , comment+    -- * Builders+    , readCopyrightDescription+    , parseCopyrightDescription+    , defaultCopyrightDescription+    ) where++import Data.Char (isSpace)+import Data.Default (Default(def))+import Data.Generics (Data, Typeable)+import Data.Lens.Template (makeLenses)+import Data.List as List (dropWhileEnd, partition)+import Data.Maybe (isJust, catMaybes, fromJust, fromMaybe, listToMaybe)+import Data.Monoid ((<>), mempty)+import Data.Text as Text (Text, pack, strip, unpack, null, lines, unlines, dropWhileEnd)+import Debian.Control (Field'(Field), lookupP, Paragraph'(Paragraph), Control'(Control, unControl), parseControl)+import Debian.Debianize.Prelude (readFileMaybe)+import Debian.Orphans ()+import Debian.Policy (License(..), readLicense, fromCabalLicense)+import Debian.Pretty (PP(PP, unPP), display', ppDisplay', ppPrint)+import qualified Distribution.License as Cabal (License(UnknownLicense))+#if MIN_VERSION_Cabal(1,20,0)+import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFiles, copyright, license))+#else+import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFile, copyright, license))+#endif+import Network.URI (URI, parseURI)+import Prelude hiding (init, init, log, log, unlines, readFile)+import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text)++-- | Description of the machine readable debian/copyright file.  A+-- special case is used to represeent the old style free format file -+-- if the value is equal to newCopyrightDescription except for the+-- field _summaryComment, the text in _summaryComment is the copyright+-- file.+data CopyrightDescription+    = CopyrightDescription+      { _format :: URI+      , _upstreamName :: Maybe Text+      , _upstreamContact :: Maybe Text+      , _upstreamSource :: Maybe Text+      , _disclaimer :: Maybe Text+      , _summaryComment :: Maybe Text+      , _summaryLicense :: Maybe License+      , _summaryCopyright :: Maybe Text+      , _filesAndLicenses :: [FilesOrLicenseDescription]+      } deriving (Eq, Ord, Show, Data, Typeable)++data FilesOrLicenseDescription+    = FilesDescription+      { _filesPattern :: FilePath+      , _filesCopyright :: Text+      , _filesLicense :: License+      , _filesComment :: Maybe Text+      }+    | LicenseDescription+      { _license :: License+      , _comment :: Maybe Text+      } deriving (Eq, Ord, Show, Data, Typeable)++instance Pretty (PP CopyrightDescription) where+    -- Special case encodes free format debian/copyright file+    pPrint (PP x@(CopyrightDescription {_summaryComment = Just t})) | x {_summaryComment = Nothing} == def = text (List.dropWhileEnd isSpace (unpack t) <> "\n")+    pPrint x = ppPrint . toControlFile . unPP $ x++instance Default CopyrightDescription where+    def = CopyrightDescription+          { _format = fromJust $ parseURI "http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/"+          , _upstreamName = Nothing+          , _upstreamContact = Nothing+          , _upstreamSource = Nothing+          , _disclaimer = Nothing+          , _summaryComment = Nothing+          , _summaryLicense = Nothing+          , _summaryCopyright = Nothing+          , _filesAndLicenses = [] }++-- | Read a 'CopyrightDescription' from the text one might obtain from+-- a @debian/copyright@ file.+readCopyrightDescription :: Text -> CopyrightDescription+readCopyrightDescription t =+    case parseControl "debian/copyright" t of+      Left _e -> def { _summaryComment = Just t }+      Right ctl -> case parseCopyrightDescription (unControl ctl) of+                     Just cpy -> cpy+                     Nothing -> def { _summaryComment = Just t }++-- | Try to parse a structured copyright file+parseCopyrightDescription :: [Paragraph' Text] -> Maybe CopyrightDescription+parseCopyrightDescription (hd : tl) =+    let (muri :: Maybe URI) = maybe Nothing (\ (Field (_, t)) -> parseURI . unpack $ t) (lookupP "Format" hd) in+    case (muri, map parseFilesOrLicense tl) of+      (Just uri, fnls) | all isJust fnls ->+          Just $ CopyrightDescription+                   { _format = uri+                   , _upstreamName = fmap (\ (Field (_, x)) -> x) $ lookupP "Upstream-Name" hd+                   , _upstreamContact = fmap (\ (Field (_, x)) -> x) $ lookupP "Upstream-Contact" hd+                   , _upstreamSource = fmap (\ (Field (_, x)) -> x) $ lookupP "Source" hd+                   , _disclaimer = fmap (\ (Field (_, x)) -> x) $ lookupP "Disclaimer" hd+                   , _summaryComment = fmap (\ (Field (_, x)) -> x) $ lookupP "Comment" hd+                   , _summaryLicense = fmap (\ (Field (_, x)) -> readLicense x) $ lookupP "License" hd+                   , _summaryCopyright = Nothing -- fmap (\ (Field (_, x)) -> x) $ lookupP "Copyright" hd+                   , _filesAndLicenses = catMaybes fnls+                   }+      _ -> Nothing+parseCopyrightDescription [] = Nothing++parseFilesOrLicense :: Paragraph' Text -> Maybe (FilesOrLicenseDescription)+parseFilesOrLicense p =+    case (lookupP "Files" p, lookupP "Copyright" p, lookupP "License" p) of+      (Just (Field (_, files)),+       Just (Field (_, copyright)),+       Just (Field (_, license))) ->+          Just $ FilesDescription+                 { _filesPattern = unpack files+                 , _filesCopyright = copyright+                 , _filesLicense = readLicense license+                 , _filesComment = maybe Nothing (\ (Field (_, comment)) -> Just comment) (lookupP "Comment" p) }+      (Nothing,+       Nothing,+       Just (Field (_, license))) ->+          Just $ LicenseDescription+                 { _license = readLicense license+                 , _comment = maybe Nothing (\ (Field (_, comment)) -> Just comment) (lookupP "Comment" p) }+      _ -> Nothing++toControlFile :: CopyrightDescription -> Control' Text+toControlFile d =+    Control+    ( Paragraph+      ( [ Field ("Format", (" " <> ppDisplay' (_format d))) ] +++        maybe [] (\x -> [Field ("Upstream-Name", " " <> x)]) (_upstreamName d) +++        maybe [] (\x -> [Field ("Upstream-Contact", " " <> x)]) (_upstreamContact d) +++        maybe [] (\x -> [Field ("Source", " " <> x)]) (_upstreamSource d) +++        maybe [] (\x -> [Field ("Disclaimer", " " <> x)]) (_disclaimer d) +++        maybe [] (\x -> [Field ("License", " " <> display' x)]) (_summaryLicense d) +++        maybe [] (\x -> [Field ("Copyright", " " <> x)]) (_summaryCopyright d) +++        maybe [] (\x -> [Field ("Comment", " " <> x)]) (_summaryComment d)) :+      map toParagraph (_filesAndLicenses d) )++toParagraph :: FilesOrLicenseDescription -> Paragraph' Text+toParagraph fd@FilesDescription {} =+    Paragraph $+      [ Field ("Files", " " <> pack (_filesPattern fd))+      , Field ("Copyright", " " <> _filesCopyright fd)+      , Field ("License", " " <> display' (_filesLicense fd)) ] +++      maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_filesComment fd)+toParagraph ld@LicenseDescription {} =+    Paragraph $+      [ Field ("License", " " <> display' (_license ld)) ] +++      maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_comment ld)++-- | Infer a 'CopyrightDescription' from a Cabal package description.+-- This will try to read any copyright files listed in the cabal+-- configuration.  Inputs include the license field from the cabal+-- file, the contents of the license files mentioned there, and the+-- provided @copyright0@ value.+defaultCopyrightDescription :: Cabal.PackageDescription -> IO CopyrightDescription+defaultCopyrightDescription pkgDesc = do+#if MIN_VERSION_Cabal(1,20,0)+  let (debianCopyrightPath, otherLicensePaths) = partition (== "debian/copyright") (Cabal.licenseFiles pkgDesc)+#else+  let (debianCopyrightPath, otherLicensePaths) = partition (== "debian/copyright") [Cabal.licenseFile pkgDesc]+#endif+      license = fromCabalLicense $ Cabal.license pkgDesc+  -- This is an @Nothing@ unless debian/copyright is (for some+  -- reason) mentioned in the cabal file.+  debianCopyrightText <- mapM readFileMaybe debianCopyrightPath >>= return . listToMaybe . catMaybes+  licenseCommentPairs <- mapM readFileMaybe otherLicensePaths >>= return . filter (isJust . snd) . zip otherLicensePaths+  return $ case debianCopyrightText of+    Just t ->+        def { _summaryComment = Just t }+    Nothing ->+        -- All we have is the name of the license+        let copyrt = fmap dots $ nothingIf (Text.null . strip) (pack (Cabal.copyright pkgDesc)) in+        def { _filesAndLicenses =+                  [ FilesDescription+                    { _filesPattern = "*"+                    , _filesCopyright = fromMaybe (pack "(No copyright field in cabal file)") copyrt+                    , _filesLicense = license+                    , _filesComment = mempty }+                  , FilesDescription+                    { _filesPattern = "*/debian"+                    , _filesCopyright = "held by the contributors mentioned in debian/changelog"+                    , _filesLicense = license+                    , _filesComment = mempty } ] +++                  case licenseCommentPairs of+                    [] -> []+                    [(_, comment)] ->+                        [ LicenseDescription+                          { _license = license+                          , _comment = comment } ]+                    _ -> map (\ (path, comment) -> LicenseDescription+                                                   { _license = fromCabalLicense (Cabal.UnknownLicense path)+                                                   , _comment = comment }) licenseCommentPairs }+{-+  -- We don't really have a way to associate licenses with+  -- file patterns, so we will just cover some simple cases,+  -- a single license, no license, etc.+  -- It is possible we might interpret the license file path+  -- as a license name, so I hang on to it here.+  return $ cabalToCopyrightDescription pkgDesc licenseComments (maybe def readCopyrightDescription debianCopyrightText)+    where+      cabalToCopyrightDescription :: Cabal.PackageDescription -> [Maybe Text] -> CopyrightDescription -> CopyrightDescription+      cabalToCopyrightDescription pkgDesc licenseComments copyright0 =+          let copyrt = fmap dots $ nothingIf (Text.null . strip) (pack (Cabal.copyright pkgDesc))+              license = Cabal.license pkgDesc in+          copyright0 { _filesAndLicenses =+                           map (\ comment ->+                                    FilesDescription+                                    { _filesPattern = "*"+                                    , _filesCopyright = fromMaybe (pack "(No copyright field in cabal file)") copyrt+                                    , _filesLicense = fromCabalLicense license+                                    , _filesComment = comment }) licenseComments }+-}++nothingIf :: (a -> Bool) -> a -> Maybe a+nothingIf p x = if p x then Nothing else Just x++-- | Replace empty lines with single dots+dots :: Text -> Text+dots = Text.unlines . map (\ line -> if Text.null line then "." else line) . map (Text.dropWhileEnd isSpace) . Text.lines++$(makeLenses [''CopyrightDescription, ''FilesOrLicenseDescription])

@@ -0,0 +1,402 @@+-- | This module holds a long list of lenses that access the Atoms+-- record, the record that holds the input data from which the+-- debianization is to be constructed.+{-# LANGUAGE CPP, DeriveDataTypeable, TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+module Debian.Debianize.DebInfo+    ( -- * Types+#if __HADDOCK__+      -- Is this ifdef working?+      DebInfo(..)+#else+      DebInfo+#endif+    , Atom(File, Install, InstallCabalExec, InstallCabalExecTo, InstallData, InstallDir, InstallTo, Link)+    , Site(Site, domain, server, serverAdmin)+    , Server(Server, headerMessage, hostname, installFile, port, retry, serverFlags)+    , InstallFile(InstallFile, destDir, destName, execName, sourceDir)++      -- * Lenses+    , flags+    , warning+    , sourceFormat+    , watch+    , rulesHead+    , rulesSettings+    , rulesIncludes+    , rulesFragments+    , copyright+    , control+    , intermediateFiles+    , compat+    , changelog+    , installInit+    , logrotateStanza+    , postInst+    , postRm+    , preInst+    , preRm+    , atomSet+    , noDocumentationLibrary+    , noProfilingLibrary+    , omitProfVersionDeps+    , omitLTDeps+    , buildDir+    , sourcePackageName+    , overrideDebianNameBase+    , revision+    , debVersion+    , maintainerOption+    , uploadersOption+    , utilsPackageNameBase+    , xDescriptionText+    , comments+    , missingDependencies+    , extraLibMap+    , execMap+    , apacheSite+    , sourceArchitectures+    , binaryArchitectures+    , sourcePriority+    , binaryPriorities+    , sourceSection+    , binarySections+    , executable+    , serverInfo+    , website+    , backups+    , extraDevDeps+    , official+    , noTestSuite+    , allowDebianSelfBuildDeps++    , binaryDebDescription++      -- * Atom builders+    , link+    , install+    , installTo+    , installData+    , file+    , installCabalExec+    , installCabalExecTo+    , installDir++      -- * DebInfo Builder+    , makeDebInfo+    ) where++import Control.Category ((.))+import Control.Monad.State (StateT)+--import Data.Default (def)+import Data.Generics (Data, Typeable)+import Data.Lens.Common (Lens, iso, getL)+import Data.Lens.Lazy ((%=))+import Data.Lens.Template (nameMakeLens)+import Data.List (init)+import Data.Map as Map (Map)+import Data.Monoid (Monoid(..))+import Data.Set as Set (insert, Set)+import Data.Text (Text)+import Debian.Changes (ChangeLog)+import Debian.Debianize.BasicInfo (Flags)+import Debian.Debianize.Prelude (listElemLens, maybeLens)+import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical), newBinaryDebDescription, package)+import Debian.Debianize.CopyrightDescription (CopyrightDescription)+import qualified Debian.Debianize.SourceDebDescription as S (newSourceDebDescription, SourceDebDescription, binaryPackages)+import Debian.Debianize.VersionSplits (DebBase)+import Debian.Orphans ()+import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat)+import Debian.Relation (BinPkgName, Relations, SrcPkgName)+import Debian.Version (DebianVersion)+import Prelude hiding ((.), init, init, log, log)+import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)++-- | Information required to represent a non-cabal debianization.+data DebInfo+    = DebInfo+      { flags_ :: Flags+      -- ^ Information regarding mode of operation - verbosity, dry-run, usage, etc+      , warning_ :: Set Text+      -- ^ A warning to be reported later+      , sourceFormat_ :: Maybe SourceFormat+      -- ^ Write debian/source/format+      , watch_ :: Maybe Text+      -- ^ the @debian\/watch@ file+      , rulesHead_ :: Maybe Text+      -- ^ The rules file header+      , rulesSettings_ :: [Text]+      -- ^ The rules file assignments+      , rulesIncludes_ :: [Text]+      -- ^ The rules file include directives+      , rulesFragments_ :: Set Text+      -- ^ Additional fragments of the rules file+      , copyright_ :: Maybe CopyrightDescription+      -- ^ Override the copyright value computed from the cabal package description.+      , control_ :: S.SourceDebDescription+      -- ^ The parsed contents of the control file+      , intermediateFiles_ :: Set (FilePath, Text)+      -- ^ Put this text into a file with the given name in the debianization.+      , compat_ :: Maybe Int+      -- ^ The debhelper compatibility level, from debian/compat.+      , changelog_ :: Maybe ChangeLog+      -- ^ The changelog, first entry contains the source package name and version+      , installInit_ :: Map BinPkgName Text+      -- ^ Add an init.d file to the binary package+      , logrotateStanza_ :: Map BinPkgName (Set Text)+      -- ^ Add a stanza of a logrotate file to the binary package+      , postInst_ :: Map BinPkgName Text+      -- ^ Map of @debian/postinst@ scripts - to be run after install,+      -- should contain #DEBHELPER# line before exit 0+      , postRm_ :: Map BinPkgName Text+      -- ^ Map of @debian/postrm@ scripts - scripts to run after+      -- remove, should contain #DEBHELPER# line before exit 0+      , preInst_ :: Map BinPkgName Text+      -- ^ Map of @debian/preinst@ scripts - to be run before install,+      -- should contain #DEBHELPER# line before exit 0+      , preRm_ :: Map BinPkgName Text+      -- ^ Map of @debian/prerm@ scripts - to be run before remove,+      -- should contain #DEBHELPER# line before exit 0+      , atomSet_ :: Set Atom+      -- ^ set of items describing file installation requests+      , noDocumentationLibrary_ :: Bool+      -- ^ Do not produce a libghc-foo-doc package.+      , noProfilingLibrary_ :: Bool+      -- ^ Do not produce a libghc-foo-prof package.+      , omitProfVersionDeps_ :: Bool+      -- ^ If present, Do not put the version dependencies on the prof packages that we put on the dev packages.+      , omitLTDeps_ :: Bool+      -- ^ If present, don't generate the << dependency when we see a cabal+      -- equals dependency.  (The implementation of this was somehow lost.)+      , buildDir_ :: Maybe FilePath+      -- ^ The build directory used by cabal, typically dist/build when+      -- building manually or dist-ghc/build when building using GHC and+      -- haskell-devscripts.  This value is used to locate files+      -- produced by cabal so we can move them into the deb.  Note that+      -- the --builddir option of runhaskell Setup appends the "/build"+      -- to the value it receives, so, yes, try not to get confused.+      -- FIXME: make this FilePath or Maybe FilePath+      , sourcePackageName_ :: Maybe SrcPkgName+      -- ^ Name to give to the debian source package.  If not supplied+      -- the name is constructed from the cabal package name.  Note that+      -- DebianNameMap could encode this information if we already knew+      -- the cabal package name, but we can't assume that.+      , overrideDebianNameBase_ :: Maybe DebBase+      -- ^ If given, use this name for the base of the debian binary+      -- packages - the string between 'libghc-' and '-dev'.  Normally+      -- this is derived from the hackage package name.+      , revision_ :: Maybe String+      -- ^ Specify the revision string to use when converting the+      -- cabal version to debian.+      , debVersion_ :: Maybe DebianVersion+      -- ^ Specify the exact debian version of the resulting package,+      -- including epoch.  One use case is to work around the the+      -- "buildN" versions that are often uploaded to the debian and+      -- ubuntu repositories.  Say the latest cabal version of+      -- transformers is 0.3.0.0, but the debian repository contains+      -- version 0.3.0.0-1build3, we need to specify+      -- debVersion="0.3.0.0-1build3" or the version we produce will+      -- look older than the one already available upstream.+      , maintainerOption_ :: Maybe NameAddr+      , uploadersOption_ :: [NameAddr]+      -- ^ Value for the maintainer field in the control file.  Note that+      -- the cabal maintainer field can have multiple addresses, but debian+      -- only one.  If this is not explicitly set, it is obtained from the+      -- cabal file, and if it is not there then from the environment.  As a+      -- last resort, there is a hard coded string in here somewhere.+      , utilsPackageNameBase_ :: Maybe String+      -- ^ Name of a package that will get left-over data files and executables.+      -- If there are more than one, each package will get those files.+      , xDescriptionText_ :: Maybe Text+      -- ^ The text for the X-Description field of the Source package stanza.+      , comments_ :: Maybe [[Text]]+      -- ^ Each element is a comment to be added to the changelog, where the+      -- element's text elements are the lines of the comment.+      , missingDependencies_ :: Set BinPkgName+      -- ^ Lets cabal-debian know that a package it might expect to exist+      -- actually does not, so omit all uses in resulting debianization.+      , extraLibMap_ :: Map String Relations+      -- ^ Map a cabal Extra-Library name to a debian binary package name,+      -- e.g. @ExtraLibMapping extraLibMap "cryptopp" "libcrypto-dev"@ adds a+      -- build dependency *and* a regular dependency on @libcrypto-dev@ to+      -- any package that has @cryptopp@ in its cabal Extra-Library list.+      , execMap_ :: Map String Relations+      -- ^ Map a cabal Build-Tool name to a debian binary package name,+      -- e.g. @ExecMapping "trhsx" "haskell-hsx-utils"@ adds a build+      -- dependency on @haskell-hsx-utils@ to any package that has @trhsx@ in its+      -- cabal build-tool list.+      , apacheSite_ :: Map BinPkgName (String, FilePath, Text)+      -- ^ Have Apache configure a site using PACKAGE, DOMAIN, LOGDIR, and APACHECONFIGFILE+      , sourceArchitectures_ :: Maybe PackageArchitectures+      -- ^ Set the Architecture field of the source package+      , binaryArchitectures_ :: Map BinPkgName PackageArchitectures+      -- ^ Set the Architecture field of a binary package+      , sourcePriority_ :: Maybe PackagePriority+      -- ^ Set the Priority field of the source package+      , binaryPriorities_ :: Map BinPkgName PackagePriority+      -- ^ Set the Priority field of a binary package+      , sourceSection_ :: Maybe Section+      -- ^ Set the Section field of the source package+      , binarySections_ :: Map BinPkgName Section+      -- ^ Set the Section field of a binary package+      , executable_ :: Map BinPkgName InstallFile+      -- ^ Create a binary package to hold a cabal executable+      , serverInfo_ :: Map BinPkgName Server+      -- ^ Like DHExecutable, but configure the executable as a server process+      , website_ :: Map BinPkgName Site+      -- ^ Like DHServer, but configure the server as a web server+      , backups_ :: Map BinPkgName String+      -- ^ Configure the executable to do incremental backups+      , extraDevDeps_ :: Relations+      -- ^ Limited version of Depends, put a dependency on the dev library package.  The only+      -- reason to use this is because we don't yet know the name of the dev library package.+      , official_ :: Bool+      -- ^ Whether this packaging is created by the Debian Haskell Group+      , noTestSuite_ :: Bool+      -- ^ Force omission of the test suites from the debianization+      , allowDebianSelfBuildDeps_ :: Bool+      -- ^ Normally self dependencies are filtered out of the debian+      -- build dependency list because they usually reflect+      -- interdependencies between the library and the executable in+      -- the Cabal packages.  This flag turns off that filtering.+      } deriving (Show, Data, Typeable)++data Atom+    = Link BinPkgName FilePath FilePath+      -- ^ Create a symbolic link in the binary package+    | Install BinPkgName FilePath FilePath+      -- ^ Install a build file into the binary package+    | InstallTo BinPkgName FilePath FilePath+      -- ^ Install a build file into the binary package at an exact location+    | InstallData BinPkgName FilePath FilePath+      -- ^ DHInstallTo somewhere relative to DataDir (see above)+    | File BinPkgName FilePath Text+      -- ^ Create a file with the given text at the given path+    | InstallCabalExec BinPkgName String FilePath+      -- ^ Install a cabal executable into the binary package+    | InstallCabalExecTo BinPkgName String FilePath+      -- ^ Install a cabal executable into the binary package at an exact location+    | InstallDir BinPkgName FilePath+      -- ^ Create a directory in the binary package+    deriving (Show, Eq, Ord, Data, Typeable)++data InstallFile+    = InstallFile+      { execName :: String -- ^ The name of the executable file+      , sourceDir :: Maybe FilePath -- ^ where to find it, default is dist/build/<execName>/+      , destDir :: Maybe FilePath -- ^ where to put it, default is usr/bin/<execName>+      , destName :: String  -- ^ name to give installed executable+      } deriving (Read, Show, Eq, Ord, Data, Typeable)++-- | Information about the web site we are packaging.+data Site+    = Site+      { domain :: String   -- ^ The domain name assigned to the server.+                           -- An apache configuration will be generated to+                           -- redirect requests from this domain to hostname:port+      , serverAdmin :: String   -- ^ Apache ServerAdmin parameter+      , server :: Server   -- ^ The hint to install the server job+      } deriving (Read, Show, Eq, Ord, Data, Typeable)++-- | Information about the server we are packaging.+data Server+    = Server+      { hostname :: String      -- ^ Host on which the server will run+      , port :: Int             -- ^ Port on which the server will run.+                                -- Obviously, this must assign each and+                                -- every server package to a different+                                -- port.+      , headerMessage :: String -- ^ A comment that will be inserted to+                                -- explain how the file was generated+      , retry :: String         -- ^ start-stop-daemon --retry argument+      , serverFlags :: [String] -- ^ Extra flags to pass to the server via the init script+      , installFile :: InstallFile -- ^ The hint to install the server executable+      } deriving (Read, Show, Eq, Ord, Data, Typeable)++makeDebInfo :: Flags -> DebInfo+makeDebInfo fs =+    DebInfo+    { flags_ = fs+    , warning_ = mempty+    , sourceFormat_ = Nothing+    , watch_ = Nothing+    , rulesHead_ = Nothing+    , rulesSettings_ = mempty+    , rulesIncludes_ = mempty+    , rulesFragments_ = mempty+    , copyright_ = Nothing+    , control_ = S.newSourceDebDescription+    , intermediateFiles_ = mempty+    , compat_ = Nothing+    , changelog_ = Nothing+    , installInit_ = mempty+    , logrotateStanza_ = mempty+    , postInst_ = mempty+    , postRm_ = mempty+    , preInst_ = mempty+    , preRm_ = mempty+    , atomSet_ = mempty+    , noDocumentationLibrary_ = False+    , noProfilingLibrary_ = False+    , omitProfVersionDeps_ = False+    , omitLTDeps_ = False+    , buildDir_ = Nothing+    , sourcePackageName_ = Nothing+    , overrideDebianNameBase_ = Nothing+    , revision_ = Nothing+    , debVersion_ = Nothing+    , maintainerOption_ = Nothing+    , uploadersOption_ = []+    , utilsPackageNameBase_ = Nothing+    , xDescriptionText_ = Nothing+    , comments_ = Nothing+    , missingDependencies_ = mempty+    , extraLibMap_ = mempty+    , execMap_ = mempty+    , apacheSite_ = mempty+    , sourceArchitectures_ = Nothing+    , binaryArchitectures_ = mempty+    , sourcePriority_ = Nothing+    , binaryPriorities_ = mempty+    , sourceSection_ = Nothing+    , binarySections_ = mempty+    , executable_ = mempty+    , serverInfo_ = mempty+    , website_ = mempty+    , backups_ = mempty+    , extraDevDeps_ = mempty+    , official_ = False+    , noTestSuite_ = False+    , allowDebianSelfBuildDeps_ = False+    }++instance Canonical DebInfo where+    canonical x = x {control_ = canonical (control_ x)}++$(let f s = case s of+              (_ : _) | last s == '_' -> Just (init s)+              _ -> Nothing in+  nameMakeLens ''DebInfo f)++-- We need (%=_)+link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()+link b from dest = atomSet %= (Set.insert $ Link b from dest) >> return ()+install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()+install b from dest = atomSet %= (Set.insert $ Install b from dest) >> return ()+installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()+installTo b from dest = atomSet %= (Set.insert $ InstallTo b from dest) >> return ()+installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()+installData b from dest = atomSet %= (Set.insert $ InstallData b from dest) >> return ()+file :: Monad m => BinPkgName -> FilePath -> Text -> StateT DebInfo m ()+file b dest content = atomSet %= (Set.insert $ File b dest content) >> return ()+installCabalExec :: Monad m => BinPkgName -> String -> FilePath -> StateT DebInfo m ()+installCabalExec b name dest = atomSet %= (Set.insert $ InstallCabalExec b name dest) >> return ()+installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT DebInfo m ()+installCabalExecTo b name dest = atomSet %= (Set.insert $ InstallCabalExecTo b name dest) >> return ()+installDir :: Monad m => BinPkgName -> FilePath -> StateT DebInfo m ()+installDir b dir = atomSet %= (Set.insert $ InstallDir b dir) >> return ()++-- | Lens to look up the binary deb description by name and create it if absent.+-- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package>+binaryDebDescription :: BinPkgName -> Lens DebInfo BinaryDebDescription+binaryDebDescription b = maybeLens (newBinaryDebDescription b) (iso id id) . listElemLens ((== b) . getL package) . S.binaryPackages . control

@@ -1,3 +1,4 @@+-- | How to name the debian packages based on the cabal package name and version number. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-} {-# OPTIONS -Wall -Wwarn -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Debianize.DebianName@@ -11,23 +12,25 @@     ) where  import Control.Applicative ((<$>))+import Control.Category ((.)) import Data.Char (toLower) import Data.Lens.Lazy (access)-import Data.Map as Map (lookup, alter)-import Data.Version (Version, showVersion)-import Debian.Debianize.Types.BinaryDebDescription as Debian (PackageType(..))-import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription, utilsPackageNameBase, overrideDebianNameBase)-import Debian.Debianize.Monad (DebT)+import Data.Map as Map (alter, lookup)+import Data.Version (showVersion, Version)+import Debian.Debianize.Monad (CabalT) import Debian.Debianize.Prelude ((%=))-import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), insertSplit, doSplits, VersionSplits, makePackage)+import Debian.Debianize.CabalInfo as A (debianNameMap, packageDescription, debInfo)+import Debian.Debianize.BinaryDebDescription as Debian (PackageType(..))+import Debian.Debianize.DebInfo as D (overrideDebianNameBase, utilsPackageNameBase)+import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), doSplits, insertSplit, makePackage, VersionSplits) import Debian.Orphans () import Debian.Relation (PkgName(..), Relations) import qualified Debian.Relation as D (VersionReq(EEQ)) import Debian.Version (parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))-import qualified Distribution.PackageDescription as Cabal-import Prelude hiding (unlines)+import qualified Distribution.PackageDescription as Cabal (PackageDescription(package))+import Prelude hiding (unlines, (.))  data Dependency_   = BuildDepends Dependency@@ -37,12 +40,12 @@     deriving (Eq, Show)  -- | Build the Debian package name for a given package type.-debianName :: (Monad m, Functor m, PkgName name) => PackageType -> CompilerFlavor -> DebT m name+debianName :: (Monad m, Functor m, PkgName name) => PackageType -> CompilerFlavor -> CabalT m name debianName typ cfl =     do base <-            case (typ, cfl) of-             (Utilities, GHC) -> access utilsPackageNameBase >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return-             (Utilities, _) -> access utilsPackageNameBase >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return+             (Utilities, GHC) -> access (utilsPackageNameBase . debInfo) >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return+             (Utilities, _) -> access (utilsPackageNameBase . debInfo) >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return              _ -> unDebBase <$> debianNameBase        return $ mkPkgName' cfl typ (DebBase base) @@ -50,12 +53,12 @@ -- names based on version numbers.  If a version split happens at v, -- this will return the ltName if < v, and the geName if the relation -- is >= v.-debianNameBase :: Monad m => DebT m DebBase+debianNameBase :: Monad m => CabalT m DebBase debianNameBase =-    do nameBase <- access T.overrideDebianNameBase-       Just pkgDesc <- access packageDescription+    do nameBase <- access (D.overrideDebianNameBase . debInfo)+       pkgDesc <- access packageDescription        let pkgId = Cabal.package pkgDesc-       nameMap <- access T.debianNameMap+       nameMap <- access A.debianNameMap        let pname@(PackageName _) = pkgName pkgId            version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))        case (nameBase, Map.lookup (pkgName pkgId) nameMap) of@@ -99,7 +102,7 @@ -- Not really a debian package name, but the name of a cabal package -- that maps to the debian package name we want.  (Should this be a -- SrcPkgName?)-mapCabal :: Monad m => PackageName -> DebBase -> DebT m ()+mapCabal :: Monad m => PackageName -> DebBase -> CabalT m () mapCabal pname dname =     debianNameMap %= Map.alter f pname     where@@ -108,7 +111,7 @@       f (Just sp) = error $ "mapCabal " ++ show pname ++ " " ++ show dname ++ ": - already mapped: " ++ show sp  -- | Map versions less than ver of Cabal Package pname to Debian package ltname-splitCabal :: Monad m => PackageName -> DebBase -> Version -> DebT m ()+splitCabal :: Monad m => PackageName -> DebBase -> Version -> CabalT m () splitCabal pname ltname ver =     debianNameMap %= Map.alter f pname     where@@ -119,7 +122,7 @@ -- | Replace any existing mapping of the cabal name 'pname' with the -- debian name 'dname'.  (Use case: to change the debian package name -- so it differs from the package provided by ghc.)-remapCabal :: Monad m => PackageName -> DebBase -> DebT m ()+remapCabal :: Monad m => PackageName -> DebBase -> CabalT m () remapCabal pname dname = do   debianNameMap %= Map.alter (const Nothing) pname   mapCabal pname dname

@@ -3,28 +3,31 @@ -- debian. {-# OPTIONS -Wall #-} module Debian.Debianize.Details-    ( debianDefaultAtoms+    ( debianDefaults     ) where +import Control.Category ((.)) import Data.Version (Version(Version))-import Debian.Relation (Relation(Rel), BinPkgName(BinPkgName))-import Debian.Debianize.DebianName (mapCabal, {-remapCabal,-} splitCabal)-import Debian.Debianize.Types.Atoms as T (epochMap, execMap)-import Debian.Debianize.Monad (DebT)+import Debian.Debianize.DebianName (mapCabal, splitCabal)+import Debian.Debianize.Monad (CabalT) import Debian.Debianize.Prelude ((++=))+import Debian.Debianize.CabalInfo as A (epochMap, debInfo)+import Debian.Debianize.DebInfo as D (execMap) import Debian.Debianize.VersionSplits (DebBase(DebBase))+import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) import Distribution.Package (PackageName(PackageName))+import Prelude hiding ((.)) --- | Update the Atoms value in the DebT state with some details about+-- | Update the CabalInfo value in the CabalT state with some details about -- the debian repository - special cases for how some cabal packages -- are mapped to debian package names.-debianDefaultAtoms :: Monad m => DebT m ()-debianDefaultAtoms =+debianDefaults :: Monad m => CabalT m ()+debianDefaults =     do -- These are the two epoch names I know about in the debian repo-       T.epochMap ++= (PackageName "HaXml", 1)-       T.epochMap ++= (PackageName "HTTP", 1)+       A.epochMap ++= (PackageName "HaXml", 1)+       A.epochMap ++= (PackageName "HTTP", 1)        -- The hsx2hs build tool is in an an eponymous deb-       T.execMap ++= ("hsx2hs", [[Rel (BinPkgName "hsx2hs") Nothing Nothing]])+       (D.execMap . A.debInfo) ++= ("hsx2hs", [[Rel (BinPkgName "hsx2hs") Nothing Nothing]])        -- For now, use deb names like libghc-cabal-ghcjs-dev for any        -- Cabal >= 1.21, which is the ghcjs development branch of Cabal.        mapCabal (PackageName "Cabal") (DebBase "cabal-ghcjs")

@@ -1,36 +1,39 @@ -- | Convert a Debianization into a list of files that can then be -- written out. {-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TupleSections #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Debian.Debianize.Files     ( debianizationFileMap     ) where  import Control.Applicative ((<$>))+import Control.Category ((.)) import Control.Monad.Trans (lift)-import Control.Monad.Writer (WriterT, execWriterT, tell)-import Debian.Control.Common ()+import Control.Monad.Writer (execWriterT, tell, WriterT) import Data.Char (isSpace) import Data.Lens.Lazy (access, getL)-import Data.List as List (map, dropWhileEnd, dropWhile)-import Data.Map as Map (Map, map, toList, fromListWithKey, mapKeys, insertWith)-import Data.Maybe+import Data.List as List (dropWhile, dropWhileEnd, map)+import Data.Map as Map (fromListWithKey, insertWith, map, Map, mapKeys, toList)+import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mempty)-import Data.Set as Set (toList, member, fold)-import Data.Text as Text (Text, pack, unpack, lines, unlines, null, intercalate, dropWhile, dropWhileEnd, strip)-import Debian.Control (Control'(Control, unControl), Paragraph'(Paragraph), Field'(Field))-import Debian.Debianize.Monad (DebT)+import Data.Set as Set (fold, member, toList)+import Data.Text as Text (dropWhile, dropWhileEnd, intercalate, lines, null, pack, strip, Text, unlines, unpack)+import Debian.Control (Control'(Control, unControl), Field'(Field), Paragraph'(Paragraph))+import Debian.Control.Common ()+import qualified Debian.Debianize.DebInfo as D (Atom(Install, InstallDir, Link), atomSet, changelog, compat, control, copyright, installInit, intermediateFiles, logrotateStanza, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, watch)+import Debian.Debianize.Monad (DebianT) import Debian.Debianize.Prelude (showDeps')-import qualified Debian.Debianize.Types.Atoms as T-import qualified Debian.Debianize.Types.BinaryDebDescription as B-import qualified Debian.Debianize.Types.SourceDebDescription as S-import Debian.Pretty (PP(..), ppDisplay, ppPrint, ppDisplay')-import Debian.Relation (Relations, BinPkgName(BinPkgName))-import Prelude hiding (init, unlines, writeFile, log, dropWhile)---import System.Directory (getCurrentDirectory)+import qualified Debian.Debianize.BinaryDebDescription as B (architecture, BinaryDebDescription, binaryPriority, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, PackageRelations, preDepends, provides, recommends, relations, replaces, suggests)+import Debian.Debianize.CopyrightDescription (CopyrightDescription)+import qualified Debian.Debianize.SourceDebDescription as S (binaryPackages, buildConflicts, buildConflictsIndep, buildDepends, buildDependsIndep, dmUploadAllowed, homepage, maintainer, priority, section, source, SourceDebDescription, standardsVersion, uploaders, vcsFields, VersionControlSpec(VCSArch, VCSBrowser, VCSBzr, VCSCvs, VCSDarcs, VCSGit, VCSHg, VCSMtn, VCSSvn), xDescription, XField(XField), XFieldDest(B, C, S), xFields)+import Debian.Pretty (PP(..), ppDisplay, ppDisplay', ppPrint)+import Debian.Relation (BinPkgName(BinPkgName), Relations)+import Distribution.PackageDescription (PackageDescription)+import Prelude hiding ((.), dropWhile, init, log, unlines, writeFile) import System.FilePath ((</>))-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text, empty)+import Text.PrettyPrint.HughesPJClass (empty, Pretty(pPrint), text) -type FilesT m = WriterT [(FilePath, Text)] (DebT m)+type FilesT m = WriterT [(FilePath, Text)] (DebianT m)  instance Pretty (PP Bool) where     pPrint = text . show . unPP@@ -42,7 +45,7 @@ -- the Debianization produced by finalizeDebianization in the unit -- tests.) -debianizationFileMap :: (Monad m, Functor m) => DebT m (Map FilePath Text)+debianizationFileMap :: (Monad m, Functor m) => DebianT m (Map FilePath Text) debianizationFileMap =     fmap (Map.fromListWithKey (\ k a b -> error $ "Multiple values for " ++ k ++ ":\n  " ++ show a ++ "\n" ++ show b)) $ execWriterT $     do -- here <- liftIO getCurrentDirectory@@ -66,103 +69,106 @@  sourceFormatFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] sourceFormatFiles =-    maybe [] (\ x -> [("debian/source/format", pack (ppDisplay x))]) <$> (lift $ access T.sourceFormat)+    maybe [] (\ x -> [("debian/source/format", pack (ppDisplay x))]) <$> (lift $ access D.sourceFormat)  watchFile :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]-watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ access T.watch)+watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ access D.watch)  intermediates :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]-intermediates = Set.toList <$> (lift $ access T.intermediateFiles)+intermediates = Set.toList <$> (lift $ access D.intermediateFiles)  installs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] installs =-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access (D.atomSet))     where-      doAtom (T.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp+      doAtom (D.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp       doAtom _ mp = mp       pathf name = "debian" </> show (ppPrint name) ++ ".install"  dirs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] dirs =-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access D.atomSet)     where-      doAtom (T.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp+      doAtom (D.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp       doAtom _ mp = mp       pathf name = "debian" </> show (ppPrint name) ++ ".dirs"  init :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] init =-    (Map.toList . mapKeys pathf) <$> (lift $ access T.installInit)+    (Map.toList . mapKeys pathf) <$> (lift $ access D.installInit)     where       pathf name = "debian" </> show (ppPrint name) ++ ".init"  -- FIXME - use a map and insertWith, check for multiple entries logrotate :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] logrotate =-    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ access T.logrotateStanza)+    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ access D.logrotateStanza)     where       pathf name = "debian" </> show (ppPrint name) ++ ".logrotate"  -- | Assemble all the links by package and output one file each links :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] links =-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access D.atomSet)     where-      doAtom (T.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp+      doAtom (D.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp       doAtom _ mp = mp       pathf name = "debian" </> show (ppPrint name) ++ ".links"  postinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] postinstFiles =-     (Map.toList . mapKeys pathf) <$> (lift $ access T.postInst)+     (Map.toList . mapKeys pathf) <$> (lift $ access D.postInst)     where       pathf (BinPkgName name) = "debian" </> name <> ".postinst"  postrmFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] postrmFiles =-    (Map.toList . mapKeys pathf) <$> (lift $ access T.postRm)+    (Map.toList . mapKeys pathf) <$> (lift $ access D.postRm)     where       pathf name = "debian" </> show (ppPrint name) ++ ".postrm"  preinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] preinstFiles =-    (Map.toList . mapKeys pathf) <$> (lift $ access T.preInst)+    (Map.toList . mapKeys pathf) <$> (lift $ access D.preInst)     where       pathf name = "debian" </> show (ppPrint name) ++ ".preinst"  prermFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] prermFiles =-    (Map.toList . mapKeys pathf) <$> (lift $ access T.preRm)+    (Map.toList . mapKeys pathf) <$> (lift $ access D.preRm)     where       pathf name = "debian" </> show (ppPrint name) ++ ".prerm"  rules :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] rules =-    do Just rh <- lift (access T.rulesHead)-       rassignments <- lift (access T.rulesSettings) >>= return . intercalate "\n"-       rincludes <- lift (access T.rulesIncludes) >>= return . intercalate "\n"-       rl <- (reverse . Set.toList) <$> lift (access T.rulesFragments)+    do Just rh <- lift (access (D.rulesHead))+       rassignments <- lift (access (D.rulesSettings)) >>= return . intercalate "\n"+       rincludes <- lift (access (D.rulesIncludes)) >>= return . intercalate "\n"+       rl <- (reverse . Set.toList) <$> lift (access (D.rulesFragments))        return [("debian/rules", intercalate "\n\n" (filter (not . Text.null) (List.map strip (rh : rassignments : rincludes : rl))) <> "\n")]  changelog :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] changelog =-    do log <- lift $ access T.changelog+    do log <- lift $ access D.changelog        return [("debian/changelog", pack (show (ppPrint (fromMaybe (error "No changelog in debianization") log))))]  control :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] control =-    do d <- lift $ access T.control+    do d <- lift $ access D.control        return [("debian/control", ppDisplay' (controlFile d))]  compat :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] compat =-    do t <- lift $ access T.compat+    do t <- lift $ access D.compat        return [("debian/compat", pack (show (fromMaybe (error "Missing DebCompat atom - is debhelper installed?") $ t) <> "\n"))]  copyright :: (Monad m, Functor m) => FilesT m [(FilePath, Text)] copyright =-    do copyrt <- lift $ access T.copyright+    do copyrt <- lift $ access (D.copyright)        return [("debian/copyright", ppDisplay' copyrt)]++instance Pretty (PP (PackageDescription -> IO CopyrightDescription)) where+    pPrint _ = text "<function>"  controlFile :: S.SourceDebDescription -> Control' String controlFile src =

@@ -2,12 +2,12 @@ {-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} module Debian.Debianize.Finalize     ( debianize-    , finalizeDebianization -- external use deprecated - used in test script+    -- , finalizeDebianization -- external use deprecated - used in test script     ) where  import Control.Applicative ((<$>)) import Control.Category ((.))-import Control.Monad (when)+import Control.Monad (unless, when) import Control.Monad as List (mapM_) import Control.Monad.State (get, modify) import Control.Monad.Trans (liftIO, MonadIO)@@ -15,70 +15,73 @@ import Data.Char (toLower) import Data.Digest.Pure.MD5 (md5) import Data.Lens.Lazy (access, getL)-import Data.List as List (intercalate, map, nub, unlines)-import Data.Map as Map (delete, elems, lookup, Map, toList, insertWith)+import Data.List as List (filter, intercalate, map, nub, null, unlines)+import Data.Map as Map (delete, elems, insertWith, lookup, Map, toList) import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Monoid ((<>), mempty)-import Data.Set as Set (difference, filter, fromList, map, null, Set, singleton, toList, union, unions, fold)+import Data.Set as Set (difference, filter, fold, fromList, insert, map, null, Set, singleton, toList, union, unions) import Data.Set.Extra as Set (mapM_)-import Data.Text as Text (Text, pack, unlines, unpack, intercalate)+import Data.Text as Text (intercalate, pack, Text, unlines, unpack)+import Data.Version (showVersion) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))+import Debian.Debianize.BasicInfo (cabalFlagAssignments, compilerFlavor, verbosity) import Debian.Debianize.BuildDependencies (debianBuildDeps, debianBuildDepsIndep) 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.Input (dataDir, inputCabalization, inputChangeLog)-import Debian.Debianize.Monad as Monad (DebT)+import Debian.Debianize.InputDebian (dataDir, inputChangeLog)+import Debian.Debianize.Monad as Monad (CabalT, liftCabal) import Debian.Debianize.Options (compileCommandlineArgs, compileEnvironmentArgs)-import Debian.Debianize.Prelude ((%=), (+=), fromEmpty, fromSingleton, (~=), (~?=))-import qualified Debian.Debianize.Types as T (apacheSite, backups, binaryArchitectures, binaryPackages, binarySection, breaks, buildDepends, buildDependsIndep, buildDir, builtUsing, changelog, comments, compat, conflicts, debianDescription, debVersion, depends, epochMap, executable, extraDevDeps, extraLibMap, file, install, installCabalExec, installData, installDir, installTo, intermediateFiles, link, maintainerOption, uploadersOption, noDocumentationLibrary, noProfilingLibrary, omitProfVersionDeps, packageDescription, packageType, preDepends, provides, recommends, replaces, revision, rulesFragments, serverInfo, standardsVersion, source, sourceFormat, sourcePackageName, sourcePriority, sourceSection, suggests, utilsPackageNameBase, verbosity, watch, website, control, homepage, official, vcsFields)-import qualified Debian.Debianize.Types.Atoms as A (InstallFile(execName, sourceDir), showAtoms, compilerFlavors, Atom(..), atomSet, rulesHead, rulesSettings, rulesIncludes)-import qualified Debian.Debianize.Types.BinaryDebDescription as B (BinaryDebDescription, package, PackageType(Development, Documentation, Exec, Profiling, Source, HaskellSource, Utilities), PackageType)-import qualified Debian.Debianize.Types.SourceDebDescription as S (xDescription, VersionControlSpec(..), maintainer, uploaders)+import Debian.Debianize.Prelude ((%=), (+=), (~=), (~?=))+import qualified Debian.Debianize.CabalInfo as A+import qualified Debian.Debianize.BinaryDebDescription as B+import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans ()-import Debian.Pretty (ppDisplay, PP(..))-import Debian.Policy (getDebhelperCompatLevel, getCurrentDebianUser, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, Section(..), SourceFormat(Native3, Quilt3), parseStandardsVersion)-import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), SrcPkgName(SrcPkgName), Relation(Rel), Relations)+import Debian.Policy (getCurrentDebianUser, getDebhelperCompatLevel, haskellMaintainer, PackageArchitectures(Any, All), PackagePriority(Extra), parseMaintainer, parseStandardsVersion, Section(..), SourceFormat(Native3, Quilt3))+import Debian.Pretty (PP(..), ppDisplay)+import Debian.Relation (BinPkgName, BinPkgName(BinPkgName), Relation(Rel), Relations, SrcPkgName(SrcPkgName)) import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relation(..)) import Debian.Release (parseReleaseName) import Debian.Time (getCurrentLocalRFC822Time) import Debian.Version (buildDebianVersion, DebianVersion, parseDebianVersion)-import Debug.Trace (trace) import Distribution.Compiler (CompilerFlavor(GHC))-#if MIN_VERSION_Cabal(1,21,0)+#if MIN_VERSION_Cabal(1,22,0) import Distribution.Compiler (CompilerFlavor(GHCJS)) #endif import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))-import Distribution.PackageDescription (PackageDescription)-import Distribution.PackageDescription as Cabal (allBuildInfo, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), maintainer, author)+import Distribution.PackageDescription (FlagName(FlagName), PackageDescription)+import Distribution.PackageDescription as Cabal (allBuildInfo, author, BuildInfo(buildable, extraLibs), Executable(buildInfo, exeName), maintainer) import qualified Distribution.PackageDescription as Cabal (PackageDescription(dataDir, dataFiles, executables, library, package))-import Prelude hiding (init, log, map, unlines, unlines, writeFile, (.))-import System.FilePath ((</>), (<.>), makeRelative, splitFileName, takeDirectory, takeFileName)+import Paths_cabal_debian (version)+import Prelude hiding ((.), init, log, map, unlines, unlines, writeFile)+import System.Environment (getProgName)+import System.FilePath ((<.>), (</>), makeRelative, splitFileName, takeDirectory, takeFileName) import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr(..)) import Text.PrettyPrint.HughesPJClass (Pretty(pPrint)) --- | Given an Atoms value, get any additional configuration--- information from the environment, read the cabal package--- description and possibly the debian/changelog file, then generate--- and return the new debianization (along with the data directory--- computed from the cabal package description.)-debianize :: (MonadIO m, Functor m) => DebT m () -> DebT m ()+-- | @debianize customize@ initializes the CabalT state from the+-- environment and the cabal package description in (and possibly the+-- debian/changelog file) from the current directory, then runs+-- @customize@ and finalizes the debianization so it is ready to be+-- output.+debianize :: (MonadIO m, Functor m) => CabalT m () -> CabalT m () debianize customize =     do compileEnvironmentArgs        compileCommandlineArgs-       inputCabalization-       inputChangeLog+       liftCabal inputChangeLog        customize        finalizeDebianization  -- | Do some light IO and call finalizeDebianization.-finalizeDebianization :: (MonadIO m, Functor m) => DebT m ()+finalizeDebianization :: (MonadIO m, Functor m) => CabalT m () finalizeDebianization =     do date <- liftIO getCurrentLocalRFC822Time        debhelperCompat <- liftIO getDebhelperCompatLevel        finalizeDebianization' date debhelperCompat-       access T.verbosity >>= \ vb -> when (vb >= 3) (get >>= liftIO . A.showAtoms)+       vb <- access (verbosity . D.flags . A.debInfo)+       when (vb >= 3) (get >>= \ x -> liftIO (putStrLn ("\nFinalized Cabal Info: " ++ show x ++ "\n")))  -- | Now that we know the build and data directories, we can expand -- some atoms into sets of simpler atoms which can eventually be@@ -88,32 +91,35 @@ -- this function is not idempotent.  (Exported for use in unit tests.) -- FIXME: we should be able to run this without a PackageDescription, change --        paramter type to Maybe PackageDescription and propagate down thru code-finalizeDebianization'  :: (MonadIO m, Functor m) => String -> Maybe Int -> DebT m ()+finalizeDebianization'  :: (MonadIO m, Functor m) => String -> Maybe Int -> CabalT m () finalizeDebianization' date debhelperCompat =     do -- In reality, hcs must be a singleton or many things won't work.  But some day...-       hcs <- Set.toList <$> access A.compilerFlavors+       hc <- access (compilerFlavor . D.flags . A.debInfo)        finalizeSourceName B.HaskellSource-       List.mapM_ checkOfficialSettings hcs-       List.mapM_ addExtraLibDependencies hcs-       Just pkgDesc <- access T.packageDescription-       T.watch ~?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))-       T.sourceSection ~?= Just (MainSection "haskell")-       T.sourcePriority ~?= Just Extra-       T.sourceFormat ~?= Just Quilt3-       T.compat ~?= debhelperCompat+       checkOfficialSettings hc+       addExtraLibDependencies hc+       pkgDesc <- access A.packageDescription+       (D.watch . A.debInfo) ~?= Just (watchAtom (pkgName $ Cabal.package $ pkgDesc))+       (S.section . D.control . A.debInfo) ~?= Just (MainSection "haskell")+       (S.priority . D.control . A.debInfo) ~?= Just Extra+       (D.sourceFormat . A.debInfo) ~?= Just Quilt3+       (D.compat . A.debInfo) ~?= debhelperCompat        finalizeChangelog date        finalizeControl        finalizeRules        -- T.license ~?= Just (Cabal.license pkgDesc)        expandAtoms        -- Create the binary packages for the web sites, servers, backup packges, and other executables-       access T.executable >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access T.backups >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access T.serverInfo >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       access T.website >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList-       putBuildDeps pkgDesc-       List.mapM_ (librarySpecs pkgDesc) hcs-       List.mapM_ (makeUtilsPackage pkgDesc) hcs+       access (D.executable . A.debInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       access (D.backups . A.debInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       access (D.serverInfo . A.debInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       access (D.website . A.debInfo) >>= List.mapM_ (cabalExecBinaryPackage . fst) . Map.toList+       -- Make sure all the control file sections exist before doing the build dependencies,+       -- because we need to filter out self dependencies.+       librarySpecs pkgDesc hc+       makeUtilsPackage pkgDesc hc+       debs <- access (S.binaryPackages . D.control . A.debInfo) >>= return . List.map (getL B.package)+       putBuildDeps 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@@ -124,10 +130,10 @@ -- description fields from the cabal descriptions and the values that -- have already been set. {--finalizeDescriptions :: (Monad m, Functor m) => DebT m ()+finalizeDescriptions :: (Monad m, Functor m) => CabalT m () finalizeDescriptions = access T.binaryPackages >>= List.mapM_ finalizeDescription -finalizeDescription :: (Monad m, Functor m) => B.BinaryDebDescription -> DebT m ()+finalizeDescription :: (Monad m, Functor m) => B.BinaryDebDescription -> CabalT m () finalizeDescription bdd =     do let b = getL B.package bdd        cabDesc <- describe@@ -141,12 +147,12 @@ -- the cabal version of the package.  Otherwise, the cabal version is -- combined with the given epoch number and revision string to create -- a version.-debianVersion :: Monad m => DebT m DebianVersion+debianVersion :: Monad m => CabalT m DebianVersion debianVersion =-    do pkgDesc <- access T.packageDescription >>= maybe (error "debianVersion: no PackageDescription") return+    do pkgDesc <- access A.packageDescription        let pkgId = Cabal.package pkgDesc        epoch <- debianEpoch (pkgName pkgId)-       debVer <- access T.debVersion+       debVer <- access (D.debVersion . A.debInfo)        case debVer of          Just override              | override < parseDebianVersion (ppDisplay (pkgVersion pkgId)) ->@@ -156,13 +162,13 @@          Just override -> return override          Nothing ->              do let ver = ppDisplay (pkgVersion pkgId)-                rev <- access T.revision+                rev <- access (D.revision . A.debInfo)                 let rev'  = case rev of Nothing -> Nothing                                         Just "" -> Nothing                                         Just "-" -> Nothing                                         Just ('-':r) -> Just r                                         Just _ -> error "The Debian revision needs to start with a dash"-                fmt <- access T.sourceFormat+                fmt <- access (D.sourceFormat . A.debInfo)                 -- If no revision number has been set and the format                 -- is not Native3 we need to set it (see                 -- https://github.com/ddssff/cabal-debian/issues/16)@@ -173,16 +179,16 @@  -- | Return the Debian epoch number assigned to the given cabal -- package - the 1 in version numbers like 1:3.5-2.-debianEpoch :: Monad m => PackageName -> DebT m (Maybe Int)-debianEpoch name = get >>= return . Map.lookup name . getL T.epochMap+debianEpoch :: Monad m => PackageName -> CabalT m (Maybe Int)+debianEpoch name = get >>= return . Map.lookup name . getL A.epochMap  -- | Compute and return the debian source package name, based on the -- sourcePackageName if it was specified, and constructed from the -- cabal name otherwise.-finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> DebT m ()+finalizeSourceName :: (Monad m, Functor m) => B.PackageType -> CabalT m () finalizeSourceName typ =     do DebBase debName <- debianNameBase-       T.sourcePackageName ~?= Just (SrcPkgName (case typ of+       (D.sourcePackageName . A.debInfo) ~?= Just (SrcPkgName (case typ of                                                    B.HaskellSource -> "haskell-" ++ debName                                                    B.Source -> debName                                                    _ -> error $ "finalizeSourceName: " ++ show typ))@@ -198,19 +204,19 @@ --    6. the Debian Haskell Group, @pkg-haskell-maintainers\@lists.alioth.debian.org@ -- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Maintainer> -- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Uploaders>-finalizeMaintainer :: MonadIO m => DebT m ()+finalizeMaintainer :: MonadIO m => CabalT m () finalizeMaintainer = do-  o <- access T.official+  o <- access (D.official . A.debInfo)   currentUser <- liftIO getCurrentDebianUser-  Just pkgDesc <- access T.packageDescription-  maintainerOption <- access T.maintainerOption-  uploadersOption <- access T.uploadersOption+  pkgDesc <- access A.packageDescription+  maintainerOption <- access (D.maintainerOption . A.debInfo)+  uploadersOption <- access (D.uploadersOption . A.debInfo)   let cabalAuthorString = takeWhile (\ c -> c /= ',' && c /= '\n') (Cabal.author pkgDesc)       cabalMaintainerString = takeWhile (\ c -> c /= ',' && c /= '\n') (Cabal.maintainer pkgDesc)       cabalMaintainerString' = cabalAuthorString <> " <" <> cabalMaintainerString <> ">"       cabalMaintainerString'' = cabalAuthorString <> " " <> cabalMaintainerString   changelogSignature <--      do log <- get >>= return . getL T.changelog+      do log <- access (D.changelog . A.debInfo)          case log of            Just (ChangeLog (entry : _)) ->                case (parseMaintainer (logWho entry)) of@@ -219,88 +225,95 @@            _ -> return Nothing   case o of     True -> do-      (S.maintainer . T.control) ~= Just haskellMaintainer-      (S.uploaders . T.control) %= whenEmpty (maybe [] (: []) currentUser)+      (S.maintainer . D.control . A.debInfo) ~= Just haskellMaintainer+      (S.uploaders . D.control . A.debInfo) %= whenEmpty (maybe [] (: []) currentUser)     False -> do-      (S.maintainer . T.control) ~?= maintainerOption-      (S.maintainer . T.control) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString)-      (S.maintainer . T.control) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString')-      (S.maintainer . T.control) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'')+      (S.maintainer . D.control . A.debInfo) ~?= maintainerOption+      (S.maintainer . D.control . A.debInfo) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString)+      (S.maintainer . D.control . A.debInfo) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString')+      (S.maintainer . D.control . A.debInfo) ~?= (either (const Nothing) Just $ parseMaintainer cabalMaintainerString'')       -- Sometimes the maintainer is just an email, if it matches the author's email we can use it-      (S.maintainer . T.control) ~?= (case parseMaintainer cabalAuthorString of+      (S.maintainer . D.control . A.debInfo) ~?= (case parseMaintainer cabalAuthorString of                                         Right x | nameAddr_addr x == cabalMaintainerString -> Just x                                         _ -> Nothing)       -- Sometimes the maintainer is just an email, try combining it with the author's name-      (S.maintainer . T.control) ~?= (case parseMaintainer cabalAuthorString of+      (S.maintainer . D.control . A.debInfo) ~?= (case parseMaintainer cabalAuthorString of                                         Right (NameAddr {nameAddr_name = Just name}) -> either (const Nothing) Just (parseMaintainer (name ++ " <" ++ cabalMaintainerString ++ ">"))                                         _ -> Nothing)-      (S.maintainer . T.control) ~?= currentUser-      (S.maintainer . T.control) ~?= changelogSignature-      x <- access (S.maintainer . T.control)+      (S.maintainer . D.control . A.debInfo) ~?= currentUser+      (S.maintainer . D.control . A.debInfo) ~?= changelogSignature+      x <- access (S.maintainer . D.control . A.debInfo)       when (isNothing x)             (do liftIO $ putStrLn ("Unable to construct a debian maintainer, using nobody <nobody@nowhere>. Cabal maintainer strings tried:\n " ++                                   show cabalMaintainerString ++ ", " ++ show cabalMaintainerString' ++ ", " ++ show cabalMaintainerString'' ++                                   ", currentUser: " ++ show currentUser)                return ())-      (S.maintainer . T.control) ~?= (either (const Nothing) Just $ parseMaintainer "nobody <nobody@nowhere>")-      (S.uploaders . T.control) %= whenEmpty uploadersOption+      (S.maintainer . D.control . A.debInfo) ~?= (either (const Nothing) Just $ parseMaintainer "nobody <nobody@nowhere>")+      (S.uploaders . D.control . A.debInfo) %= whenEmpty uploadersOption  -- | If l is the empty list return d, otherwise return l. whenEmpty :: [a] -> [a] -> [a] whenEmpty d [] = d whenEmpty _ l = l -finalizeControl :: (MonadIO m, Functor m) => DebT m ()+finalizeControl :: (MonadIO m, Functor m) => CabalT m () finalizeControl =     do finalizeMaintainer-       Just src <- access T.sourcePackageName-       T.source ~= Just src-       desc <- describe-       (S.xDescription . T.control) ~?= Just desc+       Just src <- access (D.sourcePackageName . A.debInfo)+       (S.source . D.control . A.debInfo) ~= Just src+       desc' <- describe+       (S.xDescription . D.control . A.debInfo) ~?= Just desc'        -- control %= (\ y -> y { D.source = Just src, D.maintainer = Just maint })  -- | 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 -- version number is the exact one in our debianization.)-finalizeChangelog :: (MonadIO m, Functor m) => String -> DebT m ()+finalizeChangelog :: (MonadIO m, Functor m) => String -> CabalT m () finalizeChangelog date =     do finalizeMaintainer        ver <- debianVersion-       src <- access T.sourcePackageName-       Just debianMaintainer <- access (S.maintainer . T.control)+       src <- access (D.sourcePackageName . A.debInfo)+       Just debianMaintainer <- access (S.maintainer . D.control . A.debInfo)        -- pkgDesc <- access T.packageDescription >>= return . maybe Nothing (either Nothing Just . parseMaintainer . Cabal.maintainer)-       cmts <- access T.comments-       T.changelog %= fmap (dropFutureEntries ver)-       T.changelog %= fixLog src ver cmts debianMaintainer+       cmts <- access (D.comments . A.debInfo)+       (D.changelog . A.debInfo) %= fmap (dropFutureEntries ver)+       prog <- liftIO getProgName+       let msg = pack ("Debianization generated by cabal-debian-" ++ showVersion version ++ " (" ++ show prog ++ ")")+       (D.changelog . A.debInfo) %= fixLog src ver cmts debianMaintainer msg     where+      fixLog :: Maybe SrcPkgName -> DebianVersion -> Maybe [[Text]] -> NameAddr -> Text -> Maybe ChangeLog -> Maybe ChangeLog       -- Ensure that the package name is correct in the first log entry.-      fixLog src ver cmts _maint (Just (ChangeLog (entry : older))) | logVersion entry == ver =-          Just (ChangeLog (entry { logPackage = show (pPrint (PP src))+      fixLog src ver cmts _maint _ (Just (ChangeLog (entry : older)))+          | logVersion entry == ver =+              let entry' = entry { logPackage = show (pPrint (PP src))                                  , logComments = logComments entry ++ "\n" ++                                                  (List.unlines $ List.map (("  * " <>) . List.intercalate "\n    " . List.map unpack) (fromMaybe [] cmts))-                                 } : older))+                                 } in+              Just (ChangeLog (entry' : older))       -- The newest log entry isn't exactly ver, build a new entry.-      fixLog src ver cmts maint log =-          Just (ChangeLog (Entry { logPackage = show (pPrint (PP src))+      fixLog src ver cmts maint msg log =+          let entry = Entry { logPackage = show (pPrint (PP src))                                  , logVersion = ver                                  , logDists = [parseReleaseName "UNRELEASED"]                                  , logUrgency = "low"-                                 , logComments = List.unlines $ List.map (("  * " <>) . List.intercalate "\n    " . List.map unpack)-                                                 (fromMaybe [["Debianization generated by cabal-debian"]] cmts)+                                 , logComments =+                                     List.unlines $ List.map (("  * " <>) . List.intercalate "\n    " . List.map unpack) (fromMaybe [[msg]] cmts)                                  , logWho = ppDisplay maint-                                 , logDate = date } : maybe [] (\ (ChangeLog entries) -> entries) log))+                                 , logDate = date } in+          -- Creating new log entry for version+          Just (ChangeLog (entry : maybe [] (\ (ChangeLog entries) -> entries) log))  -- | Convert the extraLibs field of the cabal build info into debian -- binary package names and make them dependendencies of the debian -- devel package (if there is one.)-addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> DebT m ()+addExtraLibDependencies :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () addExtraLibDependencies hc =-    do pkgDesc <- access T.packageDescription >>= maybe (error "addExtraLibDependencies: no PackageDescription") return+    do pkgDesc <- access A.packageDescription        devName <- debianName B.Development hc-       libMap <- access T.extraLibMap-       binNames <- List.map (getL B.package) <$> access T.binaryPackages-       when (any (== devName) binNames) (T.depends devName %= \ deps -> deps ++ g pkgDesc libMap)+       libMap <- access (D.extraLibMap . A.debInfo)+       binNames <- List.map (getL B.package) <$> access (S.binaryPackages . D.control . A.debInfo)+       when (any (== devName) binNames) ((B.depends . B.relations . D.binaryDebDescription devName . A.debInfo) %= \ deps -> deps ++ g pkgDesc libMap)     where       g :: PackageDescription -> Map String Relations -> Relations       g pkgDesc libMap = concatMap (devDep libMap) (nub $ concatMap Cabal.extraLibs $ Cabal.allBuildInfo $ pkgDesc)@@ -308,89 +321,96 @@       devDep libMap cab = maybe [[Rel (BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]] id (Map.lookup cab libMap)  -- | Applies a few settings to official packages (unless already set)-checkOfficialSettings :: (Monad m, Functor m) => CompilerFlavor -> DebT m ()+checkOfficialSettings :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () checkOfficialSettings flavor =-    do o <- access T.official+    do o <- access (D.official . A.debInfo)        when o $ case flavor of                   GHC -> officialSettings                   _ -> error $ "There is no official packaging for " ++ show flavor -officialSettings :: (Monad m, Functor m) => DebT m ()+officialSettings :: (Monad m, Functor m) => CabalT m () officialSettings =-    do pkgDesc <- access T.packageDescription >>= maybe (error "officialSettings: no PackageDescription") return+    do pkgDesc <- access A.packageDescription        let PackageName cabal = pkgName (Cabal.package pkgDesc) -       T.standardsVersion ~?= Just (parseStandardsVersion "3.9.5")-       T.homepage ~?= Just ("http://hackage.haskell.org/package/" <> pack cabal)-       T.omitProfVersionDeps ~= True-       SrcPkgName src <- access T.sourcePackageName >>= maybe (error "officialSettings: no sourcePackageName") return+       (S.standardsVersion . D.control . A.debInfo) ~?= Just (parseStandardsVersion "3.9.5")+       (S.homepage . D.control . A.debInfo) ~?= Just ("http://hackage.haskell.org/package/" <> pack cabal)+       (D.omitProfVersionDeps . A.debInfo) ~= True+       SrcPkgName src <- access (D.sourcePackageName . A.debInfo) >>= maybe (error "officialSettings: no sourcePackageName") return -       T.vcsFields %= Set.union (Set.fromList+       (S.vcsFields . D.control . A.debInfo) %= Set.union (Set.fromList           [ S.VCSBrowser $ "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/" <> pack src           , S.VCSDarcs  $ "http://darcs.debian.org/pkg-haskell/" <> pack src           ])-  -putBuildDeps :: (MonadIO m, Functor m) => PackageDescription -> DebT m ()-putBuildDeps pkgDesc =-    do deps <- debianBuildDeps pkgDesc-       depsIndep <- debianBuildDepsIndep pkgDesc-       T.buildDepends ~= deps-       T.buildDependsIndep ~= depsIndep+putBuildDeps :: (MonadIO m, Functor m) => [BinPkgName] -> PackageDescription -> CabalT m ()+putBuildDeps thisPackageDebs pkgDesc =+    do deps <- debianBuildDeps pkgDesc >>= return . filterRelations thisPackageDebs+       depsIndep <- debianBuildDepsIndep pkgDesc >>= return . filterRelations thisPackageDebs+       (S.buildDepends . D.control . A.debInfo) ~= deps+       (S.buildDependsIndep . D.control . A.debInfo) ~= depsIndep -cabalExecBinaryPackage :: Monad m => BinPkgName -> DebT m ()+-- | Filter out any relations that mention any of the bad package names.+filterRelations :: [BinPkgName] -> Relations -> Relations+filterRelations badNames orRels =+    List.filter (not . List.null) (List.map filterOrRelation orRels)+    where+      filterOrRelation :: [Relation] -> [Relation]+      filterOrRelation rels = List.filter (\ (Rel name _ _) -> not (elem name badNames)) rels++cabalExecBinaryPackage :: Monad m => BinPkgName -> CabalT m () cabalExecBinaryPackage b =-    do T.packageType b ~?= Just B.Exec-       T.binaryArchitectures b ~?= Just Any-       T.binarySection b ~?= Just (MainSection "misc")-       T.debianDescription b ~?= Just desc -- yeah, this same line is all over the place.+    do (B.packageType . D.binaryDebDescription b . A.debInfo) ~?= Just B.Exec+       (B.architecture . D.binaryDebDescription b . A.debInfo) ~?= Just Any+       (B.binarySection . D.binaryDebDescription b . A.debInfo) ~?= Just (MainSection "misc")+       (B.description . D.binaryDebDescription b . A.debInfo) ~?= Just desc -- yeah, this same line is all over the place.        binaryPackageRelations b B.Exec     where -binaryPackageRelations :: Monad m => BinPkgName -> B.PackageType -> DebT m ()+binaryPackageRelations :: Monad m => BinPkgName -> B.PackageType -> CabalT m () binaryPackageRelations b typ =-    do edds <- access T.extraDevDeps-       T.depends b %= \ rels ->+    do edds <- access (D.extraDevDeps . A.debInfo)+       (B.depends . B.relations . D.binaryDebDescription b . A.debInfo) %= \ rels ->           [anyrel "${haskell:Depends}", anyrel "${misc:Depends}"] ++           [anyrel "${shlibs:Depends}" | typ `notElem` [B.Profiling, B.Documentation] ] ++           edds ++ rels-       T.recommends b %= \ rels -> [anyrel "${haskell:Recommends}"] ++ rels-       T.suggests b %= \ rels -> [anyrel "${haskell:Suggests}"] ++ rels-       T.preDepends b ~= []-       T.breaks b ~= []-       T.conflicts b %= \ rels -> [anyrel "${haskell:Conflicts}"] ++ rels-       T.provides b %= \ rels -> (if typ /= B.Documentation then [anyrel "${haskell:Provides}"] else []) ++ rels+       (B.recommends . B.relations . D.binaryDebDescription b . A.debInfo) %= \ rels -> [anyrel "${haskell:Recommends}"] ++ rels+       (B.suggests . B.relations . D.binaryDebDescription b . A.debInfo) %= \ rels -> [anyrel "${haskell:Suggests}"] ++ rels+       (B.preDepends . B.relations . D.binaryDebDescription b . A.debInfo) ~= []+       (B.breaks . B.relations . D.binaryDebDescription b . A.debInfo) ~= []+       (B.conflicts . B.relations . D.binaryDebDescription b . A.debInfo) %= \ rels -> [anyrel "${haskell:Conflicts}"] ++ rels+       (B.provides . B.relations . D.binaryDebDescription b . A.debInfo) %= \ rels -> (if typ /= B.Documentation then [anyrel "${haskell:Provides}"] else []) ++ rels        -- T.replaces b %= \ rels -> [anyrel "${haskell:Replaces}"] ++ rels-       T.builtUsing b ~= []+       (B.builtUsing . B.relations . D.binaryDebDescription b . A.debInfo) ~= []  -- | Add the library paragraphs for a particular compiler flavor.-librarySpecs :: (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> DebT m ()+librarySpecs :: (Monad m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () librarySpecs pkgDesc hc =     do let dev = isJust (Cabal.library pkgDesc)-       doc <- get >>= return . not . getL T.noDocumentationLibrary-       prof <- get >>= return . not . getL T.noProfilingLibrary+       doc <- get >>= return . not . getL (D.noDocumentationLibrary . A.debInfo)+       prof <- get >>= return . not . getL (D.noProfilingLibrary . A.debInfo)        when dev (librarySpec Any B.Development hc)        when (dev && prof && hc == GHC) (librarySpec Any B.Profiling hc)        when (dev && doc) (docSpecsParagraph hc) -docSpecsParagraph :: (Monad m, Functor m) => CompilerFlavor -> DebT m ()+docSpecsParagraph :: (Monad m, Functor m) => CompilerFlavor -> CabalT m () docSpecsParagraph hc =     do b <- debianName B.Documentation hc        binaryPackageRelations b B.Documentation-       T.packageType b ~?= Just B.Documentation-       T.packageType b ~?= Just B.Documentation-       T.binaryArchitectures b ~= Just All-       T.binarySection b ~?= Just (MainSection "doc")-       T.debianDescription b ~?= Just desc+       (B.packageType . D.binaryDebDescription b . A.debInfo) ~?= Just B.Documentation+       (B.packageType . D.binaryDebDescription b . A.debInfo) ~?= Just B.Documentation+       (B.architecture . D.binaryDebDescription b . A.debInfo) ~= Just All+       (B.binarySection . D.binaryDebDescription b . A.debInfo) ~?= Just (MainSection "doc")+       (B.description . D.binaryDebDescription b . A.debInfo) ~?= Just desc -librarySpec :: (Monad m, Functor m) => PackageArchitectures -> B.PackageType -> CompilerFlavor -> DebT m ()+librarySpec :: (Monad m, Functor m) => PackageArchitectures -> B.PackageType -> CompilerFlavor -> CabalT m () librarySpec arch typ hc =     do b <- debianName typ hc        binaryPackageRelations b typ-       T.packageType b ~?= Just typ-       T.packageType b ~?= Just typ-       T.binaryArchitectures b ~?= Just arch-       T.debianDescription b ~?= Just desc+       (B.packageType . D.binaryDebDescription b . A.debInfo) ~?= Just typ+       (B.packageType . D.binaryDebDescription b . A.debInfo) ~?= Just typ+       (B.architecture . D.binaryDebDescription b . A.debInfo) ~?= Just arch+       (B.description . D.binaryDebDescription b . A.debInfo) ~?= Just desc  -- | This is the standard value for the Description field of a binary -- package control file stanza.@@ -407,24 +427,24 @@ -- files, assign them to the packages returned by the -- utilsPackageNames lens, and make sure those packages are in the -- source deb description.-makeUtilsPackage :: forall m. (MonadIO m, Functor m) => PackageDescription -> CompilerFlavor -> DebT m ()+makeUtilsPackage :: forall m. (MonadIO m, Functor m) => PackageDescription -> CompilerFlavor -> CabalT m () makeUtilsPackage pkgDesc hc =     do -- Files the cabal package expects to be installed        -- Files that are already assigned to any binary deb        installedDataMap <- Set.fold (\ x r ->                                          case x of-                                           A.Install b from _ -> Map.insertWith Set.union b (singleton from) r-                                           A.InstallTo b from _ -> Map.insertWith Set.union b (singleton from) r-                                           A.InstallData b from _ -> Map.insertWith Set.union b (singleton from) r-                                           _ -> r) mempty <$> access A.atomSet :: DebT m (Map BinPkgName (Set FilePath))+                                           D.Install b from _ -> Map.insertWith Set.union b (singleton from) r+                                           D.InstallTo b from _ -> Map.insertWith Set.union b (singleton from) r+                                           D.InstallData b from _ -> Map.insertWith Set.union b (singleton from) r+                                           _ -> r) mempty <$> access (D.atomSet . A.debInfo) :: CabalT m (Map BinPkgName (Set FilePath))        installedExecMap <- Set.fold (\ x r ->                                          case x of-                                           A.InstallCabalExec b name _ -> Map.insertWith Set.union b (singleton name) r-                                           A.InstallCabalExecTo b name _ -> Map.insertWith Set.union b (singleton name) r-                                           _ -> r) mempty <$> access A.atomSet :: DebT m (Map BinPkgName (Set String))+                                           D.InstallCabalExec b name _ -> Map.insertWith Set.union b (singleton name) r+                                           D.InstallCabalExecTo b name _ -> Map.insertWith Set.union b (singleton name) r+                                           _ -> r) mempty <$> access (D.atomSet . A.debInfo) :: CabalT m (Map BinPkgName (Set String))         -- The names of cabal executables that go into eponymous debs-       insExecPkg <- access T.executable >>= return . Set.map ename . Set.fromList . elems+       insExecPkg <- access (D.executable . A.debInfo) >>= return . Set.map ename . Set.fromList . elems         let installedData = Set.map (\ a -> (a, a)) $ Set.unions (Map.elems installedDataMap)            installedExec = Set.unions (Map.elems installedExecMap)@@ -435,9 +455,9 @@        let availableData = Set.union installedData dataFilePaths            availableExec = Set.union installedExec execFilePaths -       access T.utilsPackageNameBase >>= \ name ->+       access (D.utilsPackageNameBase . A.debInfo) >>= \ name ->            case name of-             Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> T.utilsPackageNameBase ~= Just name'+             Nothing -> debianName B.Utilities hc >>= \ (BinPkgName name') -> (D.utilsPackageNameBase . A.debInfo) ~= Just name'              _ -> return ()        b <- debianName B.Utilities hc @@ -453,34 +473,39 @@            utilsExecMissing = Set.difference utilsExec installedExec        -- If any files belong in the utils packages, make sure they exist        when (not (Set.null utilsData && Set.null utilsExec)) $ do-         T.debianDescription b ~?= Just desc+         (B.description . D.binaryDebDescription b . A.debInfo) ~?= Just desc          -- This is really for all binary debs except the libraries - I'm not sure why-         T.rulesFragments += (pack ("build" </> ppDisplay b ++ ":: build-ghc-stamp\n"))-         T.binaryArchitectures b ~?= Just (if Set.null utilsExec then All else Any)-         T.binarySection b ~?= Just (MainSection "misc")+         (D.rulesFragments . A.debInfo)+= (pack ("build" </> ppDisplay b ++ ":: build-ghc-stamp\n"))+         (B.architecture . D.binaryDebDescription b . A.debInfo) ~?= Just (if Set.null utilsExec then All else Any)+         (B.binarySection . D.binaryDebDescription b . A.debInfo) ~?= Just (MainSection "misc")          binaryPackageRelations b B.Utilities        -- Add the unassigned files to the utils packages-       Set.mapM_ (uncurry (T.installData b)) utilsDataMissing-       Set.mapM_ (\ name -> T.installCabalExec b name "usr/bin") utilsExecMissing+       Set.mapM_ (\ (foo, bar) -> (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallData b foo bar)) utilsDataMissing+       Set.mapM_ (\ name -> (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallCabalExec b name "usr/bin")) utilsExecMissing     where       ename i =-          case A.sourceDir i of-            (Nothing) -> A.execName i-            (Just s) ->  s </> A.execName i+          case D.sourceDir i of+            (Nothing) -> D.execName i+            (Just s) ->  s </> D.execName i -expandAtoms :: Monad m => DebT m ()+expandAtoms :: MonadIO m => CabalT m () expandAtoms =-    do hcs <- access A.compilerFlavors >>= return . Set.toList-       builddir <- access T.buildDir >>= return . fromEmpty (case hcs of-                                                               [GHC] -> singleton "dist-ghc/build"-#if MIN_VERSION_Cabal(1,21,0)-                                                               [GHCJS] -> singleton "dist-ghcjs/build"+    do hc <- access (compilerFlavor . D.flags . A.debInfo)+       case hc of+         GHC -> (cabalFlagAssignments . D.flags . A.debInfo) %= (Set.union (Set.fromList (flagList "--ghc")))+#if MIN_VERSION_Cabal(1,22,0)+         GHCJS -> (cabalFlagAssignments . D.flags . A.debInfo) %= (Set.union (Set.fromList (flagList "--ghcjs"))) #endif-                                                               _ -> error $ "Unexpected compiler: " ++ show hcs)-       dDir <- access T.packageDescription >>= maybe (error "expandAtoms") (return . dataDir)+       builddir <- access (D.buildDir . A.debInfo) >>= return . fromMaybe (case hc of+                                                               GHC -> "dist-ghc/build"+#if MIN_VERSION_Cabal(1,22,0)+                                                               GHCJS -> "dist-ghcjs/build"+#endif+                                                               _ -> error $ "Unexpected compiler: " ++ show hc)+       dDir <- dataDir        expandApacheSites-       expandInstallCabalExecs (fromSingleton (error "no builddir") (\ xs -> error $ "multiple builddirs:" ++ show xs) builddir)-       expandInstallCabalExecTo (fromSingleton (error "no builddir") (\ xs -> error $ "multiple builddirs:" ++ show xs) builddir)+       expandInstallCabalExecs builddir+       expandInstallCabalExecTo builddir        expandInstallData dDir        expandInstallTo        expandFile@@ -489,28 +514,29 @@        expandBackups        expandExecutable     where-      expandApacheSites :: Monad m => DebT m ()+      expandApacheSites :: Monad m => CabalT m ()       expandApacheSites =-          do mp <- get >>= return . getL T.apacheSite+          do mp <- get >>= return . getL (D.apacheSite . A.debInfo)              List.mapM_ expandApacheSite (Map.toList mp)           where             expandApacheSite (b, (dom, log, text)) =-                do T.link b ("/etc/apache2/sites-available/" ++ dom) ("/etc/apache2/sites-enabled/" ++ dom)-                   T.installDir b log-                   T.file b ("/etc/apache2/sites-available" </> dom) text+                do (D.atomSet . A.debInfo) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ dom) ("/etc/apache2/sites-enabled/" ++ dom))+                   (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallDir b log)+                   (D.atomSet . A.debInfo) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" </> dom) text)        -- Turn A.InstallCabalExec into A.Install-      expandInstallCabalExecs :: Monad m => FilePath -> DebT m ()+      expandInstallCabalExecs :: Monad m => FilePath -> CabalT m ()       expandInstallCabalExecs builddir = do-        hcs <- access A.compilerFlavors >>= return . Set.toList-        access A.atomSet >>= List.mapM_ (doAtom hcs) . Set.toList+        hc <- access (compilerFlavor . D.flags . A.debInfo)+        access (D.atomSet . A.debInfo) >>= Set.mapM_ (doAtom hc)           where-            doAtom [GHC] (A.InstallCabalExec b name dest) = T.install b (builddir </> name </> name) dest+            doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()+            doAtom GHC (D.InstallCabalExec b name dest) = (D.atomSet . A.debInfo) %= (Set.insert $ D.Install b (builddir </> name </> name) dest)+#if MIN_VERSION_Cabal(1,22,0)             -- A GHCJS executable is a directory with files, copy them             -- all into place.-#if MIN_VERSION_Cabal(1,21,0)-            doAtom [GHCJS] (A.InstallCabalExec b name dest) =-                T.rulesFragments +=+            doAtom GHCJS (D.InstallCabalExec b name dest) =+                (D.rulesFragments . A.debInfo) +=                      (Text.unlines                         [ pack ("binary-fixup" </> ppDisplay b) <> "::"                         , pack ("\t(cd " <> builddir </> name <> " && find " <> name <.> "jsexe" <> " -type f) |\\\n" <>@@ -519,85 +545,91 @@             doAtom _ _ = return ()        -- Turn A.InstallCabalExecTo into a make rule-      expandInstallCabalExecTo :: Monad m => FilePath -> DebT m ()+      expandInstallCabalExecTo :: Monad m => FilePath -> CabalT m ()       expandInstallCabalExecTo builddir = do-        hcs <- access A.compilerFlavors >>= return . Set.toList-        access A.atomSet >>= List.mapM_ (doAtom hcs) . Set.toList+        hc <- access (compilerFlavor . D.flags . A.debInfo)+        access (D.atomSet . A.debInfo) >>= Set.mapM_ (doAtom hc)           where-            doAtom [GHC] (A.InstallCabalExecTo b name dest) =-                T.rulesFragments += (Text.unlines+            doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m ()+            doAtom GHC (D.InstallCabalExecTo b name dest) =+                (D.rulesFragments . A.debInfo) +=+                                     (Text.unlines                                        [ pack ("binary-fixup" </> ppDisplay b) <> "::"                                        , "\tinstall -Dps " <> pack (builddir </> name </> name) <> " "                                                            <> pack ("debian" </> ppDisplay b </> makeRelative "/" dest) ])-            doAtom hcs (A.InstallCabalExecTo b name dest) = error $ "expandInstallCabalExecTo " ++ show hcs ++ " " ++ show (A.InstallCabalExecTo b name dest)+            doAtom hc (D.InstallCabalExecTo b name dest) = error $ "expandInstallCabalExecTo " ++ show hc ++ " " ++ show (D.InstallCabalExecTo b name dest)             doAtom _ _ = return ()        -- Turn A.InstallData into either an Install or an InstallTo-      expandInstallData :: Monad m => FilePath -> DebT m ()+      expandInstallData :: Monad m => FilePath -> CabalT m ()       expandInstallData dDir =-          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          access (D.atomSet . A.debInfo) >>= List.mapM_ doAtom . Set.toList           where-            doAtom (A.InstallData b from dest) =+            doAtom :: Monad m => D.Atom -> CabalT m ()+            doAtom (D.InstallData b from dest) =                 if takeFileName from == takeFileName dest-                then T.install b from (dDir </> makeRelative "/" (takeDirectory dest))-                else T.installTo b from (dDir </> makeRelative "/" dest)+                then (D.atomSet . A.debInfo) %= (Set.insert $ D.Install b from (dDir </> makeRelative "/" (takeDirectory dest)))+                else (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallTo b from (dDir </> makeRelative "/" dest))             doAtom _ = return ()        -- Turn A.InstallTo into a make rule-      expandInstallTo :: Monad m => DebT m ()+      expandInstallTo :: Monad m => CabalT m ()       expandInstallTo =-          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          access (D.atomSet . A.debInfo) >>= List.mapM_ doAtom . Set.toList           where-            doAtom (A.InstallTo b from dest) =-                T.rulesFragments += (Text.unlines [ pack ("binary-fixup" </> ppDisplay b) <> "::"+            doAtom :: Monad m => D.Atom -> CabalT m ()+            doAtom (D.InstallTo b from dest) =+                (D.rulesFragments . A.debInfo) +=+                                    (Text.unlines [ pack ("binary-fixup" </> ppDisplay b) <> "::"                                                   , "\tinstall -Dp " <> pack from <> " " <> pack ("debian" </> ppDisplay b </> makeRelative "/" dest) ])             doAtom _ = return ()        -- Turn A.File into an intermediateFile and an A.Install-      expandFile :: Monad m => DebT m ()+      expandFile :: Monad m => CabalT m ()       expandFile =-          access A.atomSet >>= List.mapM_ doAtom . Set.toList+          access (D.atomSet . A.debInfo) >>= List.mapM_ doAtom . Set.toList           where-            doAtom (A.File b path text) =+            doAtom :: Monad m => D.Atom -> CabalT m ()+            doAtom (D.File b path text) =                 do let (destDir', destName') = splitFileName path                        tmpDir = "debian/cabalInstall" </> show (md5 (fromString (unpack text)))                        tmpPath = tmpDir </> destName'-                   T.intermediateFiles += (tmpPath, text)-                   T.install b tmpPath destDir'+                   (D.intermediateFiles . A.debInfo) += (tmpPath, text)+                   (D.atomSet . A.debInfo) %= (Set.insert $ D.Install b tmpPath destDir')             doAtom _ = return () -      expandWebsite :: Monad m => DebT m ()+      expandWebsite :: Monad m => CabalT m ()       expandWebsite =-          do mp <- get >>= return . getL T.website+          do mp <- get >>= return . getL (D.website . A.debInfo)              List.mapM_ (\ (b, site) -> modify (siteAtoms b site)) (Map.toList mp) -      expandServer :: Monad m => DebT m ()+      expandServer :: Monad m => CabalT m ()       expandServer =-          do mp <- get >>= return . getL T.serverInfo+          do mp <- get >>= return . getL (D.serverInfo . A.debInfo)              List.mapM_ (\ (b, x) -> modify (serverAtoms b x False)) (Map.toList mp) -      expandBackups :: Monad m => DebT m ()+      expandBackups :: Monad m => CabalT m ()       expandBackups =-          do mp <- get >>= return . getL T.backups+          do mp <- get >>= return . getL (D.backups . A.debInfo)              List.mapM_ (\ (b, name) -> modify (backupAtoms b name)) (Map.toList mp) -      expandExecutable :: Monad m => DebT m ()+      expandExecutable :: Monad m => CabalT m ()       expandExecutable =-          do mp <- get >>= return . getL T.executable+          do mp <- get >>= return . getL (D.executable . A.debInfo)              List.mapM_ (\ (b, f) -> modify (execAtoms b f)) (Map.toList mp)  -- | Add the normal default values to the rules files.-finalizeRules :: (Monad m) => DebT m ()+finalizeRules :: (Monad m, Functor m) => CabalT m () finalizeRules =     do DebBase b <- debianNameBase-       compilers <- access A.compilerFlavors-       A.rulesHead ~?= Just "#!/usr/bin/make -f"-       A.rulesSettings %= (++ ["DEB_CABAL_PACKAGE = " <> pack b])-       A.rulesSettings %= (++ (case Set.toList compilers of-                                 [x] -> ["DEB_DEFAULT_COMPILER = " <> pack (List.map toLower (show x))]-                                 _ -> []))-       A.rulesIncludes %= (++ ["include /usr/share/cdbs/1/rules/debhelper.mk",-                               "include /usr/share/cdbs/1/class/hlibrary.mk"])+       compiler <- access (compilerFlavor . D.flags . A.debInfo)+       (D.rulesHead . A.debInfo) ~?= Just "#!/usr/bin/make -f"+       (D.rulesSettings . A.debInfo) %= (++ ["DEB_CABAL_PACKAGE = " <> pack b])+       (D.rulesSettings . A.debInfo) %= (++ (["DEB_DEFAULT_COMPILER = " <> pack (List.map toLower (show compiler))]))+       flags <- (flagString . Set.toList) <$> access (cabalFlagAssignments . D.flags . A.debInfo)+       unless (List.null flags) ((D.rulesSettings . A.debInfo) %= (++ ["DEB_SETUP_GHC6_CONFIGURE_ARGS = " <> pack flags]))+       (D.rulesIncludes . A.debInfo) %= (++ ["include /usr/share/cdbs/1/rules/debhelper.mk",+                                             "include /usr/share/cdbs/1/class/hlibrary.mk"])  data Dependency_   = BuildDepends Dependency@@ -611,3 +643,12 @@  anyrel' :: D.BinPkgName -> [D.Relation] anyrel' x = [D.Rel x Nothing Nothing]++-- Lifted from Distribution.Simple.Setup, since it's not exported.+flagList :: String -> [(FlagName, Bool)]+flagList = List.map tagWithValue . words+  where tagWithValue ('-':name) = (FlagName (List.map toLower name), False)+        tagWithValue name       = (FlagName (List.map toLower name), True)++flagString :: [(FlagName, Bool)] -> String+flagString = List.intercalate " " . List.map (\ (FlagName s, sense) -> "-f" ++ (if sense then "" else "-") ++ s)

@@ -18,25 +18,27 @@     , execAtoms     ) where +import Control.Category ((.)) import Data.Char (isSpace)-import Data.Lens.Lazy (modL, access)-import Data.List as List (map, intersperse, intercalate, dropWhileEnd)+import Data.Lens.Lazy (access, modL)+import Data.List as List (dropWhileEnd, intercalate, intersperse, map) import Data.Map as Map (insertWith) import Data.Maybe (fromMaybe) import Data.Monoid ((<>))-import Data.Set as Set (insert, union, singleton)-import Data.Text as Text (Text, pack, unlines)-import Debian.Debianize.Monad (Atoms, DebT, execDebM)-import Debian.Debianize.Prelude (stripWith, (%=), (+=), (++=), (+++=))-import qualified Debian.Debianize.Types as T-import qualified Debian.Debianize.Types.Atoms as T+import Data.Set as Set (insert, singleton, union)+import Data.Text as Text (pack, Text, unlines)+import qualified Debian.Debianize.DebInfo as D+import Debian.Debianize.Monad (CabalInfo, CabalT, DebianT, execCabalM)+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, serverAccessLog, serverAppLog) import Debian.Pretty (ppDisplay, ppDisplay')-import Debian.Policy (apacheLogDirectory, apacheErrorLog, apacheAccessLog, databaseDirectory, serverAppLog, serverAccessLog) import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel)) import Distribution.Package (PackageName(PackageName)) import Distribution.PackageDescription as Cabal (PackageDescription(package, synopsis, description))-import Prelude hiding (writeFile, init, unlines, log, map)+import Prelude hiding ((.), init, log, map, unlines, writeFile) import System.FilePath ((</>))  showCommand :: String -> [String] -> String@@ -54,10 +56,10 @@ -- to find out B's version number, version B.  Then write a rule into -- P's .substvar that makes P require that that exact version of A, -- and another that makes P conflict with any older version of A.-tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebT m ()+tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m () tightDependencyFixup [] _ = return () tightDependencyFixup pairs p =-    T.rulesFragments +=+    D.rulesFragments +=           (Text.unlines $                ([ "binary-fixup/" <> name <> "::"                 , "\techo -n 'haskell:Depends=' >> debian/" <> name <> ".substvars" ] ++@@ -73,27 +75,27 @@       display' = ppDisplay'  -- | Add a debian binary package to the debianization containing a cabal executable file.-doExecutable :: Monad m => BinPkgName -> T.InstallFile -> DebT m ()-doExecutable p f = T.executable ++= (p, f)+doExecutable :: Monad m => BinPkgName -> D.InstallFile -> CabalT m ()+doExecutable p f = (D.executable . A.debInfo) ++= (p, f)  -- | Add a debian binary package to the debianization containing a cabal executable file set up to be a server.-doServer :: Monad m => BinPkgName -> T.Server -> DebT m ()-doServer p s = T.serverInfo ++= (p, s)+doServer :: Monad m => BinPkgName -> D.Server -> CabalT m ()+doServer p s = (D.serverInfo . A.debInfo) ++= (p, s)  -- | Add a debian binary package to the debianization containing a cabal executable file set up to be a web site.-doWebsite :: Monad m => BinPkgName -> T.Site -> DebT m ()-doWebsite p w = T.website ++= (p, w)+doWebsite :: Monad m => BinPkgName -> D.Site -> CabalT m ()+doWebsite p w = (D.website . A.debInfo) ++= (p, w)  -- | Add a debian binary package to the debianization containing a cabal executable file set up to be a backup script.-doBackups :: Monad m => BinPkgName -> String -> DebT m ()+doBackups :: Monad m => BinPkgName -> String -> CabalT m () doBackups bin s =-    do T.backups ++= (bin, s)-       T.depends bin %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])+    do (D.backups . A.debInfo) ++= (bin, s)+       (B.depends . B.relations . D.binaryDebDescription bin . A.debInfo) %= (++ [[Rel (BinPkgName "anacron") Nothing Nothing]])        -- depends +++= (bin, Rel (BinPkgName "anacron") Nothing Nothing) -describe :: Monad m => DebT m Text+describe :: Monad m => CabalT m Text describe =-    do Just p <- access T.packageDescription+    do p <- access A.packageDescription        return $           debianDescriptionBase p {- <> "\n" <>           case typ of@@ -151,30 +153,30 @@       desc = List.map addDot . stripWith null $ map (dropWhileEnd isSpace) $ lines $ Cabal.description p       addDot line = if null line then "." else line -oldClckwrksSiteFlags :: T.Site -> [String]+oldClckwrksSiteFlags :: D.Site -> [String] oldClckwrksSiteFlags x =     [ -- According to the happstack-server documentation this needs a trailing slash.-      "--base-uri", "http://" ++ T.domain x ++ "/"-    , "--http-port", show T.port]-oldClckwrksServerFlags :: T.Server -> [String]+      "--base-uri", "http://" ++ D.domain x ++ "/"+    , "--http-port", show D.port]+oldClckwrksServerFlags :: D.Server -> [String] oldClckwrksServerFlags x =     [ -- According to the happstack-server documentation this needs a trailing slash.-      "--base-uri", "http://" ++ T.hostname x ++ ":" ++ show (T.port x) ++ "/"-    , "--http-port", show T.port]+      "--base-uri", "http://" ++ D.hostname x ++ ":" ++ show (D.port x) ++ "/"+    , "--http-port", show D.port]  watchAtom :: PackageName -> Text watchAtom (PackageName pkgname) =     pack $ "version=3\nhttp://hackage.haskell.org/package/" ++ pkgname ++ "/distro-monitor .*-([0-9\\.]+)\\.(?:zip|tgz|tbz|txz|(?:tar\\.(?:gz|bz2|xz)))\n" --- FIXME - use Atoms-siteAtoms :: BinPkgName -> T.Site -> Atoms -> Atoms+siteAtoms :: BinPkgName -> D.Site -> CabalInfo -> CabalInfo siteAtoms b site =-    execDebM-      (do T.installDir b "/etc/apache2/sites-available"-          T.link b ("/etc/apache2/sites-available/" ++ T.domain site) ("/etc/apache2/sites-enabled/" ++ T.domain site)-          T.file b ("/etc/apache2/sites-available" </> T.domain site) apacheConfig-          T.installDir b (apacheLogDirectory b)-          T.logrotateStanza +++= (b, singleton+    execCabalM+      (do (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallDir b "/etc/apache2/sites-available")+          (D.atomSet . A.debInfo) %= (Set.insert $ D.Link b ("/etc/apache2/sites-available/" ++ D.domain site) ("/etc/apache2/sites-enabled/" ++ D.domain site))+          (D.atomSet . A.debInfo) %= (Set.insert $ D.File b ("/etc/apache2/sites-available" </> D.domain site) apacheConfig)+          (D.atomSet . A.debInfo) %= (Set.insert $ D.InstallDir b (apacheLogDirectory b))+          (D.logrotateStanza . A.debInfo) +++=+                              (b, singleton                                    (Text.unlines $ [ pack (apacheAccessLog b) <> " {"                                                    , "  copytruncate" -- hslogger doesn't notice when the log is rotated, maybe this will help                                                    , "  weekly"@@ -182,7 +184,8 @@                                                    , "  compress"                                                    , "  missingok"                                                    , "}"]))-          T.logrotateStanza +++= (b, singleton+          (D.logrotateStanza . A.debInfo) +++=+                              (b, singleton                                    (Text.unlines $ [ pack (apacheErrorLog b) <> " {"                                                    , "  copytruncate"                                                    , "  weekly"@@ -190,16 +193,16 @@                                                    , "  compress"                                                    , "  missingok"                                                    , "}" ]))) .-      serverAtoms b (T.server site) True+      serverAtoms b (D.server site) True     where       -- An apache site configuration file.  This is installed via a line       -- in debianFiles.       apacheConfig =           Text.unlines $                    [  "<VirtualHost *:80>"-                   , "    ServerAdmin " <> pack (T.serverAdmin site)-                   , "    ServerName www." <> pack (T.domain site)-                   , "    ServerAlias " <> pack (T.domain site)+                   , "    ServerAdmin " <> pack (D.serverAdmin site)+                   , "    ServerName www." <> pack (D.domain site)+                   , "    ServerAlias " <> pack (D.domain site)                    , ""                    , "    ErrorLog " <> pack (apacheErrorLog b)                    , "    CustomLog " <> pack (apacheAccessLog b) <> " combined"@@ -228,34 +231,33 @@                    , "    ProxyPass / http://127.0.0.1:" <> port' <> "/ nocanon"                    , "    ProxyPassReverse / http://127.0.0.1:" <> port' <> "/"                    , "</VirtualHost>" ]-      port' = pack (show (T.port (T.server site)))+      port' = pack (show (D.port (D.server site))) --- FIXME - use Atoms-serverAtoms :: BinPkgName -> T.Server -> Bool -> Atoms -> Atoms+serverAtoms :: BinPkgName -> D.Server -> Bool -> CabalInfo -> CabalInfo serverAtoms b server' isSite =-    modL T.postInst (insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianPostinst) .-    modL T.installInit (Map.insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianInit) .+    modL (D.postInst . A.debInfo) (insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianPostinst) .+    modL (D.installInit . A.debInfo) (Map.insertWith (\ old new -> if old /= new then error ("serverAtoms: " ++ show old ++ " -> " ++ show new) else old) b debianInit) .     serverLogrotate' b .     execAtoms b exec     where-      exec = T.installFile server'+      exec = D.installFile server'       debianInit =           Text.unlines $                    [ "#! /bin/sh -e"                    , ""                    , ". /lib/lsb/init-functions"-                   , "test -f /etc/default/" <> pack (T.destName exec) <> " && . /etc/default/" <> pack (T.destName exec)+                   , "test -f /etc/default/" <> pack (D.destName exec) <> " && . /etc/default/" <> pack (D.destName exec)                    , ""                    , "case \"$1\" in"                    , "  start)"-                   , "    test -x /usr/bin/" <> pack (T.destName exec) <> " || exit 0"-                   , "    log_begin_msg \"Starting " <> pack (T.destName exec) <> "...\""+                   , "    test -x /usr/bin/" <> pack (D.destName exec) <> " || exit 0"+                   , "    log_begin_msg \"Starting " <> pack (D.destName exec) <> "...\""                    , "    mkdir -p " <> pack (databaseDirectory b)                    , "    " <> startCommand                    , "    log_end_msg $?"                    , "    ;;"                    , "  stop)"-                   , "    log_begin_msg \"Stopping " <> pack (T.destName exec) <> "...\""+                   , "    log_begin_msg \"Stopping " <> pack (D.destName exec) <> "...\""                    , "    " <> stopCommand                    , "    log_end_msg $?"                    , "    ;;"@@ -265,11 +267,11 @@                    , "esac"                    , ""                    , "exit 0" ]-      startCommand = pack $ showCommand "start-stop-daemon" (startOptions ++ commonOptions ++ ["--"] ++ T.serverFlags server')+      startCommand = pack $ showCommand "start-stop-daemon" (startOptions ++ commonOptions ++ ["--"] ++ D.serverFlags server')       stopCommand = pack $ showCommand "start-stop-daemon" (stopOptions ++ commonOptions)-      commonOptions = ["--pidfile", "/var/run/" ++ T.destName exec]-      startOptions = ["--start", "-b", "--make-pidfile", "-d", databaseDirectory b, "--exec", "/usr/bin" </> T.destName exec]-      stopOptions = ["--stop", "--oknodo"] ++ if T.retry server' /= "" then ["--retry=" ++ T.retry server' ] else []+      commonOptions = ["--pidfile", "/var/run/" ++ D.destName exec]+      startOptions = ["--start", "-b", "--make-pidfile", "-d", databaseDirectory b, "--exec", "/usr/bin" </> D.destName exec]+      stopOptions = ["--stop", "--oknodo"] ++ if D.retry server' /= "" then ["--retry=" ++ D.retry server' ] else []        debianPostinst =           Text.unlines $@@ -296,26 +298,24 @@  -- | A configuration file for the logrotate facility, installed via a line -- in debianFiles.--- FIXME - use Atoms-serverLogrotate' :: BinPkgName -> Atoms -> Atoms+serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo serverLogrotate' b =-    modL T.logrotateStanza (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAccessLog b) <> " {"+    modL (D.logrotateStanza . A.debInfo) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAccessLog b) <> " {"                                  , "  weekly"                                  , "  rotate 5"                                  , "  compress"                                  , "  missingok"                                  , "}" ]))) .-    modL T.logrotateStanza (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAppLog b) <> " {"+    modL (D.logrotateStanza . A.debInfo) (insertWith Set.union b (singleton (Text.unlines $ [ pack (serverAppLog b) <> " {"                                  , "  weekly"                                  , "  rotate 5"                                  , "  compress"                                  , "  missingok"                                  , "}" ]))) --- FIXME - use Atoms-backupAtoms :: BinPkgName -> String -> Atoms -> Atoms+backupAtoms :: BinPkgName -> String -> CabalInfo -> CabalInfo backupAtoms b name =-    modL T.postInst (insertWith (\ old new -> if old /= new then error $ "backupAtoms: " ++ show old ++ " -> " ++ show new else old) b+    modL (D.postInst . A.debInfo) (insertWith (\ old new -> if old /= new then error $ "backupAtoms: " ++ show old ++ " -> " ++ show new else old) b                  (Text.unlines $                   [ "#!/bin/sh"                   , ""@@ -324,30 +324,27 @@                   , "    " <> pack ("/etc/cron.hourly" </> name) <> " --initialize"                   , "    ;;"                   , "esac" ])) .-    execAtoms b (T.InstallFile { T.execName = name-                               , T.destName = name-                               , T.sourceDir = Nothing-                               , T.destDir = Just "/etc/cron.hourly" })+    execAtoms b (D.InstallFile { D.execName = name+                               , D.destName = name+                               , D.sourceDir = Nothing+                               , D.destDir = Just "/etc/cron.hourly" }) --- FIXME - use Atoms-execAtoms :: BinPkgName -> T.InstallFile -> Atoms -> Atoms+execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo execAtoms b ifile r =-    modL T.rulesFragments (Set.insert (pack ("build" </> ppDisplay b ++ ":: build-ghc-stamp\n"))) .+    modL (D.rulesFragments . A.debInfo) (Set.insert (pack ("build" </> ppDisplay b ++ ":: build-ghc-stamp\n"))) .     fileAtoms b ifile $     r --- FIXME - use Atoms-fileAtoms :: BinPkgName -> T.InstallFile -> Atoms -> Atoms+fileAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo fileAtoms b installFile' r =-    fileAtoms' b (T.sourceDir installFile') (T.execName installFile') (T.destDir installFile') (T.destName installFile') r+    fileAtoms' b (D.sourceDir installFile') (D.execName installFile') (D.destDir installFile') (D.destName installFile') r --- FIXME - use Atoms-fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> Atoms -> Atoms+fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> CabalInfo -> CabalInfo fileAtoms' b sourceDir' execName' destDir' destName' r =     case (sourceDir', execName' == destName') of-      (Nothing, True) -> execDebM (T.installCabalExec b execName' d) r-      (Just s, True) -> execDebM (T.install b (s </> execName') d) r-      (Nothing, False) -> execDebM (T.installCabalExecTo b execName' (d </> destName')) r-      (Just s, False) -> execDebM (T.installTo b (s </> execName') (d </> destName')) r+      (Nothing, True) -> execCabalM ((D.atomSet . A.debInfo) %= (Set.insert $ D.InstallCabalExec b execName' d)) r+      (Just s, True) -> execCabalM ((D.atomSet . A.debInfo) %= (Set.insert $ D.Install b (s </> execName') d)) r+      (Nothing, False) -> execCabalM ((D.atomSet . A.debInfo) %= (Set.insert $ D.InstallCabalExecTo b execName' (d </> destName'))) r+      (Just s, False) -> execCabalM ((D.atomSet . A.debInfo) %= (Set.insert $ D.InstallTo b (s </> execName') (d </> destName'))) r     where       d = fromMaybe "usr/bin" destDir'

@@ -1,363 +0,0 @@--- | Read an existing Debianization from a directory file.-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}-module Debian.Debianize.Input-    ( inputDebianization-    , inputDebianizationFile-    , inputChangeLog-    , inputCabalization-    , inputCabalization'-    , dataDir-    ) where--import Debug.Trace (trace)--import Control.Applicative ((<$>))-import Control.Category ((.))---import Control.DeepSeq (NFData, force)-import Control.Exception (bracket)-import Control.Monad (when, filterM)-import Control.Monad.State (put)-import Control.Monad.Trans (MonadIO, liftIO)-import Data.Char (isSpace, toLower)-import Data.Lens.Lazy (setL, modL, access)-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Monoid ((<>))-import Data.Set as Set (Set, toList, fromList, insert, singleton)-import Data.Text (Text, unpack, pack, lines, words, break, strip, null)-import Data.Text.IO (readFile)---import Data.Version (showVersion, Version(Version))-import Debian.Changes (parseChangeLog)-import Debian.Control (Control'(unControl), Paragraph'(..), stripWS, parseControlFromFile, Field, Field'(..), ControlFunctions)-import qualified Debian.Debianize.Types.Atoms as T (makeAtoms, compilerFlavors)-import Debian.Debianize.Types.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription)-import qualified Debian.Debianize.Types.BinaryDebDescription as B-import Debian.Debianize.Types.CopyrightDescription (readCopyrightDescription, CopyrightDescription(..), FilesOrLicenseDescription(..))-import qualified Debian.Debianize.Types.SourceDebDescription as S-import Debian.Debianize.Types.Atoms-    (control, warning, sourceFormat, watch, rulesHead, compat, packageDescription,-     copyright, changelog, installInit, postInst, postRm, preInst, preRm,-     logrotateStanza, link, install, installDir, intermediateFiles, cabalFlagAssignments, verbosity, buildEnv)-import Debian.Debianize.Monad (DebT)-import Debian.Debianize.Prelude (getDirectoryContents', readFileMaybe, read', intToVerbosity', (~=), (~?=), (+=), (++=), (+++=), (%=))-import Debian.Debianize.Types.Atoms (EnvSet(dependOS))-import Debian.GHC (newestAvailableCompilerId)-import Debian.Orphans ()-import Debian.Policy (Section(..), parseStandardsVersion, readPriority, readSection, parsePackageArchitectures, parseMaintainer,-                      parseUploaders, readSourceFormat, fromCabalLicense)-import Debian.Relation (Relations, BinPkgName(..), SrcPkgName(..), parseRelations)---import Debian.Version (DebianVersion, parseDebianVersion)-import Distribution.Compiler (CompilerId)-#if MIN_VERSION_Cabal(1,22,0)-import Distribution.Compiler (unknownCompilerInfo, AbiTag(NoAbiTag))-#endif-import Distribution.Package (Package(packageId), PackageIdentifier(..), PackageName(PackageName), Dependency)-import qualified Distribution.PackageDescription as Cabal (PackageDescription(package, license, copyright {-, synopsis, description-}))-#if MIN_VERSION_Cabal(1,19,0)-import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFiles))-#else-import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFile))-#endif-import Distribution.PackageDescription as Cabal (PackageDescription, FlagName)-import Distribution.PackageDescription.Configuration (finalizePackageDescription)-import Distribution.PackageDescription.Parse (readPackageDescription)-import Distribution.Simple.Utils (defaultPackageDesc, die, setupMessage)-import Distribution.System (Platform(..), buildOS, buildArch)-import Distribution.Verbosity (Verbosity)-import Prelude hiding (readFile, lines, words, break, null, log, sum, (.))--- import qualified Prelude (lines)-import System.Directory (doesFileExist, getCurrentDirectory)-import System.Exit (ExitCode(..))-import System.FilePath ((</>), takeExtension, dropExtension)-import System.Posix.Files (setFileCreationMask)-import System.Process (system)-import System.IO.Error (catchIOError, tryIOError)--- import System.Unix.Chroot (useEnv)--- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)--inputDebianization :: MonadIO m => EnvSet -> DebT m ()-inputDebianization envset =-    do -- Erase any the existing information-       let atoms = T.makeAtoms envset-       put atoms-       (ctl, _) <- inputSourceDebDescription-       inputAtomsFromDirectory-       control ~= ctl---- | Try to input a file and if successful add it to the debianization.-inputDebianizationFile :: MonadIO m => FilePath -> DebT m ()-inputDebianizationFile path =-    do inputAtomsFromDirectory-       liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text))--inputSourceDebDescription :: MonadIO m => DebT m (S.SourceDebDescription, [Field])-inputSourceDebDescription =-    do paras <- liftIO $ parseControlFromFile "debian/control" >>= either (error . show) (return . unControl)-       case paras of-         [] -> error "Missing source paragraph"-         [_] -> error "Missing binary paragraph"-         (hd : tl) -> return $ parseSourceDebDescription hd tl--parseSourceDebDescription :: Paragraph' String -> [Paragraph' String] -> (S.SourceDebDescription, [Field])-parseSourceDebDescription (Paragraph fields) binaryParagraphs =-    foldr readField (src, []) fields'-    where-      fields' = map stripField fields-      src = setL S.binaryPackages bins (S.newSourceDebDescription' findSource findMaint)-      findSource = findMap "Source" SrcPkgName fields'-      findMaint = findMap "Maintainer" (\ m -> either (\ e -> error $ "Failed to parse maintainer field " ++ show m ++ ": " ++ show e) id . parseMaintainer $ m) fields'-      -- findStandards = findMap "Standards-Version" parseStandardsVersion fields'--      (bins, _extra) = unzip $ map parseBinaryDebDescription binaryParagraphs-      readField :: Field -> (S.SourceDebDescription, [Field]) -> (S.SourceDebDescription, [Field])-      -- Mandatory-      readField (Field ("Source", _)) x = x-      readField (Field ("Maintainer", _)) x = x-      -- readField (Field ("Standards-Version", _)) x = x-      -- Recommended-      readField (Field ("Standards-Version", value)) (desc, unrecognized) = (setL S.standardsVersion (Just (parseStandardsVersion value)) desc, unrecognized)-      readField (Field ("Priority", value)) (desc, unrecognized) = (setL S.priority (Just (readPriority value)) desc, unrecognized)-      readField (Field ("Section", value)) (desc, unrecognized) = (setL S.section (Just (MainSection value)) desc, unrecognized)-      -- Optional-      readField (Field ("Homepage", value)) (desc, unrecognized) = (setL S.homepage (Just (strip (pack value))) desc, unrecognized)-      readField (Field ("Uploaders", value)) (desc, unrecognized) = (setL S.uploaders (either (const []) id (parseUploaders value)) desc, unrecognized)-      readField (Field ("DM-Upload-Allowed", value)) (desc, unrecognized) = (setL S.dmUploadAllowed (yes value) desc, unrecognized)-      readField (Field ("Build-Depends", value)) (desc, unrecognized) = (setL S.buildDepends (rels value) desc, unrecognized)-      readField (Field ("Build-Conflicts", value)) (desc, unrecognized) = (setL S.buildConflicts (rels value) desc, unrecognized)-      readField (Field ("Build-Depends-Indep", value)) (desc, unrecognized) = (setL S.buildDependsIndep (rels value) desc, unrecognized)-      readField (Field ("Build-Conflicts-Indep", value)) (desc, unrecognized) = (setL S.buildConflictsIndep (rels value) desc, unrecognized)-      readField (Field ("Vcs-Browser", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSBrowser (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Arch", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSArch (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Bzr", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSBzr (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Cvs", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSCvs (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Darcs", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSDarcs (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Git", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSGit (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Hg", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSHg (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Mtn", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSMtn (pack s)) vcsFields) desc, unrecognized)-      readField (Field ("Vcs-Svn", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSSvn (pack s)) vcsFields) desc, unrecognized)-      readField field@(Field ('X' : fld, value)) (desc, unrecognized) =-          case span (`elem` "BCS") fld of-            (xs, '-' : more) -> (modL S.xFields (\ xFields -> insert (S.XField (fromList (map (read' (\ s -> error $ "parseSourceDebDescription: " ++ show s) . (: [])) xs)) (pack more) (pack value)) xFields) desc, unrecognized)-            _ -> (desc, field : unrecognized)-      readField field (desc, unrecognized) = (desc, field : unrecognized)--parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])-parseBinaryDebDescription (Paragraph fields) =-    foldr readField (bin, []) fields'-    where-      fields' = map stripField fields-      bin = setL B.architecture (Just arch) (newBinaryDebDescription b)-      b :: BinPkgName-      b = findMap "Package" BinPkgName fields'-      arch = findMap "Architecture" parsePackageArchitectures fields'-{--(BinPkgName (fromJust (fieldValue "Package" bin)))-(read' (fromJust (fieldValue "Architecture" bin)))-, []-    foldr readField (newBinaryDebDescription (BinPkgName (fromJust (fieldValue "Package" bin))) (read' (fromJust (fieldValue "Architecture" bin))), []) (map stripField fields)--}--      readField :: Field -> (BinaryDebDescription, [Field]) -> (BinaryDebDescription, [Field])-      readField (Field ("Package", x)) (desc, unrecognized) = (setL B.package (BinPkgName x) desc, unrecognized)-      readField (Field ("Architecture", x)) (desc, unrecognized) = (setL B.architecture (Just (parsePackageArchitectures x)) desc, unrecognized)-      readField (Field ("Section", x)) (desc, unrecognized) = (setL B.binarySection (Just (readSection x)) desc, unrecognized)-      readField (Field ("Priority", x)) (desc, unrecognized) = (setL B.binaryPriority (Just (readPriority x)) desc, unrecognized)-      readField (Field ("Essential", x)) (desc, unrecognized) = (setL B.essential (Just (yes x)) desc, unrecognized)-      readField (Field ("Depends", x)) (desc, unrecognized) = (setL (B.depends . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Recommends", x)) (desc, unrecognized) = (setL (B.recommends . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Suggests", x)) (desc, unrecognized) = (setL (B.suggests . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Pre-Depends", x)) (desc, unrecognized) = (setL (B.preDepends . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Breaks", x)) (desc, unrecognized) = (setL (B.breaks . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Conflicts", x)) (desc, unrecognized) = (setL (B.conflicts . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Provides", x)) (desc, unrecognized) = (setL (B.provides . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Replaces", x)) (desc, unrecognized) = (setL (B.replaces . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Built-Using", x)) (desc, unrecognized) = (setL (B.builtUsing . B.relations) (rels x) desc, unrecognized)-      readField (Field ("Description", x)) (desc, unrecognized) = (setL B.description (Just (pack x)) desc, unrecognized)-      readField field (desc, unrecognized) = (desc, field : unrecognized)---- | Look for a field and apply a function to its value-findMap :: String -> (String -> a) -> [Field] -> a-findMap field f fields =-    fromMaybe (error $ "Missing " ++ show field ++ " field in " ++ show fields) (foldr findMap' Nothing fields)-    where-      findMap' (Field (fld, val)) x = if fld == field then Just (f val) else x-      findMap' _ x = x--stripField :: ControlFunctions a => Field' a -> Field' a-stripField (Field (a, b)) = Field (a, stripWS b)-stripField x = x--rels :: String -> Relations-rels s =-    either (\ e -> error ("Relations field error: " ++ show e ++ "\n  " ++ s)) id (parseRelations s)--yes :: String -> Bool-yes "yes" = True-yes "no" = False-yes x = error $ "Expecting yes or no: " ++ x--inputChangeLog :: MonadIO m => DebT m ()-inputChangeLog =-    do log <- liftIO $ tryIOError (readFile "debian/changelog" >>= return . parseChangeLog . unpack)-       changelog ~?= either (\ _ -> Nothing) Just log--inputAtomsFromDirectory :: MonadIO m => DebT m () -- .install files, .init files, etc.-inputAtomsFromDirectory =-    do findFiles-       doFiles ("./debian/cabalInstall")-    where-      -- Find regular files in the debian/ or in debian/source/format/ and-      -- add them to the debianization.-      findFiles :: MonadIO m => DebT m ()-      findFiles =-          liftIO (getDirectoryContents' ("debian")) >>=-          return . (++ ["source/format"]) >>=-          liftIO . filterM (doesFileExist . (("debian") </>)) >>= \ names ->-          mapM_ (inputAtoms ("debian")) names-      doFiles :: MonadIO m => FilePath -> DebT m ()-      doFiles tmp =-          do sums <- liftIO $ getDirectoryContents' tmp `catchIOError` (\ _ -> return [])-             paths <- liftIO $ mapM (\ sum -> getDirectoryContents' (tmp </> sum) >>= return . map (sum </>)) sums >>= return . filter ((/= '~') . last) . concat-             files <- liftIO $ mapM (readFile . (tmp </>)) paths-             mapM_ (intermediateFiles +=) (zip (map ("debian/cabalInstall" </>) paths) files)---- | Construct a file path from the debian directory and a relative--- path, read its contents and add the result to the debianization.--- This may mean using a specialized parser from the debian package--- (e.g. parseChangeLog), and some files (like control) are ignored--- here, though I don't recall why at the moment.-inputAtoms :: MonadIO m => FilePath -> FilePath -> DebT m ()-inputAtoms _ path | elem path ["control"] = return ()-inputAtoms debian name@"source/format" = liftIO (readFile (debian </> name)) >>= \ text -> either (warning +=) ((sourceFormat ~=) . Just) (readSourceFormat text)-inputAtoms debian name@"watch" = liftIO (readFile (debian </> name)) >>= \ text -> watch ~= Just text-inputAtoms debian name@"rules" = liftIO (readFile (debian </> name)) >>= \ text -> rulesHead ~= (Just $ strip text <> "\n")-inputAtoms debian name@"compat" = liftIO (readFile (debian </> name)) >>= \ text -> compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text))-inputAtoms debian name@"copyright" = liftIO (readFile (debian </> name)) >>= \ text -> copyright ~= readCopyrightDescription text-inputAtoms debian name@"changelog" =-    liftIO (readFile (debian </> name)) >>= return . parseChangeLog . unpack >>= \ log -> changelog ~= Just log-inputAtoms debian name =-    case (BinPkgName (dropExtension name), takeExtension name) of-      (p, ".install") ->   liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readInstall p) (lines text)-      (p, ".dirs") ->      liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readDir p) (lines text)-      (p, ".init") ->      liftIO (readFile (debian </> name)) >>= \ text -> installInit ++= (p, text)-      (p, ".logrotate") -> liftIO (readFile (debian </> name)) >>= \ text -> logrotateStanza +++= (p, singleton text)-      (p, ".links") ->     liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readLink p) (lines text)-      (p, ".postinst") ->  liftIO (readFile (debian </> name)) >>= \ text -> postInst ++= (p, text)-      (p, ".postrm") ->    liftIO (readFile (debian </> name)) >>= \ text -> postRm ++= (p, text)-      (p, ".preinst") ->   liftIO (readFile (debian </> name)) >>= \ text -> preInst ++= (p, text)-      (p, ".prerm") ->     liftIO (readFile (debian </> name)) >>= \ text -> preRm ++= (p, text)-      (_, ".log") ->       return () -- Generated by debhelper-      (_, ".debhelper") -> return () -- Generated by debhelper-      (_, ".hs") ->        return () -- Code that uses this library-      (_, ".setup") ->     return () -- Compiled Setup.hs file-      (_, ".substvars") -> return () -- Unsupported-      (_, "") ->           return () -- File with no extension-      (_, x) | last x == '~' -> return () -- backup file-      _ -> trace ("Ignored: " ++ debian </> name) (return ())---- | Read a line from a debian .links file-readLink :: Monad m => BinPkgName -> Text -> DebT m ()-readLink p line =-    case words line of-      [a, b] -> link p (unpack a) (unpack b)-      [] -> return ()-      _ -> trace ("Unexpected value passed to readLink: " ++ show line) (return ())---- | Read a line from a debian .install file-readInstall :: Monad m => BinPkgName -> Text -> DebT m ()-readInstall p line =-    case break isSpace line of-      (_, b) | null b -> error $ "readInstall: syntax error in .install file for " ++ show p ++ ": " ++ show line-      (a, b) -> install p (unpack (strip a)) (unpack (strip b))---- | Read a line from a debian .dirs file-readDir :: Monad m => BinPkgName -> Text -> DebT m ()-readDir p line = installDir p (unpack line)--nothingIf :: (a -> Bool) -> a -> Maybe a-nothingIf p x = if p x then Nothing else Just x--inputCabalization :: (MonadIO m, Functor m) => DebT m ()-inputCabalization =-    do vb <- access verbosity >>= return . intToVerbosity'-       flags <- access cabalFlagAssignments-       root <- dependOS <$> access buildEnv-       hcs <- access T.compilerFlavors-       let cids = map (newestAvailableCompilerId root) (toList hcs)-       ePkgDescs <- liftIO $ inputCabalization' vb flags cids-       mapM_ (either (\ deps -> liftIO getCurrentDirectory >>= \ here ->-                                error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps)-                     (\ pkgDesc -> do-                        packageDescription ~= Just pkgDesc-                        -- This will contain either the contents of the file given in-                        -- the license-file: field or the contents of the license:-                        -- field.-                        licenseFiles <- mapM (\ path -> liftIO (readFileMaybe path) >>= \ text -> return (path, text))-#if MIN_VERSION_Cabal(1,19,0)-                                             (Cabal.licenseFiles pkgDesc)-#else-                                             (case Cabal.licenseFile pkgDesc of-                                                "" -> []-                                                path -> [path])-#endif-                        -- It is possible we might interpret the license file path-                        -- as a license name, so I hang on to it here.-                        let licenseFiles' = mapMaybe (\ (path, text) -> maybe Nothing (\ t -> Just (path, t)) text) licenseFiles-                        copyright %= cabalToCopyrightDescription pkgDesc licenseFiles'-                      ))-             ePkgDescs--cabalToCopyrightDescription :: PackageDescription -> [(FilePath, Text)] -> CopyrightDescription -> CopyrightDescription-cabalToCopyrightDescription pkgDesc licenseFiles cdesc =-    let triples = zip3 (repeat (nothingIf (null . strip) (pack (Cabal.copyright pkgDesc))))-                       (repeat (Cabal.license pkgDesc))-                       (case licenseFiles of-                          [] -> [Nothing]-                          xs -> map (Just. snd) xs)-        fnls = map (\ (copyrt, license, comment) ->-                         FilesDescription-                                {_filesPattern = "*"-                                , _filesCopyright = fromMaybe (pack "(No copyright field in cabal file)") copyrt-                                , _filesLicense = fromCabalLicense license-                                , _filesComment = comment }) triples in-     cdesc { _filesAndLicenses = fnls }--inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> [CompilerId] -> IO [Either [Dependency] PackageDescription]-inputCabalization' vb flags cids = do-         descPath <- defaultPackageDesc vb-         genPkgDesc <- readPackageDescription vb descPath-         let finalized = map (\ cid -> finalizePackageDescription (toList flags) (const True) (Platform buildArch buildOS) cid [] genPkgDesc) $-#if MIN_VERSION_Cabal(1,22,0)-                             map (\ i -> unknownCompilerInfo i NoAbiTag)-#endif-                                                     cids-         mapM (either (return . Left)-                      (\ (pkgDesc, _) -> do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc-                                            return (Right pkgDesc)))-              finalized---- | Run the package's configuration script.-autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()-autoreconf verbose pkgDesc = do-    ac <- doesFileExist "configure.ac"-    when ac $ do-        c <- doesFileExist "configure"-        when (not c) $ do-            setupMessage verbose "Running autoreconf" (packageId pkgDesc)-            ret <- system "autoreconf"-            case ret of-              ExitSuccess -> return ()-              ExitFailure n -> die ("autoreconf failed with status " ++ show n)---- chroot :: NFData a => FilePath -> IO a -> IO a--- chroot "/" task = task--- chroot root task = useEnv root (return . force) task---- | Compute the Cabal data directory for a Linux install from a Cabal--- package description.  This needs to match the path cabal assigns to--- datadir in the dist/build/autogen/Paths_packagename.hs module, or--- perhaps the path in the cabal_debian_datadir environment variable.-dataDir :: Cabal.PackageDescription -> FilePath-dataDir p =-    let PackageName pkgname = pkgName . Cabal.package $ p in-    "usr/share" </> map toLower pkgname

@@ -0,0 +1,77 @@+-- | Input the Cabal package description.+{-# LANGUAGE CPP, DeriveDataTypeable, TemplateHaskell #-}+module Debian.Debianize.InputCabal+    ( inputCabalization+    ) where++import Control.Category ((.))+import Control.Exception (bracket)+import Control.Monad (when)+import Data.Lens.Common (getL)+import Data.Set as Set (Set, toList)+import Debian.Debianize.BasicInfo (Flags, buildEnv, dependOS, verbosity, compilerFlavor, cabalFlagAssignments)+import Debian.Debianize.Prelude (intToVerbosity')+import Debian.GHC (newestAvailableCompilerId)+import Debian.Orphans ()+#if MIN_VERSION_Cabal(1,22,0)+import Distribution.Compiler (AbiTag(NoAbiTag), unknownCompilerInfo)+#endif+import Distribution.Compiler (CompilerId)+import Distribution.Package (Dependency, Package(packageId))+import Distribution.PackageDescription as Cabal (FlagName, PackageDescription)+import Distribution.PackageDescription.Configuration (finalizePackageDescription)+import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Simple.Utils (defaultPackageDesc, die, setupMessage)+import Distribution.System as Cabal (buildArch, Platform(..))+import qualified Distribution.System as Cabal (buildOS)+import Distribution.Verbosity (Verbosity)+import Prelude hiding ((.), break, lines, log, null, readFile, sum)+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode(..))+import System.Posix.Files (setFileCreationMask)+import System.Process (system)++-- | Load a PackageDescription using the information in the Flags record -+-- in particular, using the dependency environment in the EnvSet, find+-- the newest available compiler of the requested compiler flavor and+-- use that information load the configured PackageDescription.+inputCabalization :: Flags -> IO PackageDescription+inputCabalization flags =+    do let root = dependOS $ getL buildEnv flags+       let cid = newestAvailableCompilerId root (getL compilerFlavor flags)+       ePkgDesc <- inputCabalization' (intToVerbosity' $ getL verbosity flags) (getL cabalFlagAssignments flags) cid+       either (\ deps -> getCurrentDirectory >>= \ here ->+                         error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps)+              return+              ePkgDesc++-- | Load a GenericPackageDescription from the current directory and+-- from that create a finalized PackageDescription for the given+-- CompilerId.+inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> CompilerId -> IO (Either [Dependency] PackageDescription)+inputCabalization' vb flags cid = do+  genPkgDesc <- defaultPackageDesc vb >>= readPackageDescription vb+  let cid' =+#if MIN_VERSION_Cabal(1,22,0)+             unknownCompilerInfo cid NoAbiTag+#else+             cid+#endif+  let finalized = finalizePackageDescription (toList flags) (const True) (Platform buildArch Cabal.buildOS) cid' [] genPkgDesc+  either (return . Left)+         (\ (pkgDesc, _) -> do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc+                               return (Right pkgDesc))+         finalized++-- | Run the package's configuration script.+autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()+autoreconf verbose pkgDesc = do+    ac <- doesFileExist "configure.ac"+    when ac $ do+        c <- doesFileExist "configure"+        when (not c) $ do+            setupMessage verbose "Running autoreconf" (packageId pkgDesc)+            ret <- system "autoreconf"+            case ret of+              ExitSuccess -> return ()+              ExitFailure n -> die ("autoreconf failed with status " ++ show n)

@@ -0,0 +1,261 @@+-- | Read an existing Debianization from a directory file.+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+module Debian.Debianize.InputDebian+    ( inputDebianization+    , inputDebianizationFile+    , inputChangeLog+    , dataDir+    ) where++import Control.Category ((.))+import Control.Monad (filterM)+import Control.Monad.State (put)+import Control.Monad.Trans (liftIO, MonadIO)+import Data.Char (isSpace)+import Data.Lens.Lazy (access, modL, setL)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Set as Set (fromList, insert, singleton)+import Data.Text (break, lines, null, pack, strip, Text, unpack, words)+import Data.Text.IO (readFile)+import Debian.Changes (parseChangeLog)+import Debian.Control (Control'(unControl), ControlFunctions, Field, Field'(..), Paragraph'(..), parseControlFromFile, stripWS)+import Debian.Debianize.DebInfo (changelog, compat, control, copyright, install, installDir, installInit, intermediateFiles, link, logrotateStanza, postInst, postRm, preInst, preRm, rulesHead, sourceFormat, warning, watch)+import qualified Debian.Debianize.DebInfo as T (flags, makeDebInfo)+import Debian.Debianize.Monad (CabalT, DebianT)+import Debian.Debianize.Prelude ((+++=), (++=), (+=), getDirectoryContents', read', readFileMaybe, (~=), (~?=))+import Debian.Debianize.CabalInfo (packageDescription)+import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription)+import qualified Debian.Debianize.BinaryDebDescription as B (architecture, binaryPriority, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, preDepends, provides, recommends, relations, replaces, suggests)+import Debian.Debianize.CopyrightDescription (readCopyrightDescription)+import qualified Debian.Debianize.SourceDebDescription as S (binaryPackages, buildConflicts, buildConflictsIndep, buildDepends, buildDependsIndep, dmUploadAllowed, homepage, newSourceDebDescription', priority, section, SourceDebDescription, standardsVersion, uploaders, vcsFields, VersionControlSpec(VCSArch, VCSBrowser, VCSBzr, VCSCvs, VCSDarcs, VCSGit, VCSHg, VCSMtn, VCSSvn), XField(XField), xFields)+import Debian.Orphans ()+import Debian.Policy (parseMaintainer, parsePackageArchitectures, parseStandardsVersion, parseUploaders, readPriority, readSection, readSourceFormat, Section(..))+import Debian.Relation (BinPkgName(..), parseRelations, Relations, SrcPkgName(..))+import Debug.Trace (trace)+import Distribution.Package (PackageIdentifier(..), PackageName(..))+import qualified Distribution.PackageDescription as Cabal (dataDir, PackageDescription(package))+import Prelude hiding ((.), break, lines, log, null, readFile, sum, words)+import System.Directory (doesFileExist)+import System.FilePath ((</>), dropExtension, takeExtension)+import System.IO.Error (catchIOError, tryIOError)+-- import System.Unix.Chroot (useEnv)+-- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)++inputDebianization :: MonadIO m => DebianT m ()+inputDebianization =+    do -- Erase any the existing information+       fs <- access T.flags+       put $ T.makeDebInfo fs+       (ctl, _) <- inputSourceDebDescription+       inputCabalInfoFromDirectory+       control ~= ctl++-- | Try to input a file and if successful add it to the+-- debianization's list of "intermediate" files, files which will+-- simply be added to the final debianization without any+-- understanding of their contents or purpose.+inputDebianizationFile :: MonadIO m => FilePath -> DebianT m ()+inputDebianizationFile path =+    do inputCabalInfoFromDirectory+       liftIO (readFileMaybe path) >>= maybe (return ()) (\ text -> intermediateFiles += (path, text))++inputSourceDebDescription :: MonadIO m => DebianT m (S.SourceDebDescription, [Field])+inputSourceDebDescription =+    do paras <- liftIO $ parseControlFromFile "debian/control" >>= either (error . show) (return . unControl)+       case paras of+         [] -> error "Missing source paragraph"+         [_] -> error "Missing binary paragraph"+         (hd : tl) -> return $ parseSourceDebDescription hd tl++parseSourceDebDescription :: Paragraph' String -> [Paragraph' String] -> (S.SourceDebDescription, [Field])+parseSourceDebDescription (Paragraph fields) binaryParagraphs =+    foldr readField (src, []) fields'+    where+      fields' = map stripField fields+      src = setL S.binaryPackages bins (S.newSourceDebDescription' findSource findMaint)+      findSource = findMap "Source" SrcPkgName fields'+      findMaint = findMap "Maintainer" (\ m -> either (\ e -> error $ "Failed to parse maintainer field " ++ show m ++ ": " ++ show e) id . parseMaintainer $ m) fields'+      -- findStandards = findMap "Standards-Version" parseStandardsVersion fields'++      (bins, _extra) = unzip $ map parseBinaryDebDescription binaryParagraphs+      readField :: Field -> (S.SourceDebDescription, [Field]) -> (S.SourceDebDescription, [Field])+      -- Mandatory+      readField (Field ("Source", _)) x = x+      readField (Field ("Maintainer", _)) x = x+      -- readField (Field ("Standards-Version", _)) x = x+      -- Recommended+      readField (Field ("Standards-Version", value)) (desc, unrecognized) = (setL S.standardsVersion (Just (parseStandardsVersion value)) desc, unrecognized)+      readField (Field ("Priority", value)) (desc, unrecognized) = (setL S.priority (Just (readPriority value)) desc, unrecognized)+      readField (Field ("Section", value)) (desc, unrecognized) = (setL S.section (Just (MainSection value)) desc, unrecognized)+      -- Optional+      readField (Field ("Homepage", value)) (desc, unrecognized) = (setL S.homepage (Just (strip (pack value))) desc, unrecognized)+      readField (Field ("Uploaders", value)) (desc, unrecognized) = (setL S.uploaders (either (const []) id (parseUploaders value)) desc, unrecognized)+      readField (Field ("DM-Upload-Allowed", value)) (desc, unrecognized) = (setL S.dmUploadAllowed (yes value) desc, unrecognized)+      readField (Field ("Build-Depends", value)) (desc, unrecognized) = (setL S.buildDepends (rels value) desc, unrecognized)+      readField (Field ("Build-Conflicts", value)) (desc, unrecognized) = (setL S.buildConflicts (rels value) desc, unrecognized)+      readField (Field ("Build-Depends-Indep", value)) (desc, unrecognized) = (setL S.buildDependsIndep (rels value) desc, unrecognized)+      readField (Field ("Build-Conflicts-Indep", value)) (desc, unrecognized) = (setL S.buildConflictsIndep (rels value) desc, unrecognized)+      readField (Field ("Vcs-Browser", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSBrowser (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Arch", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSArch (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Bzr", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSBzr (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Cvs", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSCvs (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Darcs", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSDarcs (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Git", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSGit (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Hg", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSHg (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Mtn", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSMtn (pack s)) vcsFields) desc, unrecognized)+      readField (Field ("Vcs-Svn", s)) (desc, unrecognized) = (modL S.vcsFields (\ vcsFields -> insert (S.VCSSvn (pack s)) vcsFields) desc, unrecognized)+      readField field@(Field ('X' : fld, value)) (desc, unrecognized) =+          case span (`elem` "BCS") fld of+            (xs, '-' : more) -> (modL S.xFields (\ xFields -> insert (S.XField (fromList (map (read' (\ s -> error $ "parseSourceDebDescription: " ++ show s) . (: [])) xs)) (pack more) (pack value)) xFields) desc, unrecognized)+            _ -> (desc, field : unrecognized)+      readField field (desc, unrecognized) = (desc, field : unrecognized)++parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])+parseBinaryDebDescription (Paragraph fields) =+    foldr readField (bin, []) fields'+    where+      fields' = map stripField fields+      bin = setL B.architecture (Just arch) (newBinaryDebDescription b)+      b :: BinPkgName+      b = findMap "Package" BinPkgName fields'+      arch = findMap "Architecture" parsePackageArchitectures fields'+{-+(BinPkgName (fromJust (fieldValue "Package" bin)))+(read' (fromJust (fieldValue "Architecture" bin)))+, []+    foldr readField (newBinaryDebDescription (BinPkgName (fromJust (fieldValue "Package" bin))) (read' (fromJust (fieldValue "Architecture" bin))), []) (map stripField fields)+-}++      readField :: Field -> (BinaryDebDescription, [Field]) -> (BinaryDebDescription, [Field])+      readField (Field ("Package", x)) (desc, unrecognized) = (setL B.package (BinPkgName x) desc, unrecognized)+      readField (Field ("Architecture", x)) (desc, unrecognized) = (setL B.architecture (Just (parsePackageArchitectures x)) desc, unrecognized)+      readField (Field ("Section", x)) (desc, unrecognized) = (setL B.binarySection (Just (readSection x)) desc, unrecognized)+      readField (Field ("Priority", x)) (desc, unrecognized) = (setL B.binaryPriority (Just (readPriority x)) desc, unrecognized)+      readField (Field ("Essential", x)) (desc, unrecognized) = (setL B.essential (Just (yes x)) desc, unrecognized)+      readField (Field ("Depends", x)) (desc, unrecognized) = (setL (B.depends . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Recommends", x)) (desc, unrecognized) = (setL (B.recommends . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Suggests", x)) (desc, unrecognized) = (setL (B.suggests . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Pre-Depends", x)) (desc, unrecognized) = (setL (B.preDepends . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Breaks", x)) (desc, unrecognized) = (setL (B.breaks . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Conflicts", x)) (desc, unrecognized) = (setL (B.conflicts . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Provides", x)) (desc, unrecognized) = (setL (B.provides . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Replaces", x)) (desc, unrecognized) = (setL (B.replaces . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Built-Using", x)) (desc, unrecognized) = (setL (B.builtUsing . B.relations) (rels x) desc, unrecognized)+      readField (Field ("Description", x)) (desc, unrecognized) = (setL B.description (Just (pack x)) desc, unrecognized)+      readField field (desc, unrecognized) = (desc, field : unrecognized)++-- | Look for a field and apply a function to its value+findMap :: String -> (String -> a) -> [Field] -> a+findMap field f fields =+    fromMaybe (error $ "Missing " ++ show field ++ " field in " ++ show fields) (foldr findMap' Nothing fields)+    where+      findMap' (Field (fld, val)) x = if fld == field then Just (f val) else x+      findMap' _ x = x++stripField :: ControlFunctions a => Field' a -> Field' a+stripField (Field (a, b)) = Field (a, stripWS b)+stripField x = x++rels :: String -> Relations+rels s =+    either (\ e -> error ("Relations field error: " ++ show e ++ "\n  " ++ s)) id (parseRelations s)++yes :: String -> Bool+yes "yes" = True+yes "no" = False+yes x = error $ "Expecting yes or no: " ++ x++inputChangeLog :: MonadIO m => DebianT m ()+inputChangeLog =+    do log <- liftIO $ tryIOError (readFile "debian/changelog" >>= return . parseChangeLog . unpack)+       changelog ~?= either (\ _ -> Nothing) Just log++inputCabalInfoFromDirectory :: MonadIO m => DebianT m () -- .install files, .init files, etc.+inputCabalInfoFromDirectory =+    do findFiles+       doFiles ("./debian/cabalInstall")+    where+      -- Find regular files in the debian/ or in debian/source/format/ and+      -- add them to the debianization.+      findFiles :: MonadIO m => DebianT m ()+      findFiles =+          liftIO (getDirectoryContents' ("debian")) >>=+          return . (++ ["source/format"]) >>=+          liftIO . filterM (doesFileExist . (("debian") </>)) >>= \ names ->+          mapM_ (inputCabalInfo ("debian")) names+      doFiles :: MonadIO m => FilePath -> DebianT m ()+      doFiles tmp =+          do sums <- liftIO $ getDirectoryContents' tmp `catchIOError` (\ _ -> return [])+             paths <- liftIO $ mapM (\ sum -> getDirectoryContents' (tmp </> sum) >>= return . map (sum </>)) sums >>= return . filter ((/= '~') . last) . concat+             files <- liftIO $ mapM (readFile . (tmp </>)) paths+             mapM_ (intermediateFiles +=) (zip (map ("debian/cabalInstall" </>) paths) files)++-- | Construct a file path from the debian directory and a relative+-- path, read its contents and add the result to the debianization.+-- This may mean using a specialized parser from the debian package+-- (e.g. parseChangeLog), and some files (like control) are ignored+-- here, though I don't recall why at the moment.+inputCabalInfo :: MonadIO m => FilePath -> FilePath -> DebianT m ()+inputCabalInfo _ path | elem path ["control"] = return ()+inputCabalInfo debian name@"source/format" = liftIO (readFile (debian </> name)) >>= \ text -> either (warning +=) ((sourceFormat ~=) . Just) (readSourceFormat text)+inputCabalInfo debian name@"watch" = liftIO (readFile (debian </> name)) >>= \ text -> watch ~= Just text+inputCabalInfo debian name@"rules" = liftIO (readFile (debian </> name)) >>= \ text -> rulesHead ~= (Just $ strip text <> "\n")+inputCabalInfo debian name@"compat" = liftIO (readFile (debian </> name)) >>= \ text -> compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text))+inputCabalInfo debian name@"copyright" = liftIO (readFile (debian </> name)) >>= \ text -> copyright ~= Just (readCopyrightDescription text)+inputCabalInfo debian name@"changelog" =+    liftIO (readFile (debian </> name)) >>= return . parseChangeLog . unpack >>= \ log -> changelog ~= Just log+inputCabalInfo debian name =+    case (BinPkgName (dropExtension name), takeExtension name) of+      (p, ".install") ->   liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readInstall p) (lines text)+      (p, ".dirs") ->      liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readDir p) (lines text)+      (p, ".init") ->      liftIO (readFile (debian </> name)) >>= \ text -> installInit ++= (p, text)+      (p, ".logrotate") -> liftIO (readFile (debian </> name)) >>= \ text -> logrotateStanza +++= (p, singleton text)+      (p, ".links") ->     liftIO (readFile (debian </> name)) >>= \ text -> mapM_ (readLink p) (lines text)+      (p, ".postinst") ->  liftIO (readFile (debian </> name)) >>= \ text -> postInst ++= (p, text)+      (p, ".postrm") ->    liftIO (readFile (debian </> name)) >>= \ text -> postRm ++= (p, text)+      (p, ".preinst") ->   liftIO (readFile (debian </> name)) >>= \ text -> preInst ++= (p, text)+      (p, ".prerm") ->     liftIO (readFile (debian </> name)) >>= \ text -> preRm ++= (p, text)+      (_, ".log") ->       return () -- Generated by debhelper+      (_, ".debhelper") -> return () -- Generated by debhelper+      (_, ".hs") ->        return () -- Code that uses this library+      (_, ".setup") ->     return () -- Compiled Setup.hs file+      (_, ".substvars") -> return () -- Unsupported+      (_, "") ->           return () -- File with no extension+      (_, x) | last x == '~' -> return () -- backup file+      _ -> trace ("Ignored: " ++ debian </> name) (return ())++-- | Read a line from a debian .links file+readLink :: Monad m => BinPkgName -> Text -> DebianT m ()+readLink p line =+    case words line of+      [a, b] -> link p (unpack a) (unpack b)+      [] -> return ()+      _ -> trace ("Unexpected value passed to readLink: " ++ show line) (return ())++-- | Read a line from a debian .install file+readInstall :: Monad m => BinPkgName -> Text -> DebianT m ()+readInstall p line =+    case break isSpace line of+      (_, b) | null b -> error $ "readInstall: syntax error in .install file for " ++ show p ++ ": " ++ show line+      (a, b) -> install p (unpack (strip a)) (unpack (strip b))++-- | Read a line from a debian .dirs file+readDir :: Monad m => BinPkgName -> Text -> DebianT m ()+readDir p line = installDir p (unpack line)++-- chroot :: NFData a => FilePath -> IO a -> IO a+-- chroot "/" task = task+-- chroot root task = useEnv root (return . force) task++-- | Compute the Cabal data directory for a Linux install from a Cabal+-- package description.  This needs to match the path cabal assigns to+-- datadir in the dist/build/autogen/Paths_packagename.hs module, or+-- perhaps the path in the CABAL_DEBIAN_DATADIR environment variable.+dataDir :: MonadIO m => CabalT m FilePath+dataDir = do+  d <- access packageDescription+  return $ case Cabal.dataDir d of+             [] -> "usr/share" </> ((\ (PackageName x) -> x) $ pkgName $ Cabal.package d)+             x -> x

@@ -7,7 +7,7 @@     ( Interspersed(..)     ) where -import Debug.Trace+import Debug.Trace (trace)  -- | A class of Bs insterspersed with Cs.  It is used when converting -- the cabal dependencies to debian, where the "around" type is the

@@ -1,44 +1,61 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Debian.Debianize.Monad-    ( Atoms--    , DebT-    , runDebT-    , evalDebT-    , execDebT-    , DebM-    , runDebM-    , evalDebM-    , execDebM+    ( CabalInfo+    , CabalT+    , runCabalT+    , evalCabalT+    , execCabalT+    , CabalM+    , runCabalM+    , evalCabalM+    , execCabalM      -- * modify cabal to debian package version map     -- , mapCabal     -- , splitCabal++    , DebianT+    , evalDebianT+    , execDebianT+    , liftCabal     ) where  import Control.Monad.State (evalState, evalStateT, execState, execStateT, runState, State, StateT(runStateT))-import Debian.Debianize.Types.Atoms (Atoms)+import Data.Lens.Lazy (focus)+import Debian.Debianize.DebInfo (DebInfo)+import Debian.Debianize.CabalInfo (CabalInfo, debInfo) import Debian.Orphans () import Prelude hiding (init, log, unlines) -type DebT m = StateT Atoms m-type DebM = State Atoms+type CabalT m = StateT CabalInfo m -- Better name - CabalT?+type CabalM = State CabalInfo -execDebT :: Monad m => DebT m a -> Atoms -> m Atoms-execDebT action atoms = execStateT action atoms+execCabalT :: Monad m => CabalT m a -> CabalInfo -> m CabalInfo+execCabalT action atoms = execStateT action atoms -evalDebT :: Monad m => DebT m a -> Atoms -> m a-evalDebT action atoms = evalStateT action atoms+evalCabalT :: Monad m => CabalT m a -> CabalInfo -> m a+evalCabalT action atoms = evalStateT action atoms -runDebT :: Monad m => DebT m a -> Atoms -> m (a, Atoms)-runDebT action atoms = runStateT action atoms+runCabalT :: Monad m => CabalT m a -> CabalInfo -> m (a, CabalInfo)+runCabalT action atoms = runStateT action atoms -execDebM :: DebM a -> Atoms -> Atoms-execDebM action atoms = execState action atoms+execCabalM :: CabalM a -> CabalInfo -> CabalInfo+execCabalM action atoms = execState action atoms -evalDebM :: DebM a -> Atoms -> a-evalDebM action atoms = evalState action atoms+evalCabalM :: CabalM a -> CabalInfo -> a+evalCabalM action atoms = evalState action atoms -runDebM :: DebM a -> Atoms -> (a, Atoms)-runDebM action atoms = runState action atoms+runCabalM :: CabalM a -> CabalInfo -> (a, CabalInfo)+runCabalM action atoms = runState action atoms++type DebianT m = StateT DebInfo m++evalDebianT :: Monad m => DebianT m a -> DebInfo -> m a+evalDebianT = evalStateT++execDebianT :: Monad m => DebianT m () -> DebInfo -> m DebInfo+execDebianT = execStateT++liftCabal :: Monad m => StateT DebInfo m a -> StateT CabalInfo m a+liftCabal = focus debInfo

@@ -8,61 +8,58 @@     , withEnvironmentArgs     ) where -import Control.Monad.State (get, put)-import Control.Monad.Trans (MonadIO, liftIO)-import Data.Char (toLower, toUpper, isDigit, ord)-import Data.Lens.Lazy (Lens)-import Data.Set (singleton, insert, delete)+import Control.Category ((.))+import Control.Monad.State (StateT)+import Control.Monad.Trans (liftIO, MonadIO)+import Data.Char (isDigit, ord)+import Data.Lens.Lazy (focus, Lens)+import Debian.Debianize.BasicInfo (flagOptions, Flags)+import Debian.Debianize.DebInfo (DebInfo, flags, binaryDebDescription)+import qualified  Debian.Debianize.DebInfo as D import Debian.Debianize.Goodies (doExecutable)-import Debian.Debianize.Monad (DebT)-import Debian.Debianize.Prelude (read', maybeRead, (+=), (~=), (%=), (++=), (+++=))-import Debian.Debianize.Types-    (verbosity, dryRun, debAction, noDocumentationLibrary, noProfilingLibrary,-     missingDependencies, sourcePackageName, overrideDebianNameBase, cabalFlagAssignments, maintainerOption, uploadersOption, buildDir, omitProfVersionDeps, omitLTDeps,-     sourceFormat, buildDepends, buildDependsIndep, extraDevDeps, depends, conflicts, replaces, provides,-     recommends, suggests, extraLibMap, debVersion, revision, epochMap, execMap, utilsPackageNameBase,-     standardsVersion, official, sourceSection)-import Debian.Debianize.Types.Atoms (Atoms, EnvSet(..), InstallFile(..), DebAction(..), setBuildEnv, compilerFlavors)+import Debian.Debianize.Monad (CabalT)+import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), maybeRead, (~=))+import qualified Debian.Debianize.CabalInfo as A+import qualified Debian.Debianize.BinaryDebDescription as B+import qualified Debian.Debianize.SourceDebDescription as S import Debian.Debianize.VersionSplits (DebBase(DebBase)) import Debian.Orphans ()-import Debian.Policy (SourceFormat(Quilt3, Native3), parseMaintainer, parseStandardsVersion)-import Debian.Relation (BinPkgName(..), SrcPkgName(..), Relations, Relation(..))+import Debian.Policy (parseMaintainer, parseStandardsVersion, SourceFormat(Quilt3, Native3))+import Debian.Relation (BinPkgName(..), Relation(..), Relations, SrcPkgName(..)) import Debian.Relation.String (parseRelations) import Debian.Version (parseDebianVersion)-import Distribution.Compiler (CompilerFlavor(..))-import Distribution.PackageDescription (FlagName(..)) import Distribution.Package (PackageName(..))-import Prelude hiding (readFile, lines, null, log, sum)-import System.Console.GetOpt (ArgDescr(..), OptDescr(..), ArgOrder(RequireOrder), getOpt')+import Prelude hiding ((.), lines, log, null, readFile, sum)+import System.Console.GetOpt (ArgDescr(..), ArgOrder(RequireOrder), getOpt', OptDescr(..)) import System.Environment (getArgs, getEnv) import System.FilePath ((</>), splitFileName) import System.IO.Error (tryIOError) import System.Posix.Env (setEnv)-import Text.Read (readMaybe) import Text.Regex.TDFA ((=~))  -- | Apply a list of command line arguments to the monadic state.-compileArgs :: MonadIO m => [String] -> DebT m ()+compileArgs :: MonadIO m => [String] -> CabalT m () compileArgs args =     case getOpt' RequireOrder options args of       (os, [], [], []) -> sequence_ os-      (_, non, unk, errs) -> error ("Errors: " ++ show errs ++-                                    ", Unrecognized: " ++ show unk ++-                                    ", Non-Options: " ++ show non)+      (_, non, unk, errs) -> error ("Arguments: " ++ show args +++                                    "\n Errors: " ++ show errs +++                                    "\n  Unrecognized: " ++ show unk +++                                    "\n  Non-Options: " ++ show non)  -- | Get a list of arguments from the CABALDEBIAN environment variable -- and apply them to the monadic state.-compileEnvironmentArgs :: MonadIO m => DebT m ()+compileEnvironmentArgs :: MonadIO m => CabalT m () compileEnvironmentArgs = withEnvironmentArgs compileArgs  -- | Get the list of command line arguments and apply them to the -- monadic state.-compileCommandlineArgs :: MonadIO m => DebT m ()+compileCommandlineArgs :: MonadIO m => CabalT m () compileCommandlineArgs = liftIO getArgs >>= compileArgs  -- | Read a value out of the CABALDEBIAN environment variable which is -- the result of applying show to a [String].-withEnvironmentArgs :: MonadIO m => ([String] -> DebT m a) -> DebT m a+withEnvironmentArgs :: MonadIO m => ([String] -> CabalT m a) -> CabalT m a withEnvironmentArgs f =     liftIO (tryIOError (getEnv "CABALDEBIAN")) >>= either (\ _ -> f []) (maybe (f []) f . maybeRead) @@ -73,53 +70,47 @@ putEnvironmentArgs fs = setEnv "CABALDEBIAN" (show fs) True  -- | Options that modify other atoms.-options :: MonadIO m => [OptDescr (DebT m ())]+options :: MonadIO m => [OptDescr (CabalT m ())] options =-    [ Option "v" ["verbose"] (ReqArg (\ s -> verbosity ~= (read' (\ s' -> error $ "verbose: " ++ show s') s)) "n")-             "Change the amount of progress messages generated",-      Option "n" ["dry-run", "compare"] (NoArg (dryRun ~= True))-             "Just compare the existing debianization to the one we would generate.",-      Option "h?" ["help"] (NoArg (debAction ~= Usage))-             "Show this help text",-      Option "" ["executable"] (ReqArg (\ path -> executableOption path (\ bin e -> doExecutable bin e)) "SOURCEPATH or SOURCEPATH:DESTDIR")+    [ Option "" ["executable"] (ReqArg (\ path -> executableOption path (\ bin e -> doExecutable bin e)) "SOURCEPATH or SOURCEPATH:DESTDIR")              (unlines [ "Create an individual binary package to hold this executable.  Other executables "                       , " and data files are gathered into a single utils package named 'haskell-packagename-utils'."]),-      Option "" ["default-package"] (ReqArg (\ name -> utilsPackageNameBase ~= Just name) "NAME")+      Option "" ["default-package"] (ReqArg (\ name -> (D.utilsPackageNameBase . A.debInfo) ~= Just name) "NAME")              (unlines [ "Set the name of the catch-all package that receives all the files not included in a library package or "                       , " some other executable package.  By default this is 'haskell-packagename-utils'."]),-      Option "" ["disable-haddock"] (NoArg (noDocumentationLibrary ~= True))+      Option "" ["disable-haddock"] (NoArg ((D.noDocumentationLibrary . A.debInfo) ~= True))              (unlines [ "Don't generate API documentation packages, usually named"                       , "libghc-packagename-doc.  Use this if your build is crashing due to a"                       , "haddock bug."]),-      Option "" ["missing-dependency"] (ReqArg (\ name -> missingDependencies += (BinPkgName name)) "DEB")+      Option "" ["missing-dependency"] (ReqArg (\ name -> (D.missingDependencies . A.debInfo) += (BinPkgName name)) "DEB")              (unlines [ "This is the counterpart to --disable-haddock.  It prevents a package"                       , "from being added to the build dependencies.  This is necessary, for example,"                       , "when a dependency package was built with the --disable-haddock option, because"                       , "normally cabal-debian assumes that the -doc package exists and adds it as a"                       , "build dependency."]),-      Option "" ["debian-name-base"] (ReqArg (\ name -> overrideDebianNameBase ~= (Just (DebBase name))) "NAME")+      Option "" ["debian-name-base"] (ReqArg (\ name -> (D.overrideDebianNameBase . A.debInfo) ~= (Just (DebBase name))) "NAME")              (unlines [ "Use this name for the base of the debian binary packages - the string between 'libghc-'"                       , " and '-dev'.  Normally this is derived from the hackage package name."]),-      Option "" ["source-package-name"] (ReqArg (\ name -> sourcePackageName ~= (Just (SrcPkgName name))) "NAME")+      Option "" ["source-package-name"] (ReqArg (\ name -> (D.sourcePackageName . A.debInfo) ~= (Just (SrcPkgName name))) "NAME")              (unlines [ "Use this name for the debian source package, the name in the Source field at the top of the"                       , "debian control file, and also at the very beginning of the debian/changelog file.  By default"                       , "this is haskell-<cabalname>, where the cabal package name is downcased."]),-      Option "" ["source-section"] (ReqArg (\ name -> sourceSection ~= Just (read name)) "NAME")+      Option "" ["source-section"] (ReqArg (\ name -> (S.section . D.control . A.debInfo) ~= Just (read name)) "NAME")              "Set the Section: field of the Debian source package.",-      Option "" ["disable-library-profiling"] (NoArg (noProfilingLibrary ~= True))+      Option "" ["disable-library-profiling"] (NoArg ((D.noProfilingLibrary . A.debInfo) ~= True))              (unlines [ "Don't generate profiling (-prof) library packages.  This has been used in one case"                       , "where the package code triggered a compiler bug."]),-      Option "" ["maintainer"] (ReqArg (\ s -> either (error ("Invalid maintainer string: " ++ show s)) ((maintainerOption ~=) . Just) (parseMaintainer s)) "Maintainer Name <email addr>")+      Option "" ["maintainer"] (ReqArg (\ s -> either (error ("Invalid maintainer string: " ++ show s)) (((D.maintainerOption . A.debInfo) ~=) . Just) (parseMaintainer s)) "Maintainer Name <email addr>")              (unlines [ "Supply a value for the Maintainer field.  Final value is computed from several inputs."]),-      Option "" ["uploader"] (ReqArg (\ s -> either (error ("Invalid uploader string: " ++ show s)) (\ x -> uploadersOption %= (\ l -> l ++ [x])) (parseMaintainer s)) "Uploader Name <email addr>")+      Option "" ["uploader"] (ReqArg (\ s -> either (error ("Invalid uploader string: " ++ show s)) (\ x -> (D.uploadersOption . A.debInfo) %= (\ l -> l ++ [x])) (parseMaintainer s)) "Uploader Name <email addr>")              (unlines [ "Add one entry to the uploader list"]),-      Option "" ["standards-version"] (ReqArg (\ sv -> standardsVersion ~= Just (parseStandardsVersion sv)) "VERSION")+      Option "" ["standards-version"] (ReqArg (\ sv -> (S.standardsVersion . D.control . A.debInfo) ~= Just (parseStandardsVersion sv)) "VERSION")              "Claim compatibility to this version of the Debian policy (i.e. the value of the Standards-Version field)",       Option "" ["build-dep"]                  (ReqArg (\ name ->                               case parseRelations name of                                 Left err -> error ("cabal-debian option --build-dep " ++ show name ++ ": " ++ show err)-                                Right rss -> buildDepends %= (++ rss)) "Debian package relations")+                                Right rss -> (S.buildDepends . D.control . A.debInfo) %= (++ rss)) "Debian package relations")                  (unlines [ "Add a dependency relation to the Build-Depends: field for this source package, e.g."                           , ""                           , "     --build-dep libglib2.0-dev"@@ -128,126 +119,107 @@                  (ReqArg (\ name ->                               case parseRelations name of                                 Left err -> error ("cabal-debian option --build-dep-indep " ++ show name ++ ": " ++ show err)-                                Right rss -> buildDependsIndep %= (++ rss)) "Debian binary package name")+                                Right rss -> (S.buildDependsIndep . D.control . A.debInfo) %= (++ rss)) "Debian binary package name")                  (unlines [ "Similar to --build-dep, but the dependencies are added to Build-Depends-Indep, e.g.:"                           , ""                           , "    --build-dep-indep perl" ]),-      Option "" ["dev-dep"] (ReqArg (\ name -> extraDevDeps %= (++ [[Rel (BinPkgName name) Nothing Nothing]])) "Debian binary package name")+      Option "" ["dev-dep"] (ReqArg (\ name -> (D.extraDevDeps . A.debInfo) %= (++ [[Rel (BinPkgName name) Nothing Nothing]])) "Debian binary package name")              (unlines [ "Add an entry to the Depends: field of the -dev package, e.g."                       , "'--dev-dep libncurses5-dev'.  It might be good if this implied --build-dep."]),       Option "" ["depends"]-             (ReqArg (addDep depends) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.depends . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              (unlines [ "Generalized --dev-dep - specify pairs A:B of debian binary package names, each"                       , "A gets a Depends: B.  Note that B can have debian style version relations"]),       Option "" ["conflicts"]-             (ReqArg (addDep conflicts) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.conflicts . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Conflicts field.",       Option "" ["replaces"]-             (ReqArg (addDep replaces) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.replaces . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Replaces field.",       Option "" ["provides"]-             (ReqArg (addDep provides) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.provides . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Provides field.",       Option "" ["recommends"]-             (ReqArg (addDep recommends) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.recommends . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Recommends field.",       Option "" ["suggests"]-             (ReqArg (addDep suggests) "deb:deb,deb:deb,...")+             (ReqArg (addDep (\b -> B.suggests . B.relations . binaryDebDescription b)) "deb:deb,deb:deb,...")              "Like --depends, modifies the Suggests field.",       Option "" ["map-dep"] (ReqArg (\ pair -> case break (== '=') pair of-                                                 (cab, (_ : deb)) -> extraLibMap +++= (cab, rels deb)+                                                 (cab, (_ : deb)) -> (D.extraLibMap . A.debInfo) +++= (cab, rels deb)                                                  (_, "") -> error "usage: --map-dep CABALNAME=RELATIONS") "CABALNAME=RELATIONS")              (unlines [ "Specify what debian package name corresponds with a name that appears in"                       , "the Extra-Library field of a cabal file, e.g. --map-dep cryptopp=libcrypto-dev."                       , "I think this information is present somewhere in the packaging system, but"                       , "I'm not sure of the details."]),-      Option "" ["deb-version"] (ReqArg (\ version -> debVersion ~= Just (parseDebianVersion version)) "VERSION")+      Option "" ["deb-version"] (ReqArg (\ version -> (D.debVersion . A.debInfo) ~= Just (parseDebianVersion version)) "VERSION")              "Specify the version number for the debian package.  This will pin the version and should be considered dangerous.",-      Option "" ["revision"] (ReqArg (\ rev -> revision ~= Just rev) "REVISION")+      Option "" ["revision"] (ReqArg (\ rev -> (D.revision . A.debInfo) ~= Just rev) "REVISION")              "Add this string to the cabal version to get the debian version number.  By default this is '-1~hackage1'.  Debian policy says this must either be empty (--revision '') or begin with a dash.",       Option "" ["epoch-map"]              (ReqArg (\ pair -> case break (== '=') pair of                                   (_, (_ : ['0'])) -> return ()-                                  (cab, (_ : [d])) | isDigit d -> epochMap ++= (PackageName cab, ord d - ord '0')+                                  (cab, (_ : [d])) | isDigit d -> A.epochMap ++= (PackageName cab, ord d - ord '0')                                   _ -> error "usage: --epoch-map CABALNAME=DIGIT") "CABALNAME=DIGIT")              "Specify a mapping from the cabal package name to a digit to use as the debian package epoch number, e.g. --epoch-map HTTP=1",       Option "" ["exec-map"] (ReqArg (\ s -> case break (== '=') s of-                                               (cab, (_ : deb)) -> execMap ++= (cab, rels deb)+                                               (cab, (_ : deb)) -> (D.execMap . A.debInfo) ++= (cab, rels deb)                                                _ -> error "usage: --exec-map EXECNAME=RELATIONS") "EXECNAME=RELATIONS")              "Specify a mapping from the name appearing in the Build-Tool field of the cabal file to a debian binary package name, e.g. --exec-map trhsx=haskell-hsx-utils",-      Option "" ["omit-prof-version-deps"] (NoArg (omitProfVersionDeps ~= True))+      Option "" ["omit-prof-version-deps"] (NoArg ((D.omitProfVersionDeps . A.debInfo) ~= True))              "Do not put the version dependencies on the prof packages that we put on the dev packages.",-      Option "" ["omit-lt-deps"] (NoArg (omitLTDeps ~= True))+      Option "" ["omit-lt-deps"] (NoArg ((D.omitLTDeps . A.debInfo) ~= True))              (unlines [ "Remove all less-than dependencies from the generated control file.  Less-than"                       , "dependencies are less useful and more troublesome for debian packages than cabal,"                       , "because you can't install multiple versions of a given debian package.  For more"                       , "google 'cabal hell'."]),-      Option "" ["quilt"] (NoArg (sourceFormat ~= Just Quilt3))+      Option "" ["quilt"] (NoArg ((D.sourceFormat . A.debInfo) ~= Just Quilt3))              "The package has an upstream tarball, write '3.0 (quilt)' into source/format.",-      Option "" ["native"] (NoArg (sourceFormat ~= Just Native3))+      Option "" ["native"] (NoArg ((D.sourceFormat . A.debInfo) ~= Just Native3))              "The package has an no upstream tarball, write '3.0 (native)' into source/format.",-      Option "" ["official"] (NoArg (official ~= True))+      Option "" ["official"] (NoArg ((D.official . A.debInfo) ~= True))              "This packaging is created of the official Debian Haskell Group",-      Option "" ["builddir"] (ReqArg (\ s -> buildDir ~= singleton (s </> "build")) "PATH")+      Option "" ["builddir"] (ReqArg (\ s -> (D.buildDir . A.debInfo) ~= Just (s </> "build")) "PATH")              (unlines [ "Subdirectory where cabal does its build, dist/build by default, dist-ghc when"                       , "run by haskell-devscripts.  The build subdirectory is added to match the"                       , "behavior of the --builddir option in the Setup script."]),+      Option "" ["no-test-suite"] (NoArg ((D.noTestSuite . A.debInfo) ~= True))+             "Don't build or run the test suite.",+      Option "" ["allow-debian-self-build-deps"] (NoArg ((D.allowDebianSelfBuildDeps . A.debInfo) ~= True))+             (unlines [ "Don't filter out self dependencies in the debian package build dependencies."+                      , "This may occasionally be necessary for a package that relies on an older"+                      , "version of itself to build." ])+    ] ++ map liftOpt flagOptions -      let f :: MonadIO m => String -> DebT m ()-          f s = get >>= setBuildEnv (EnvSet {cleanOS = s </> "clean", dependOS = s </> "depend", buildOS = s </> "build"}) >>= put in-      Option "" ["buildenvdir"] (ReqArg f "PATH")-             (unlines [ "Directory containing the build environment for which the debianization will"-                      , "be generated.  This determines which compiler will be available, which in turn"-                      , "determines which basic libraries can be provided by the compiler.  This can be"-                      , "set to /, but it must be set."]),-      Option "" ["ghc"] (NoArg (compilerFlavors %= (insert GHC))) "Generate packages for GHC - same as --with-compiler GHC",-      Option "" ["no-ghc"] (NoArg (compilerFlavors %= (delete GHC))) "Do not generate packages for GHC - same as --without-compiler GHC",-#if MIN_VERSION_Cabal(1,21,0)-      Option "" ["ghcjs"] (NoArg (compilerFlavors %= (insert GHCJS))) "Generate packages for GHCJS - same as --with-compiler GHCJS",-      Option "" ["no-ghcjs"] (NoArg (compilerFlavors %= (delete GHCJS))) "Do not generate packages for GHCJS - same as --without-compiler GHCJS",-#endif-      Option "" ["hugs"] (NoArg (compilerFlavors %= (insert Hugs))) "Generate packages for Hugs - same as --with-compiler GHC",-      Option "" ["no-hugs"] (NoArg (compilerFlavors %= (delete Hugs))) "Do not generate packages for Hugs - same as --without-compiler Hugs",-      Option "" ["with-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)-                                                        (\ hc -> compilerFlavors %= insert hc)-                                                        (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")-             (unlines [ "Generate packages for this CompilerFlavor" ]),-      Option "" ["without-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)-                                                           (\ hc -> compilerFlavors %= delete hc)-                                                           (readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")-             (unlines [ "Do not generate packages for this CompilerFlavors, e.g. GHC" ]),-      Option "f" ["flags"] (ReqArg (\ fs -> mapM_ (cabalFlagAssignments +=) (flagList fs)) "FLAGS")-             (unlines [ "Flags to pass to the finalizePackageDescription function in"-                      , "Distribution.PackageDescription.Configuration when loading the cabal file."]),+liftOpt :: Monad m => OptDescr (StateT Flags m ()) -> OptDescr (CabalT m ())+liftOpt (Option chrs strs desc doc) = Option chrs strs (liftDesc desc) doc -      Option "" ["debianize"] (NoArg (debAction ~= Debianize))-             "Deprecated - formerly used to get what is now the normal benavior.",-      Option "" ["substvar"] (ReqArg (\ name -> debAction ~= (SubstVar (read' (\ s -> error $ "substvar: " ++ show s) name))) "Doc, Prof, or Dev")-             (unlines [ "With this option no debianization is generated.  Instead, the list"-                      , "of dependencies required for the dev, prof or doc package (depending"-                      , "on the argument) is printed to standard output.  These can be added"-                      , "to the appropriate substvars file.  (This is an option whose use case"-                      , "is lost in the mists of time.)"])-    ]+liftDesc :: Monad m => ArgDescr (StateT Flags m ()) -> ArgDescr (CabalT m ())+liftDesc (NoArg x) = NoArg (focus (flags . A.debInfo) x)+liftDesc (ReqArg f s) = ReqArg (\ p -> focus (flags . A.debInfo) (f p)) s+liftDesc (OptArg f s) = OptArg (\ mp -> focus (flags . A.debInfo) (f mp)) s  anyrel :: BinPkgName -> Relation anyrel x = Rel x Nothing Nothing  -- | Process a --executable command line argument-executableOption :: String -> (BinPkgName -> InstallFile -> a) -> a+executableOption :: String -> (BinPkgName -> D.InstallFile -> a) -> a executableOption arg f =     case span (/= ':') arg of       (sp, md) ->           let (sd, name) = splitFileName sp in           f (BinPkgName name)-            (InstallFile { execName = name-                         , destName = name-                         , sourceDir = case sd of "./" -> Nothing; _ -> Just sd-                         , destDir = case md of (':' : dd) -> Just dd; _ -> Nothing })+            (D.InstallFile { D.execName = name+                           , D.destName = name+                           , D.sourceDir = case sd of "./" -> Nothing; _ -> Just sd+                           , D.destDir = case md of (':' : dd) -> Just dd; _ -> Nothing }) -addDep :: Monad m => (BinPkgName -> Lens Atoms Relations) -> String -> DebT m ()-addDep lns arg = mapM_ (\ (b, rel) -> lns b %= (++ [[rel]])) (parseDeps arg)+-- addDep' :: Monad m => (BinPkgName -> Lens DebInfo Relations) -> String -> DebianT m ()+-- addDep' lns arg = mapM_ (\ (b, rel) -> lns b %= (++ [[rel]])) (parseDeps arg) +addDep :: Monad m => (BinPkgName -> Lens DebInfo Relations) -> String -> CabalT m ()+addDep lns arg = mapM_ (\ (b, rel) -> (lns b . A.debInfo) %= (++ [[rel]])) (parseDeps arg)+ parseDeps :: String -> [(BinPkgName, Relation)] parseDeps arg =     map pair (split arg)@@ -261,12 +233,6 @@           case s =~ "^[ \t:]*([^ \t:]+)[ \t]*:[ \t]*(.+)[ \t]*" :: (String, String, String, [String]) of             (_, _, _, [x, y]) -> (BinPkgName x, anyrel (BinPkgName y))             _ -> error $ "Invalid dependency: " ++ show s---- Lifted from Distribution.Simple.Setup, since it's not exported.-flagList :: String -> [(FlagName, Bool)]-flagList = map tagWithValue . words-  where tagWithValue ('-':name) = (FlagName (map toLower name), False)-        tagWithValue name       = (FlagName (map toLower name), True)  rels :: String -> Relations rels s =

@@ -17,7 +17,7 @@ import Control.Category ((.)) import Control.Exception as E (throw) import Control.Monad.State (get)-import Control.Monad.Trans (MonadIO, liftIO)+import Control.Monad.Trans (liftIO, MonadIO) import Data.Algorithm.Diff.Context (contextDiff) import Data.Algorithm.Diff.Pretty (prettyDiff) import Data.Lens.Lazy (getL)@@ -25,19 +25,18 @@ import Data.Maybe (fromMaybe) import Data.Text as Text (split, Text, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))-import Debian.Debianize.Types.Atoms (EnvSet)+import Debian.Debianize.BasicInfo (dryRun, validate)+import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap)-import Debian.Debianize.Input (inputDebianization)-import Debian.Debianize.Monad (DebT, Atoms, evalDebT)+import Debian.Debianize.InputDebian (inputDebianization)+import Debian.Debianize.Monad (DebianT, evalDebianT) import Debian.Debianize.Options (putEnvironmentArgs) import Debian.Debianize.Prelude (indent, replaceFile, zipMaps)-import qualified Debian.Debianize.Types as T-import Debian.Debianize.Types.BinaryDebDescription as B (package, canonical)-import qualified Debian.Debianize.Types.SourceDebDescription as S (source)-import Debian.Pretty (ppPrint, ppDisplay)-import Prelude hiding (unlines, writeFile, (.))+import Debian.Debianize.BinaryDebDescription as B (canonical, package)+import qualified Debian.Debianize.SourceDebDescription as S+import Debian.Pretty (ppDisplay, ppPrint)+import Prelude hiding ((.), unlines, writeFile) import System.Directory (createDirectoryIfMissing, doesFileExist, getPermissions, Permissions(executable), setPermissions)---import System.Environment (getEnv) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((</>), takeDirectory) import System.IO (hPutStrLn, stderr)@@ -70,23 +69,23 @@  -- | Depending on the options in @atoms@, either validate, describe, -- or write the generated debianization.-doDebianizeAction :: (MonadIO m, Functor m) => EnvSet -> DebT m ()-doDebianizeAction envset =+doDebianizeAction :: (MonadIO m, Functor m) => DebianT m ()+doDebianizeAction =     do new <- get        case () of-         _ | getL T.validate new ->-               do inputDebianization envset+         _ | getL (validate . D.flags) new ->+               do inputDebianization                   old <- get                   return $ validateDebianization old new-         _ | getL T.dryRun new ->-               do inputDebianization envset+         _ | getL (dryRun . D.flags) new ->+               do inputDebianization                   old <- get                   diff <- liftIO $ compareDebianization old new                   liftIO $ putStr ("Debianization (dry run):\n" ++ diff)          _ -> writeDebianization  -- | Write the files of the debianization @d@ to ./debian-writeDebianization :: (MonadIO m, Functor m) => DebT m ()+writeDebianization :: (MonadIO m, Functor m) => DebianT m () writeDebianization =     do files <- debianizationFileMap        liftIO $ mapM_ (uncurry doFile) (Map.toList files)@@ -98,16 +97,16 @@  -- | Return a string describing the debianization - a list of file -- names and their contents in a somewhat human readable format.-describeDebianization :: (MonadIO m, Functor m) => DebT m String+describeDebianization :: (MonadIO m, Functor m) => DebianT m String describeDebianization =     debianizationFileMap >>= return . concatMap (\ (path, text) -> path ++ ": " ++ indent " > " (unpack text)) . Map.toList  -- | Compare the old and new debianizations, returning a string -- describing the differences.-compareDebianization :: Atoms -> Atoms -> IO String+compareDebianization :: D.DebInfo -> D.DebInfo -> IO String compareDebianization old new =-    do oldFiles <- evalDebT debianizationFileMap (canonical old)-       newFiles <- evalDebT debianizationFileMap (canonical new)+    do oldFiles <- evalDebianT debianizationFileMap (canonical old)+       newFiles <- evalDebianT debianizationFileMap (canonical new)        return $ concat $ Map.elems $ zipMaps doFile oldFiles newFiles     where       doFile :: FilePath -> Maybe Text -> Maybe Text -> Maybe String@@ -124,7 +123,7 @@ -- the names of the source and binary packages.  Some debian packages -- come with a skeleton debianization that needs to be filled in, this -- can be used to make sure the debianization we produce is usable.-validateDebianization :: Atoms -> Atoms -> ()+validateDebianization :: D.DebInfo -> D.DebInfo -> () validateDebianization old new =     case () of       _ | oldVersion /= newVersion -> throw (userError ("Version mismatch, expected " ++ ppDisplay oldVersion ++ ", found " ++ ppDisplay newVersion))@@ -132,11 +131,11 @@         | oldPackages /= newPackages -> throw (userError ("Package mismatch, expected " ++ show (map ppPrint oldPackages) ++ ", found " ++ show (map ppPrint newPackages)))         | True -> ()     where-      oldVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (getL T.changelog old))))-      newVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (getL T.changelog new))))-      oldSource = getL (S.source . T.control) old-      newSource = getL (S.source . T.control) new-      oldPackages = map (getL B.package) $ getL T.binaryPackages old-      newPackages = map (getL B.package) $ getL T.binaryPackages new+      oldVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (getL D.changelog old))))+      newVersion = logVersion (head (unChangeLog (fromMaybe (error "Missing changelog") (getL D.changelog new))))+      oldSource = getL (S.source . D.control) old+      newSource = getL (S.source . D.control) new+      oldPackages = map (getL B.package) $ getL (S.binaryPackages . D.control) old+      newPackages = map (getL B.package) $ getL (S.binaryPackages . D.control) new       unChangeLog :: ChangeLog -> [ChangeLogEntry]       unChangeLog (ChangeLog x) = x

@@ -46,36 +46,36 @@  import Control.Applicative ((<$>)) import Control.Category ((.))-import Control.Exception as E (catch, try, bracket, IOException)+import Control.Exception as E (bracket, catch, throw, try) import Control.Monad (when)-import Control.Monad.Reader (ReaderT, ask)-import Control.Monad.State (MonadState, StateT, get, put)+import Control.Monad.Reader (ask, ReaderT)+import Control.Monad.State (get, MonadState, put, StateT) import Data.Char (isSpace)-import qualified Data.Lens.Lazy as Lens ((~=), (%=))-import Data.Lens.Lazy (getL, Lens, lens, modL, setL)-import Data.List as List (isSuffixOf, intersperse, map, lines, dropWhileEnd)-import Data.Map as Map (Map, foldWithKey, empty, fromList, findWithDefault, insert, map, lookup, insertWith)-import Data.Maybe (catMaybes, mapMaybe, listToMaybe, fromMaybe, fromJust)-import Data.Monoid (Monoid, (<>), mappend, mconcat)+import Data.Lens.Lazy (getL, lens, Lens, modL, setL)+import qualified Data.Lens.Lazy as Lens ((%=), (~=))+import Data.List as List (dropWhileEnd, intersperse, isSuffixOf, lines, map)+import Data.Map as Map (empty, findWithDefault, foldWithKey, fromList, insert, insertWith, lookup, map, Map)+import Data.Maybe (catMaybes, fromJust, fromMaybe, listToMaybe, mapMaybe)+import Data.Monoid ((<>), mappend, mconcat, Monoid) import Data.Set as Set (Set, toList)-import qualified Data.Set as Set-import Data.Text as Text (Text, unpack, lines)+import qualified Data.Set as Set (findMin, fromList, insert, null, size)+import Data.Text as Text (lines, Text, unpack) import Data.Text.IO (hGetContents)-import Debian.Control (parseControl, lookupP, Field'(Field), unControl, stripWS)+import Debian.Control (Field'(Field), lookupP, parseControl, stripWS, unControl) import Debian.Orphans () import Debian.Pretty (PP(PP))-import Debian.Relation.Common ({- Pretty instances -})+import qualified Debian.Relation as D (BinPkgName(BinPkgName), Relations)+import Debian.Relation.Common () import Debian.Version (DebianVersion, prettyDebianVersion) import Debian.Version.String (parseDebianVersion)-import qualified Debian.Relation as D import Distribution.Package (PackageIdentifier(..), PackageName(..))-import Distribution.Verbosity (Verbosity, intToVerbosity)-import Prelude hiding (map, lookup, (.))-import System.Directory (doesFileExist, doesDirectoryExist, removeFile, renameFile, removeDirectory, getDirectoryContents, getCurrentDirectory, setCurrentDirectory)-import System.Exit(ExitCode(ExitSuccess, ExitFailure))+import Distribution.Verbosity (intToVerbosity, Verbosity)+import GHC.IO.Exception (ExitCode(ExitFailure, ExitSuccess), IOErrorType(InappropriateType, NoSuchThing), IOException(IOError, ioe_description, ioe_type))+import Prelude hiding ((.), lookup, map)+import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents, removeDirectory, removeFile, renameFile, setCurrentDirectory) import System.FilePath ((</>), dropExtension)-import System.IO (IOMode (ReadMode), withFile, openFile, hSetBinaryMode)-import System.IO.Error (isDoesNotExistError, catchIOError)+import System.IO (hSetBinaryMode, IOMode(ReadMode), openFile, withFile)+import System.IO.Error (catchIOError, isDoesNotExistError) import System.Process (readProcessWithExitCode, showCommandForUser) import Text.PrettyPrint.HughesPJClass as PP (Pretty(pPrint), text) @@ -199,13 +199,22 @@  -- | From Darcs.Utils - set the working directory and run an IO operation. withCurrentDirectory :: FilePath -> IO a -> IO a-withCurrentDirectory name m =+withCurrentDirectory path m =     E.bracket-        (do cwd <- getCurrentDirectory-            setCurrentDirectory name-            return cwd)-        (\oldwd -> setCurrentDirectory oldwd {- `catchall` return () -})-        (const m)+        (do oldwd <- getCurrentDirectory+            let newwd = oldwd </> path+            setCurrentDirectory' newwd+            return oldwd)+        (\oldwd -> setCurrentDirectory' oldwd {- `catchall` return () -})+        (\_oldwd -> m)++setCurrentDirectory' :: FilePath -> IO ()+setCurrentDirectory' dir =+    try (setCurrentDirectory dir) >>= either handle return+    where+      handle e@(IOError {ioe_type = NoSuchThing}) = throw $ e {ioe_description = ioe_description e ++ ": " ++ show dir}+      handle e@(IOError {ioe_type = InappropriateType}) = throw $ e {ioe_description = ioe_description e ++ ": " ++ show dir}+      handle e@(IOError {ioe_type = typ}) = throw $ e {ioe_description = ioe_description e ++ " unexpected ioe_type: " ++ show typ}  {- catchall :: IO a -> IO a -> IO a

@@ -0,0 +1,136 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeSynonymInstances #-}+module Debian.Debianize.SourceDebDescription+    ( SourceDebDescription+    , newSourceDebDescription+    , newSourceDebDescription'+    , source+    , maintainer+    , changedBy+    , uploaders+    , dmUploadAllowed+    , priority+    , section+    , buildDepends+    , buildConflicts+    , buildDependsIndep+    , buildConflictsIndep+    , standardsVersion+    , homepage+    , vcsFields+    , xFields+    , xDescription+    , binaryPackages+    , VersionControlSpec(..)+    , XField(..)+    , XFieldDest(..)+    ) where++import Data.Generics (Data, Typeable)+import Data.Lens.Template (makeLenses)+import Data.Set as Set (empty, Set)+import Data.Text (Text)+import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical))+import Debian.Orphans ()+import Debian.Policy (PackagePriority, Section, StandardsVersion)+import Debian.Relation (Relations, SrcPkgName)+import Prelude hiding (init, init, log, log, unlines)+import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)++-- | This type represents the debian/control file, which is the core+-- of the source package debianization.  It includes the information+-- that goes in the first, or source, section, and then a list of the+-- succeeding binary package sections.+data SourceDebDescription+    = SourceDebDescription+      { _source :: Maybe SrcPkgName+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Source>+      , _maintainer :: Maybe NameAddr+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Maintainer>+      , _changedBy :: Maybe NameAddr+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Changed-By>+      , _uploaders :: [NameAddr]+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Uploaders>+      , _dmUploadAllowed :: Bool+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-DM-Upload-Allowed>+      , _priority :: Maybe PackagePriority+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Priority>+      , _section :: Maybe Section+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Section>+      , _standardsVersion :: Maybe StandardsVersion+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Standards-Version>+      , _homepage :: Maybe Text+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Homepage>+      , _vcsFields :: Set VersionControlSpec+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-VCS-fields>+      , _xFields :: Set XField+      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.7>+      , _buildDepends :: Relations+      , _buildConflicts :: Relations+      , _buildDependsIndep :: Relations+      , _buildConflictsIndep :: Relations+      , _xDescription :: Maybe Text+      , _binaryPackages :: [BinaryDebDescription]+      -- ^ The binary debs.  This should be a map, but we may need to preserve the order+      } deriving (Eq, Ord, Show, Data, Typeable)++instance Canonical SourceDebDescription where+    canonical x = x { _binaryPackages = canonical (_binaryPackages x)+                    , _buildDepends = canonical (_buildDepends x)+                    , _buildConflicts = canonical (_buildConflicts x)+                    , _buildDependsIndep = canonical (_buildDependsIndep x)+                    , _buildConflictsIndep = canonical (_buildConflictsIndep x)+                    }++newSourceDebDescription :: SourceDebDescription+newSourceDebDescription =+    SourceDebDescription+      { _source = Nothing+      , _maintainer = Nothing+      , _changedBy = Nothing+      , _uploaders = []+      , _dmUploadAllowed = False+      , _priority = Nothing+      , _section = Nothing+      , _buildDepends = []+      , _buildConflicts = []+      , _buildDependsIndep  = []+      , _buildConflictsIndep  = []+      , _standardsVersion = Nothing+      , _homepage = Nothing+      , _vcsFields = Set.empty+      , _xFields = Set.empty+      , _xDescription = Nothing -- Quick hack, I should maybe put this into _xFields+      , _binaryPackages = [] }++newSourceDebDescription' :: SrcPkgName -> NameAddr -> SourceDebDescription+newSourceDebDescription' src who =+    newSourceDebDescription+      { _source = Just src+      , _maintainer = Just who }++data VersionControlSpec+    = VCSBrowser Text+    | VCSArch Text+    | VCSBzr Text+    | VCSCvs Text+    | VCSDarcs Text+    | VCSGit Text+    | VCSHg Text+    | VCSMtn Text+    | VCSSvn Text+    deriving (Eq, Ord, Show, Data, Typeable)++-- | User defined fields.  Parse the line "XBS-Comment: I stand+-- between the candle and the star." to get XField (fromList "BS")+-- "Comment" " I stand between the candle and the star."+data XField+    = XField (Set XFieldDest) Text Text+    deriving (Eq, Ord, Show, Data, Typeable)++data XFieldDest+    = B -- ^ Field will be copied to the binary packgae control files+    | S -- ^ Field will be copied to the source packgae control files+    | C -- ^ Field will be copied to the upload control (.changes) file+    deriving (Eq, Ord, Read, Show, Data, Typeable)++$(makeLenses [''SourceDebDescription])

@@ -7,47 +7,38 @@     ( substvars     ) where -import Control.Applicative ((<$>))+import Control.Category ((.)) import Control.Exception (SomeException, try) import Control.Monad (foldM) import Control.Monad.Reader (ReaderT(runReaderT)) import Control.Monad.State (get)-import Control.Monad.Trans (MonadIO, liftIO, lift)-import Data.Lens.Lazy (getL, modL, access)+import Control.Monad.Trans (lift, liftIO, MonadIO)+import Data.Lens.Lazy (access, getL, modL) import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition, unlines) import Data.List as List (map) import qualified Data.Map as Map (insert, lookup, Map)-import Data.Maybe (catMaybes, listToMaybe, fromMaybe)+import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import qualified Data.Set as Set (member, Set) import Data.Text (pack) import Debian.Control (Control'(unControl), ControlFunctions(lookupP, parseControl, stripWS), Field'(Field))-import Debian.Debianize.Input (inputCabalization)-import Debian.Debianize.Monad (DebT)-import Debian.Debianize.Prelude ((!), buildDebVersionMap, cond, DebMap, debOfFile, diffFile, dpkgFileMap, replaceFile, showDeps, modifyM)-import qualified Debian.Debianize.Types.Atoms as T+import Debian.Debianize.BasicInfo (DebType(..), dryRun)+import qualified Debian.Debianize.DebInfo as D (flags, extraLibMap, missingDependencies)+import Debian.Debianize.Monad (CabalT)+import Debian.Debianize.Prelude ((!), buildDebVersionMap, cond, DebMap, debOfFile, diffFile, dpkgFileMap, modifyM, replaceFile, showDeps)+import qualified Debian.Debianize.CabalInfo as A (CabalInfo, debInfo, packageDescription, packageInfo, PackageInfo(PackageInfo, cabalName, devDeb, docDeb, profDeb)) import Debian.Orphans () import Debian.Pretty (ppDisplay) import Debian.Relation (BinPkgName(BinPkgName), Relation, Relations) import qualified Debian.Relation as D (BinPkgName(BinPkgName), ParseRelations(parseRelations), Relation(Rel), Relations, VersionReq(GRE))-#if MIN_VERSION_Cabal(1,18,0) import Distribution.Compiler (buildCompilerId)-#else-import Data.Version-import Distribution.Compiler-#endif import Distribution.Package (Dependency(..), PackageName(PackageName)) import Distribution.PackageDescription as Cabal (allBuildInfo, buildTools, extraLibs, PackageDescription(..), pkgconfigDepends) import Distribution.Simple.Utils (die) import Distribution.Text (display)-import Prelude hiding (unlines)+import Prelude hiding ((.), unlines) import System.Directory (doesDirectoryExist, getDirectoryContents) import System.FilePath ((</>)) -#if !MIN_VERSION_Cabal(1,18,0)-buildCompilerId :: CompilerId-buildCompilerId = CompilerId GHC (Version [7,6,3] [])-#endif- -- | Expand the contents of the .substvars file for a library package. -- Each cabal package corresponds to a directory <name>-<version>, -- either in /usr/lib or in /usr/lib/haskell-packages/ghc/lib.  In@@ -59,18 +50,17 @@ -- these we can determine the source package name, and from that the -- documentation package name. substvars :: (MonadIO m, Functor m) =>-             T.DebType  -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc-          -> DebT m ()+             DebType  -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc+          -> CabalT m () substvars debType =-    do inputCabalization-       debVersions <- liftIO buildDebVersionMap+    do debVersions <- liftIO buildDebVersionMap        modifyM (liftIO . libPaths debVersions)        control <- liftIO $ readFile "debian/control" >>= either (error . show) return . parseControl "debian/control"        substvars' debType control -substvars' :: (MonadIO m, Functor m) => T.DebType -> Control' String -> DebT m ()+substvars' :: (MonadIO m, Functor m) => DebType -> Control' String -> CabalT m () substvars' debType control =-    get >>= return . getL T.packageInfo >>= \ info ->+    get >>= return . getL A.packageInfo >>= \ info ->     cabalDependencies >>= \ cabalDeps ->     case (missingBuildDeps info cabalDeps, path) of       -- There should already be a .substvars file produced by dh_haskell_prep,@@ -85,7 +75,7 @@           do old <- liftIO $ readFile path'              deps <- debDeps debType control              new <- addDeps old deps-             dry <- get >>= return . getL T.dryRun+             dry <- get >>= return . getL (dryRun . D.flags . A.debInfo)              liftIO (diffFile path' (pack new) >>= maybe (putStrLn ("cabal-debian substvars: No updates found for " ++ show path'))                                                        (\ diff -> if dry then putStr diff else replaceFile path' new))       ([], Nothing) -> return ()@@ -111,8 +101,8 @@                   concat (map (\ (Dependency name _) ->                                case Map.lookup name info of                                  Just info' ->-                                     let prof = maybe (T.devDeb info') Just (T.profDeb info') in-                                     let doc = T.docDeb info' in+                                     let prof = maybe (A.devDeb info') Just (A.profDeb info') in+                                     let doc = A.docDeb info' in                                      catMaybes [prof, doc]                                  Nothing -> []) cabalDeps) in           filter (not . (`elem` buildDepNames) . fst) requiredDebs@@ -124,7 +114,7 @@       bd = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends" . head . unControl $ control       bdi = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends-Indep" . head . unControl $ control -libPaths :: DebMap -> T.Atoms -> IO T.Atoms+libPaths :: DebMap -> A.CabalInfo -> IO A.CabalInfo libPaths debVersions atoms =     do a <- getDirPaths "/usr/lib"        b <- getDirPaths ("/usr/lib/haskell-packages" </> display buildCompilerId </> "lib")@@ -133,7 +123,7 @@     where       getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (\ (_ :: SomeException) -> []) id -packageInfo' :: DebMap -> T.Atoms -> (FilePath, String) -> ReaderT (Map.Map FilePath (Set.Set D.BinPkgName)) IO T.Atoms+packageInfo' :: DebMap -> A.CabalInfo -> (FilePath, String) -> ReaderT (Map.Map FilePath (Set.Set D.BinPkgName)) IO A.CabalInfo packageInfo' debVersions atoms (d, f) =     case parseNameVersion f of       Nothing -> return atoms@@ -148,12 +138,12 @@           do dev <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ ".a$")              prof <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ "_p.a$")              doc <- debOfFile ("/" ++ p ++ ".haddock$")-             return $ modL T.packageInfo (Map.insert+             return $ modL A.packageInfo (Map.insert                                            (PackageName p)-                                           (T.PackageInfo { T.cabalName = PackageName p-                                                          , T.devDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) dev-                                                          , T.profDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) prof-                                                          , T.docDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) doc })) atoms+                                           (A.PackageInfo { A.cabalName = PackageName p+                                                          , A.devDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) dev+                                                          , A.profDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) prof+                                                          , A.docDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) doc })) atoms  data Dependency_   = BuildDepends Dependency@@ -170,15 +160,15 @@  -- Make a list of the debian devel packages corresponding to cabal packages -- which are build dependencies-debDeps :: (MonadIO m, Functor m) => T.DebType -> Control' String -> DebT m D.Relations+debDeps :: (MonadIO m, Functor m) => DebType -> Control' String -> CabalT m D.Relations debDeps debType control =-    do info <- get >>= return . getL T.packageInfo+    do info <- get >>= return . getL A.packageInfo        cabalDeps <- cabalDependencies        return $ interdependencies ++ otherdependencies info cabalDeps     where       interdependencies =           case debType of-            T.Prof -> maybe [] (\ name -> [[D.Rel name Nothing Nothing]]) (debNameFromType control T.Dev)+            Prof -> maybe [] (\ name -> [[D.Rel name Nothing Nothing]]) (debNameFromType control Dev)             _ -> []       otherdependencies info cabalDeps =           catMaybes (map (\ (Dependency name _) ->@@ -186,14 +176,14 @@                             Just p -> maybe Nothing                                             (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing])                                             (case debType of-                                               T.Dev -> T.devDeb p-                                               T.Prof -> T.profDeb p-                                               T.Doc -> T.docDeb p)+                                               Dev -> A.devDeb p+                                               Prof -> A.profDeb p+                                               Doc -> A.docDeb p)                             Nothing -> Nothing) cabalDeps) -cabalDependencies :: (MonadIO m, Functor m) => DebT m [Dependency]+cabalDependencies :: (MonadIO m, Functor m) => CabalT m [Dependency] cabalDependencies =-    do pkgDesc <- fromMaybe (error "cabalDependencies") <$> access T.packageDescription+    do pkgDesc <- access A.packageDescription        atoms <- get        return $ catMaybes $ map unboxDependency $            allBuildDepends atoms@@ -204,7 +194,7 @@  -- |Debian packages don't have per binary package build dependencies, -- so we just gather them all up here.-allBuildDepends :: T.Atoms -> [Dependency] -> [Dependency] -> [Dependency] -> [String] -> [Dependency_]+allBuildDepends :: A.CabalInfo -> [Dependency] -> [Dependency] -> [Dependency] -> [String] -> [Dependency_] allBuildDepends atoms buildDepends buildTools pkgconfigDepends extraLibs =     nub $ map BuildDepends buildDepends ++           map BuildTools buildTools ++@@ -213,20 +203,20 @@     where       fixDeps :: [String] -> [Relations]       fixDeps xs = map (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]]-                                           (Map.lookup cab (getL T.extraLibMap atoms))) xs+                                           (Map.lookup cab (getL (D.extraLibMap . A.debInfo) atoms))) xs  -- | Given a control file and a DebType, look for the binary deb with -- the corresponding suffix and return its name.-debNameFromType :: Control' String -> T.DebType -> Maybe BinPkgName+debNameFromType :: Control' String -> DebType -> Maybe BinPkgName debNameFromType control debType =     case debType of-      T.Dev -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-dev") debNames)-      T.Prof -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-prof") debNames)-      T.Doc -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-doc") debNames)+      Dev -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-dev") debNames)+      Prof -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-prof") debNames)+      Doc -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-doc") debNames)     where       debNames = map (\ (Field (_, s)) -> stripWS s) (catMaybes (map (lookupP "Package") (tail (unControl control)))) -filterMissing :: Monad m => [[Relation]] -> DebT m [[Relation]]+filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]] filterMissing rels =-    do missing <- get >>= return . getL T.missingDependencies+    do missing <- get >>= return . getL (D.missingDependencies . A.debInfo)        return $ filter (/= []) (List.map (filter (\ (D.Rel name _ _) -> not (Set.member name missing))) rels)

@@ -1,272 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}-module Debian.Debianize.Types-    (-    -- * Modes of operation-      verbosity-    , dryRun-    , debAction-    , cabalFlagAssignments--    -- * Cabal package info-    , packageDescription--    -- * Repository info-    , execMap-    , epochMap-    , missingDependencies-    , extraLibMap-    , debianNameMap--    -- * Source Package Info-    , sourcePackageName-    , overrideDebianNameBase-    , revision-    , debVersion-    , debianMaintainer-    , debianUploaders-    , maintainerOption-    , uploadersOption-    , copyright-    , sourceArchitectures-    , sourcePriority-    , sourceSection-    , compat-    , sourceFormat-    , changelog-    , comments-    , standardsVersion-    , rulesHead-    , rulesSettings-    , rulesIncludes-    , rulesFragments-    , official-    , noProfilingLibrary-    , noDocumentationLibrary-    , utilsPackageNameBase-    , buildDir-    , watch-    , xDescription--    -- * Source Package Build Dependencies-    , omitProfVersionDeps-    , omitLTDeps-    -- , compilerVersion--    -- * Binary Package Info-    , binaryArchitectures-    , executable-    , serverInfo -- askServers = serverInfo-    , website-    , backups-    , apacheSite-    , extraDevDeps-    , postInst-    , postRm-    , preInst-    , preRm-    , binaryPriority-    , binarySection-    , installInit-    , packageType-    , debianDescription-    , essential--    , depends-    , recommends-    , suggests-    , preDepends-    , breaks-    , conflicts-    , provides-    , replaces-    , builtUsing--{--    -- * Binary Package Dependencies-    , depends-    , conflicts-    , replaces-    , provides--}--    -- * Binary package Files-    , link-    , install-    , installTo-    , installData-    , file-    , installCabalExec-    , installCabalExecTo-    , installDir-    , logrotateStanza--    -- * Unknown, obsolete, internal-    , flags-    , validate-    , warning -- no-op?-    , intermediateFiles-    , packageInfo-    , control -- obsolete-    , source-    , changedBy-    , uploaders-    , dmUploadAllowed-    , homepage-    , vcsFields-    , xFields-    , buildDepends-    , buildConflicts-    , buildDependsIndep-    , buildConflictsIndep-    , binaryPackages-    ) where--import Control.Category ((.))-import Data.Lens.Lazy (Lens, iso, getL)-import Data.Set as Set (Set)-import Data.Text (Text)-import Debian.Debianize.Prelude (maybeLens, listElemLens)-import Debian.Debianize.Types.Atoms-import qualified Debian.Debianize.Types.BinaryDebDescription as B-import qualified Debian.Debianize.Types.SourceDebDescription as S-import Debian.Orphans ()-import Debian.Policy (PackageArchitectures, PackagePriority, Section, StandardsVersion)-import Debian.Relation (BinPkgName, Relations, SrcPkgName)-import Prelude hiding (init, init, log, log, unlines, (.))-import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)---- | Not exported - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package>-binaryDebDescription :: BinPkgName -> Lens Atoms B.BinaryDebDescription-binaryDebDescription b = maybeLens (B.newBinaryDebDescription b) (iso id id) . listElemLens ((== b) . getL B.package) . S.binaryPackages . control---- | Lens onto one of several 'B.PackageType' values of which we have--- specific knowledge how to package.-packageType :: BinPkgName -> Lens Atoms (Maybe B.PackageType)-packageType b = B.packageType . binaryDebDescription b---- | Lens into the description field of a BinaryDebDescription.-debianDescription :: BinPkgName -> Lens Atoms (Maybe Text)-debianDescription b = B.description . binaryDebDescription b---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Essential>-essential :: BinPkgName -> Lens Atoms (Maybe Bool)-essential b = B.essential . binaryDebDescription b---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>--- relations :: BinPkgName -> Lens Atoms B.PackageRelations--- relations b = B.relations . binaryDebDescription b---- | The Depends: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-depends :: BinPkgName -> Lens Atoms Relations-depends b = B.depends . B.relations . binaryDebDescription b---- | The Recommends: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-recommends :: BinPkgName -> Lens Atoms Relations-recommends b = B.recommends . B.relations . binaryDebDescription b---- | The Suggests: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-suggests :: BinPkgName -> Lens Atoms Relations-suggests b = B.suggests . B.relations . binaryDebDescription b---- | The Pre-Depends: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-preDepends :: BinPkgName -> Lens Atoms Relations-preDepends b = B.preDepends . B.relations . binaryDebDescription b---- | The Breaks: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-breaks :: BinPkgName -> Lens Atoms Relations-breaks b = B.breaks . B.relations . binaryDebDescription b---- | The Conflicts: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-conflicts :: BinPkgName -> Lens Atoms Relations-conflicts b = B.conflicts . B.relations . binaryDebDescription b---- | The Provides: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-provides :: BinPkgName -> Lens Atoms Relations-provides b = B.provides . B.relations . binaryDebDescription b---- | The Replaces: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-replaces :: BinPkgName -> Lens Atoms Relations-replaces b = B.replaces . B.relations . binaryDebDescription b---- | THe Built-Using: relations for each binary deb - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>-builtUsing :: BinPkgName -> Lens Atoms Relations-builtUsing b = B.builtUsing . B.relations . binaryDebDescription b--debianMaintainer :: Lens Atoms (Maybe NameAddr)-debianMaintainer = S.maintainer . control--debianUploaders :: Lens Atoms [NameAddr]-debianUploaders = S.uploaders . control---- | The architectures supported by a binary package-binaryArchitectures :: BinPkgName -> Lens Atoms (Maybe PackageArchitectures)-binaryArchitectures b = B.architecture . binaryDebDescription b---- | The source package priority - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Priority>-sourcePriority :: Lens Atoms (Maybe PackagePriority)-sourcePriority = S.priority . control---- | Map of the binary package priorities (FIXME: redundant with BinaryDebDescription)-binaryPriority :: BinPkgName -> Lens Atoms (Maybe PackagePriority)-binaryPriority b = B.binaryPriority . binaryDebDescription b---- | The source package's section assignment - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Section>-sourceSection :: Lens Atoms (Maybe Section)-sourceSection = S.section . control---- | Map of the binary deb section assignments (FIXME: redundant with BinaryDebDescription)-binarySection :: BinPkgName -> Lens Atoms (Maybe Section)-binarySection b = B.binarySection . binaryDebDescription b---- * Debian dependency info---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Source>-source :: Lens Atoms (Maybe SrcPkgName)-source = S.source . control---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Changed-By>-changedBy :: Lens Atoms (Maybe NameAddr)-changedBy = S.changedBy . control---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Uploaders>-uploaders :: Lens Atoms ([NameAddr])-uploaders = S.uploaders . control---- | Obsolete - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-DM-Upload-Allowed>-dmUploadAllowed :: Lens Atoms (Bool)-dmUploadAllowed = S.dmUploadAllowed . control---- | The @Standards-Version@ field of the @debian/control@ file - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Standards-Version>-standardsVersion :: Lens Atoms (Maybe StandardsVersion)-standardsVersion = S.standardsVersion . control---- | <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Homepage>-homepage :: Lens Atoms (Maybe Text)-homepage = S.homepage . control---- | Version control system field - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-VCS-fields>-vcsFields :: Lens Atoms (Set S.VersionControlSpec)-vcsFields = S.vcsFields . control---- | User defined fields - <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.7>-xFields :: Lens Atoms (Set S.XField)-xFields = S.xFields . control---- | <http://www.debian.org/doc/debian-policy/ch-relationships.html#s-sourcebinarydeps>-buildDepends :: Lens Atoms Relations-buildDepends = S.buildDepends . control---- | <http://www.debian.org/doc/debian-policy/ch-relationships.html#s-sourcebinarydeps>-buildDependsIndep :: Lens Atoms Relations-buildDependsIndep = S.buildDependsIndep . control---- | <http://www.debian.org/doc/debian-policy/ch-relationships.html#s-sourcebinarydeps>-buildConflicts :: Lens Atoms Relations-buildConflicts = S.buildConflicts . control---- | <http://www.debian.org/doc/debian-policy/ch-relationships.html#s-sourcebinarydeps>-buildConflictsIndep :: Lens Atoms Relations-buildConflictsIndep = S.buildConflictsIndep . control--binaryPackages :: Lens Atoms [B.BinaryDebDescription]-binaryPackages = S.binaryPackages . control

@@ -1,760 +0,0 @@--- | This module holds a long list of lenses that access the Atoms--- record, the record that holds the input data from which the--- debianization is to be constructed.-{-# LANGUAGE CPP, DeriveDataTypeable #-}-{-# OPTIONS_GHC -Wall #-}-module Debian.Debianize.Types.Atoms-{-    ( Atoms-    , showAtoms-    , newAtoms-    , InstallFile(..) -- FIXME - lenses for this-    , Server(..) -- FIXME - lenses for this-    , Site(..) -- FIXME - lenses for this-    , DebAction(..)-    , DebType(..)-    , PackageInfo(..)-    ) -} where--import Control.Applicative ((<$>))-import Control.Category ((.))-import Control.Monad.State (StateT)-import Control.Monad.Trans (MonadIO, liftIO)-import Data.Generics (Data, Typeable)-import Data.Lens.Lazy (Lens, lens, (%=))-import Data.Map as Map (Map)-import Data.Monoid (Monoid(..))-import Data.Set as Set (Set, singleton, insert)-import Data.Text (Text)-import Debian.Changes (ChangeLog)-import Debian.Debianize.Types.CopyrightDescription-import Debian.Debianize.Types.BinaryDebDescription (Canonical(canonical))-import qualified Debian.Debianize.Types.SourceDebDescription as S-import Debian.Debianize.VersionSplits (VersionSplits, DebBase)-import Debian.Orphans ()-import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat)-import Debian.Relation (BinPkgName, Relations, SrcPkgName)-import Debian.Version (DebianVersion)-import Distribution.Compiler (CompilerFlavor(GHC))-import Distribution.Package (PackageName)-import Distribution.PackageDescription as Cabal (FlagName, PackageDescription)-import Prelude hiding (init, init, log, log, unlines, (.))-import System.Console.GetOpt (getOpt, ArgOrder(Permute), OptDescr(Option), ArgDescr(ReqArg))-import System.Environment (getArgs)-import System.FilePath ((</>))-import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)---- This enormous record is a mistake - instead it should be an Atom--- type with lots of constructors, and the Atoms type is a set of--- these.  Then we can cruise through the atom set converting the--- elements into other simpler elements until they elements are all--- simple enough to convert directly into a debianization.  At the--- moment I really need this for the Install atoms, so I will try to--- convert just that portion of the type to this new scheme.---- | Bits and pieces of information about the mapping from cabal package--- names and versions to debian package names and versions.  In essence,--- an 'Atoms' value represents a package's debianization.  The lenses in--- this module are used to get and set the values hidden in this Atoms--- value.  Many of the values should be left alone to be set when the--- debianization is finalized.-data Atoms-    = Atoms-      { noDocumentationLibrary_ :: Bool-      -- ^ Do not produce a libghc-foo-doc package.-      , noProfilingLibrary_ :: Bool-      -- ^ Do not produce a libghc-foo-prof package.-      , omitProfVersionDeps_ :: Bool-      -- ^ If present, Do not put the version dependencies on the prof packages that we put on the dev packages.-      , omitLTDeps_ :: Bool-      -- ^ If present, don't generate the << dependency when we see a cabal-      -- equals dependency.  (The implementation of this was somehow lost.)-      , buildDir_ :: Set FilePath-      -- ^ The build directory used by cabal, typically dist/build when-      -- building manually or dist-ghc/build when building using GHC and-      -- haskell-devscripts.  This value is used to locate files-      -- produced by cabal so we can move them into the deb.  Note that-      -- the --builddir option of runhaskell Setup appends the "/build"-      -- to the value it receives, so, yes, try not to get confused.-      -- FIXME: make this FilePath or Maybe FilePath-      , buildEnv_ :: EnvSet-      -- ^ Directory containing the build environment for which the-      -- debianization will be generated.  This determines which-      -- compiler will be available, which in turn determines which-      -- basic libraries can be provided by the compiler.  By default-      -- all the paths in EnvSet are "/".-      , flags_ :: Flags-      -- ^ Information regarding mode of operation - verbosity, dry-run, usage, etc-      , debianNameMap_ :: Map PackageName VersionSplits-      -- ^ Mapping from cabal package name and version to debian source-      -- package name.  This allows different ranges of cabal versions to-      -- map to different debian source package names.-      , control_ :: S.SourceDebDescription-      -- ^ The parsed contents of the control file-      , sourcePackageName_ :: Maybe SrcPkgName-      -- ^ Name to give to the debian source package.  If not supplied-      -- the name is constructed from the cabal package name.  Note that-      -- DebianNameMap could encode this information if we already knew-      -- the cabal package name, but we can't assume that.-      , overrideDebianNameBase_ :: Maybe DebBase-      -- ^ If given, use this name for the base of the debian binary-      -- packages - the string between 'libghc-' and '-dev'.  Normally-      -- this is derived from the hackage package name.-      , revision_ :: Maybe String-      -- ^ Specify the revision string to use when converting the-      -- cabal version to debian.-      , debVersion_ :: Maybe DebianVersion-      -- ^ Specify the exact debian version of the resulting package,-      -- including epoch.  One use case is to work around the the-      -- "buildN" versions that are often uploaded to the debian and-      -- ubuntu repositories.  Say the latest cabal version of-      -- transformers is 0.3.0.0, but the debian repository contains-      -- version 0.3.0.0-1build3, we need to specify-      -- debVersion="0.3.0.0-1build3" or the version we produce will-      -- look older than the one already available upstream.-      , maintainerOption_ :: Maybe NameAddr-      , uploadersOption_ :: [NameAddr]-      -- ^ Value for the maintainer field in the control file.  Note that-      -- the cabal maintainer field can have multiple addresses, but debian-      -- only one.  If this is not explicitly set, it is obtained from the-      -- cabal file, and if it is not there then from the environment.  As a-      -- last resort, there is a hard coded string in here somewhere.-      , cabalFlagAssignments_ :: Set (FlagName, Bool)-      -- ^ Flags to pass to Cabal function finalizePackageDescription,-      -- this can be used to control the flags in the cabal file.  It-      -- can be supplied to the cabal-debian binary using the --flags-      -- option.-      , sourceFormat_ :: Maybe SourceFormat-      -- ^ Write debian/source/format-      , watch_ :: Maybe Text-      -- ^ Write debian/watch-      , intermediateFiles_ :: Set (FilePath, Text)-      -- ^ Put this text into a file with the given name in the debianization.-      , rulesHead_ :: Maybe Text-      , rulesSettings_ :: [Text]-      , rulesIncludes_ :: [Text]-      -- ^ The header of the debian/rules file.  The remainder is assembled-      -- from DebRulesFragment values in the atom list.-      , rulesFragments_ :: Set Text-      -- ^ A Fragment of debian/rules-      , warning_ :: Set Text-      -- ^ A warning to be reported later-      , utilsPackageNameBase_ :: Maybe String-      -- ^ Name of a package that will get left-over data files and executables.-      -- If there are more than one, each package will get those files.-      , xDescription_ :: Maybe Text-      -- ^ The text for the X-Description field of the Source package stanza.-      , changelog_ :: Maybe ChangeLog-      -- ^ The changelog, first entry contains the source package name and version-      , comments_ :: Maybe [[Text]]-      -- ^ Each element is a comment to be added to the changelog, where the-      -- element's text elements are the lines of the comment.-      , missingDependencies_ :: Set BinPkgName-      -- ^ Lets cabal-debian know that a package it might expect to exist-      -- actually does not, so omit all uses in resulting debianization.-      , extraLibMap_ :: Map String Relations-      -- ^ Map a cabal Extra-Library name to a debian binary package name,-      -- e.g. @ExtraLibMapping extraLibMap "cryptopp" "libcrypto-dev"@ adds a-      -- build dependency *and* a regular dependency on @libcrypto-dev@ to-      -- any package that has @cryptopp@ in its cabal Extra-Library list.-      , execMap_ :: Map String Relations-      -- ^ Map a cabal Build-Tool name to a debian binary package name,-      -- e.g. @ExecMapping "trhsx" "haskell-hsx-utils"@ adds a build-      -- dependency on @haskell-hsx-utils@ to any package that has @trhsx@ in its-      -- cabal build-tool list.-      , epochMap_ :: Map PackageName Int-      -- ^ Specify epoch numbers for the debian package generated from a-      -- cabal package.  Example: @EpochMapping (PackageName "HTTP") 1@.-      , packageInfo_ :: Map PackageName PackageInfo-      -- ^ Supply some info about a cabal package.-      , compat_ :: Maybe Int-      -- ^ The debhelper compatibility level, from debian/compat.-      -- , copyright_ :: Maybe (Either CopyrightDescription Text)-      , copyright_ :: CopyrightDescription-      -- ^ Copyright and license information-      , apacheSite_ :: Map BinPkgName (String, FilePath, Text)-      -- ^ Have Apache configure a site using PACKAGE, DOMAIN, LOGDIR, and APACHECONFIGFILE-      , logrotateStanza_ :: Map BinPkgName (Set Text)-      -- ^ Add a stanza of a logrotate file to the binary package-      , postInst_ :: Map BinPkgName Text-      -- ^ Script to run after install, should contain #DEBHELPER# line before exit 0-      , postRm_ :: Map BinPkgName Text-      -- ^ Script to run after remove, should contain #DEBHELPER# line before exit 0-      , preInst_ :: Map BinPkgName Text-      -- ^ Script to run before install, should contain #DEBHELPER# line before exit 0-      , preRm_ :: Map BinPkgName Text-      -- ^ Script to run before remove, should contain #DEBHELPER# line before exit 0-      , sourceArchitecture_ :: Maybe PackageArchitectures-      -- ^ Set the Architecture field of the source package-      , binaryArchitectures_ :: Map BinPkgName PackageArchitectures-      -- ^ Set the Architecture field of a binary package-      , sourcePriority_ :: Maybe PackagePriority-      -- ^ Set the Priority field of the source package-      , binaryPriorities_ :: Map BinPkgName PackagePriority-      -- ^ Set the Priority field of a binary package-      , sourceSection_ :: Maybe Section-      -- ^ Set the Section field of the source package-      , binarySections_ :: Map BinPkgName Section-      -- ^ Set the Section field of a binary package-#if 0-      , link_ :: Map BinPkgName (Set (FilePath, FilePath))-      -- ^ Create a symbolic link in the binary package-      , install_ :: Map BinPkgName (Set (FilePath, FilePath))-      -- ^ Install a build file into the binary package-      , installTo_ :: Map BinPkgName (Set (FilePath, FilePath))-      -- ^ Install a build file into the binary package at an exact location-      , installData_ :: Map BinPkgName (Set (FilePath, FilePath))-      -- ^ DHInstallTo somewhere relative to DataDir (see above)-      , file_ :: Map BinPkgName (Set (FilePath, Text))-      -- ^ Create a file with the given text at the given path-      , installCabalExec_ :: Map BinPkgName (Set (String, FilePath))-      -- ^ Install a cabal executable into the binary package-      , installCabalExecTo_ :: Map BinPkgName (Set (String, FilePath))-      -- ^ Install a cabal executable into the binary package at an exact location-      , installDir_ :: Map BinPkgName (Set FilePath)-      -- ^ Create a directory in the binary package-#else-      , atomSet_ :: Set Atom-#endif-      , installInit_ :: Map BinPkgName Text-      -- ^ Add an init.d file to the binary package-      , executable_ :: Map BinPkgName InstallFile-      -- ^ Create a binary package to hold a cabal executable-      , serverInfo_ :: Map BinPkgName Server-      -- ^ Like DHExecutable, but configure the executable as a server process-      , website_ :: Map BinPkgName Site-      -- ^ Like DHServer, but configure the server as a web server-      , backups_ :: Map BinPkgName String-      -- ^ Configure the executable to do incremental backups-      , extraDevDeps_ :: Relations-      -- ^ Limited version of Depends, put a dependency on the dev library package.  The only-      -- reason to use this is because we don't yet know the name of the dev library package.-      , packageDescription_ :: Maybe PackageDescription-      -- ^ The result of reading a cabal configuration file.-      , compilerFlavors_ :: Set CompilerFlavor-      -- ^ Which compilers should we generate library packages for?-      , official_ :: Bool-      -- ^ Whether this packaging is created by the Debian Haskell Group-      } deriving (Eq, Show, Data, Typeable)--instance Canonical Atoms where-    canonical x = x {control_ = canonical (control_ x)}--data Atom-    = Link BinPkgName FilePath FilePath-      -- ^ Create a symbolic link in the binary package-    | Install BinPkgName FilePath FilePath-      -- ^ Install a build file into the binary package-    | InstallTo BinPkgName FilePath FilePath-      -- ^ Install a build file into the binary package at an exact location-    | InstallData BinPkgName FilePath FilePath-      -- ^ DHInstallTo somewhere relative to DataDir (see above)-    | File BinPkgName FilePath Text-      -- ^ Create a file with the given text at the given path-    | InstallCabalExec BinPkgName String FilePath-      -- ^ Install a cabal executable into the binary package-    | InstallCabalExecTo BinPkgName String FilePath-      -- ^ Install a cabal executable into the binary package at an exact location-    | InstallDir BinPkgName FilePath-      -- ^ Create a directory in the binary package-    deriving (Show, Eq, Ord, Data, Typeable)--type Atoms' = Set Atom--data EnvSet = EnvSet-    { cleanOS :: FilePath  -- ^ The output of the debootstrap command-    , dependOS :: FilePath -- ^ An environment with build dependencies installed-    , buildOS :: FilePath  -- ^ An environment where we have built a package-    } deriving (Eq, Show, Data, Typeable)---- | Look for --buildenvdir in the command line arguments to get the--- changeroot path, use "/" if not present.-newAtoms :: MonadIO m => m Atoms-newAtoms = liftIO $ do-  (roots, _, _) <- getOpt Permute [Option "buildenvdir" [] (ReqArg id "PATH")-                                          "Directory containing the build environment"] <$> getArgs-  let envset = case roots of-                 (x : _) -> EnvSet {cleanOS = x </> "clean", dependOS = x </> "depend", buildOS = x </> "build"}-                 _ -> EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}-  return $ makeAtoms envset--makeAtoms :: EnvSet -> Atoms-makeAtoms envset =-    Atoms-      { noDocumentationLibrary_ = False-      , noProfilingLibrary_ = False-      , omitProfVersionDeps_ = False-      , omitLTDeps_ = False-      , buildDir_ = mempty-      , buildEnv_ = envset-      , flags_ = defaultFlags-      , debianNameMap_ = mempty-      , control_ = S.newSourceDebDescription-      , sourcePackageName_ = Nothing-      , overrideDebianNameBase_ = Nothing-      , revision_ = Nothing-      , debVersion_ = Nothing-      , maintainerOption_ = Nothing-      , uploadersOption_ = []-      , cabalFlagAssignments_ = mempty-      , sourceFormat_ = Nothing-      , watch_ = Nothing-      , intermediateFiles_ = mempty-      , rulesHead_ = Nothing-      , rulesSettings_ = mempty-      , rulesIncludes_ = mempty-      , rulesFragments_ = mempty-      , warning_ = mempty-      , utilsPackageNameBase_ = Nothing-      , changelog_ = Nothing-      , xDescription_ = Nothing-      , comments_ = Nothing-      , missingDependencies_ = mempty-      , extraLibMap_ = mempty-      , execMap_ = mempty-      , epochMap_ = mempty-      , packageInfo_ = mempty-      , compat_ = Nothing-      , copyright_ = newCopyrightDescription-      , apacheSite_ = mempty-      , logrotateStanza_ = mempty-      , postInst_ = mempty-      , postRm_ = mempty-      , preInst_ = mempty-      , preRm_ = mempty-      , sourceArchitecture_ = Nothing-      , binaryArchitectures_ = mempty-      , sourcePriority_ = Nothing-      , binaryPriorities_ = mempty-      , sourceSection_ = Nothing-      , binarySections_ = mempty-#if 0-      , link_ = mempty-      , install_ = mempty-      , installTo_ = mempty-      , installData_ = mempty-      , file_ = mempty-      , installCabalExec_ = mempty-      , installCabalExecTo_ = mempty-      , installDir_ = mempty-#else-      , atomSet_ = mempty-#endif-      , installInit_ = mempty-      , executable_ = mempty-      , serverInfo_ = mempty-      , website_ = mempty-      , backups_ = mempty-      , extraDevDeps_ = mempty-      , packageDescription_ = Nothing-      , compilerFlavors_ = singleton GHC-      , official_ = False-      }---- | This record supplies information about the task we want done ---- debianization, validataion, help message, etc.-data Flags = Flags-    {-    --------------------------    -- Modes of Operation ----    --------------------------      verbosity_ :: Int-    -- ^ Run with progress messages at the given level of verboseness.-    , dryRun_ :: Bool-    -- ^ Don't write any files or create any directories, just explain-    -- what would have been done.-    , validate_ :: Bool-    -- ^ Fail if the debianization already present doesn't match the-    -- one we are going to generate closely enough that it is safe to-    -- debianize during the run of dpkg-buildpackage, when Setup-    -- configure is run.  Specifically, the version number in the top-    -- changelog entry must match, and the sets of package names in-    -- the control file must match.-    , debAction_ :: DebAction-    -- ^ What to do - Usage, Debianize or Substvar-    } deriving (Eq, Ord, Show, Data, Typeable)--data DebAction = Usage | Debianize | SubstVar DebType deriving (Read, Show, Eq, Ord, Data, Typeable)---- | A redundant data type, too lazy to expunge.-data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable)--data PackageInfo = PackageInfo { cabalName :: PackageName-                               , devDeb :: Maybe (BinPkgName, DebianVersion)-                               , profDeb :: Maybe (BinPkgName, DebianVersion)-                               , docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable)---- | Information about the web site we are packaging.-data Site-    = Site-      { domain :: String   -- ^ The domain name assigned to the server.-                           -- An apache configuration will be generated to-                           -- redirect requests from this domain to hostname:port-      , serverAdmin :: String   -- ^ Apache ServerAdmin parameter-      , server :: Server   -- ^ The hint to install the server job-      } deriving (Read, Show, Eq, Ord, Data, Typeable)---- | Information about the server we are packaging.-data Server-    = Server-      { hostname :: String      -- ^ Host on which the server will run-      , port :: Int             -- ^ Port on which the server will run.-                                -- Obviously, this must assign each and-                                -- every server package to a different-                                -- port.-      , headerMessage :: String -- ^ A comment that will be inserted to-                                -- explain how the file was generated-      , retry :: String         -- ^ start-stop-daemon --retry argument-      , serverFlags :: [String] -- ^ Extra flags to pass to the server via the init script-      , installFile :: InstallFile -- ^ The hint to install the server executable-      } deriving (Read, Show, Eq, Ord, Data, Typeable)--data InstallFile-    = InstallFile-      { execName :: String -- ^ The name of the executable file-      , sourceDir :: Maybe FilePath -- ^ where to find it, default is dist/build/<execName>/-      , destDir :: Maybe FilePath -- ^ where to put it, default is usr/bin/<execName>-      , destName :: String  -- ^ name to give installed executable-      } deriving (Read, Show, Eq, Ord, Data, Typeable)--defaultFlags :: Flags-defaultFlags =-    Flags {-      verbosity_ = 1-    , debAction_ = Debianize-    , dryRun_ = False-    , validate_ = False-    }--showAtoms :: Atoms -> IO ()-showAtoms x = putStrLn ("\nTop: " ++ show x ++ "\n")---- | Set how much progress messages get generated.-verbosity :: Lens Atoms Int-verbosity = lens verbosity_ (\ b a -> a {verbosity_ = b}) . flags---- | Don't write anything, just output a description of what would have happened-dryRun :: Lens Atoms Bool-dryRun = lens dryRun_ (\ b a -> a {dryRun_ = b}) . flags---- | Make sure the version number and package names of the supplied--- and generated debianizations match.-validate :: Lens Atoms Bool-validate = lens validate_ (\ b a -> a {validate_ = b}) . flags---- | Debianize, SubstVars, or Usage.  I'm no longer sure what SubstVars does, but someone--- may still be using it.-debAction :: Lens Atoms DebAction-debAction = lens debAction_ (\ b a -> a {debAction_ = b}) . flags---- | Obsolete record containing verbosity, dryRun, validate, and debAction.-flags :: Lens Atoms Flags-flags = lens flags_ (\ b a -> a {flags_ = b})---- | Unused-warning :: Lens Atoms (Set Text)-warning = lens warning_ (\ a b -> b {warning_ = a})---- | The build directory.  This can be set by an argument to the @Setup@ script.--- When @Setup@ is run manually it is just @dist@, when it is run by--- @dpkg-buildpackage@ the compiler name is appended, so it is typically--- @dist-ghc@.  Cabal-debian needs the correct value of buildDir to find--- the build results.-buildDir :: Lens Atoms (Set FilePath)-buildDir = lens buildDir_ (\ b a -> a {buildDir_ = b})---- We need to update ghcVersion when this is changed, which means doing IO--- buildEnv :: Lens Atoms (Maybe EnvSet)--- buildEnv = lens buildEnv_ (\ b a -> a {buildEnv_ = b})--buildEnv :: Lens Atoms EnvSet-buildEnv = lens buildEnv_ (\ b a -> a {buildEnv_ = b})--setBuildEnv :: MonadIO m => EnvSet -> Atoms -> m Atoms-setBuildEnv envset atoms = return $ atoms {buildEnv_ = envset}---- | Map from cabal Extra-Lib names to debian binary package names.-extraLibMap :: Lens Atoms (Map String Relations)-extraLibMap = lens extraLibMap_ (\ a b -> b {extraLibMap_ = a})---- | Map from cabal Build-Tool names to debian binary package names.-execMap :: Lens Atoms (Map String Relations)-execMap = lens execMap_ (\ a b -> b {execMap_ = a})--maintainerOption :: Lens Atoms (Maybe NameAddr)-maintainerOption = lens maintainerOption_ (\ a b -> b {maintainerOption_ = a})--uploadersOption :: Lens Atoms [NameAddr]-uploadersOption = lens uploadersOption_ (\ a b -> b {uploadersOption_ = a})---- | Cabal flag assignments to use when loading the cabal file.-cabalFlagAssignments :: Lens Atoms (Set (FlagName, Bool))-cabalFlagAssignments = lens cabalFlagAssignments_ (\ a b -> b {cabalFlagAssignments_ = a})---- | The result of loading a .cabal file-packageDescription :: Lens Atoms (Maybe PackageDescription)-packageDescription = lens packageDescription_ (\ a b -> b {packageDescription_ = a})---- | Map from cabal version number ranges to debian package names.  This is a--- result of the fact that only one version of a debian package can be--- installed at a given time, while multiple versions of a cabal package can.-debianNameMap :: Lens Atoms (Map PackageName VersionSplits)-debianNameMap = lens debianNameMap_ (\ a b -> b {debianNameMap_ = a})---- | Map of Debian epoch numbers assigned to cabal packages.-epochMap :: Lens Atoms (Map PackageName Int)-epochMap = lens epochMap_ (\ a b -> b {epochMap_ = a})---- | Create a package to hold a cabal executable-executable :: Lens Atoms (Map BinPkgName InstallFile)-executable = lens executable_ (\ a b -> b {executable_ = a})---- | Create a package for a server-serverInfo :: Lens Atoms (Map BinPkgName Server)-serverInfo = lens serverInfo_ (\ a b -> b {serverInfo_ = a})---- | Create a package for a website-website :: Lens Atoms (Map BinPkgName Site)-website = lens website_ (\ a b -> b {website_ = a})---- | Create a package for a timed backup script-backups :: Lens Atoms (Map BinPkgName String)-backups = lens backups_ (\ a b -> b {backups_ = a})---- | Create an apache configuration file with the given--- (domain, logdir, filetext).  This is called when expanding--- the result of the website lens above.-apacheSite :: Lens Atoms (Map BinPkgName (String, FilePath, Text))-apacheSite = lens apacheSite_ (\ a b -> b {apacheSite_ = a})---- * Lower level hints about the debianization----- | List if packages that should be omitted from any--- dependency list - e.g. a profiling package missing due--- to use of noProfilingPackage lens elsewhere.-missingDependencies :: Lens Atoms (Set BinPkgName)-missingDependencies = lens missingDependencies_ (\ a b -> b {missingDependencies_ = a})---- | Override the package name used to hold left over data files and executables.-utilsPackageNameBase :: Lens Atoms (Maybe String)-utilsPackageNameBase = lens utilsPackageNameBase_ (\ a b -> b {utilsPackageNameBase_ = a})---- | Override the debian source package name constructed from the cabal name-sourcePackageName :: Lens Atoms (Maybe SrcPkgName)-sourcePackageName = lens sourcePackageName_ (\ a b -> b {sourcePackageName_ = a})---- | Override the default base of the debian binary package names.-overrideDebianNameBase :: Lens Atoms (Maybe DebBase)-overrideDebianNameBase = lens overrideDebianNameBase_ (\ a b -> b {overrideDebianNameBase_ = a})---- | Revision string used in constructing the debian verison number from the cabal version-revision :: Lens Atoms (Maybe String)-revision = lens revision_ (\ a b -> b {revision_ = a})---- | Exact debian version number, overrides the version generated from the cabal version-debVersion :: Lens Atoms (Maybe DebianVersion)-debVersion = lens debVersion_ (\ b a -> a {debVersion_ = b})---- | No longer sure what the purpose of this lens is.-packageInfo :: Lens Atoms (Map PackageName PackageInfo)-packageInfo = lens packageInfo_ (\ a b -> b {packageInfo_ = a})---- | Do not put the version dependencies on the prof packages that we put on the dev packages.-omitProfVersionDeps :: Lens Atoms Bool-omitProfVersionDeps = lens omitProfVersionDeps_ (\ b a -> a {omitProfVersionDeps_ = b})---- | Set this to filter any less-than dependencies out of the generated debian--- dependencies.  (Not sure if this is implemented.)-omitLTDeps :: Lens Atoms Bool-omitLTDeps = lens omitLTDeps_ (\ b a -> a {omitLTDeps_ = b})---- | Set this to omit the prof library deb.-noProfilingLibrary :: Lens Atoms Bool-noProfilingLibrary = lens noProfilingLibrary_ (\ b a -> a {noProfilingLibrary_ = b})---- | Set this to omit the doc library deb.-noDocumentationLibrary :: Lens Atoms Bool-noDocumentationLibrary = lens noDocumentationLibrary_ (\ b a -> a {noDocumentationLibrary_ = b})---- | Set this to apply offical Debian settings-official :: Lens Atoms Bool-official = lens official_ (\ b a -> a {official_ = b})---- | The copyright information from the cabal file-copyright :: Lens Atoms CopyrightDescription-copyright = lens copyright_ (\ a b -> b {copyright_ = a})--{---- | The license information from the cabal file-license :: Lens Atoms (Maybe License)-license = lens license_ (\ a b -> b {license_ = a})---- | The value in the cabal file's license-file field-licenseFile :: Lens Atoms (Maybe Text)-licenseFile = lens licenseFile_ (\ a b -> b {licenseFile_ = a})--}---- | The architectures supported by this source package - @Any@,--- @All@, or some list of specific architectures.-sourceArchitectures :: Lens Atoms (Maybe PackageArchitectures)-sourceArchitectures = lens sourceArchitecture_ (\ a b -> b {sourceArchitecture_ = a})---- | Extra install dependencies for the devel library.  Redundant--- with depends, but kept for backwards compatibility.  Also, I--- think maybe this is or was needed because it can be set before--- the exact name of the library package is known.-extraDevDeps :: Lens Atoms Relations-extraDevDeps = lens extraDevDeps_ (\ a b -> b {extraDevDeps_ = a})---- | The rules file header-rulesHead :: Lens Atoms (Maybe Text)-rulesHead = lens rulesHead_ (\ a b -> b {rulesHead_ = a})---- | The rules file assignments-rulesSettings :: Lens Atoms [Text]-rulesSettings = lens rulesSettings_ (\ a b -> b {rulesSettings_ = a})---- | The rules file include directives-rulesIncludes :: Lens Atoms [Text]-rulesIncludes = lens rulesIncludes_ (\ a b -> b {rulesIncludes_ = a})---- | Additional fragments of the rules file-rulesFragments :: Lens Atoms (Set Text)-rulesFragments = lens rulesFragments_ (\ a b -> b {rulesFragments_ = a})---- | Map of @debian/postinst@ scripts-postInst :: Lens Atoms (Map BinPkgName Text)-postInst = lens postInst_ (\ a b -> b {postInst_ = a})---- | Map of @debian/postrm@ scripts-postRm :: Lens Atoms (Map BinPkgName Text)-postRm = lens postRm_ (\ a b -> b {postRm_ = a})---- | Map of @debian/preinst@ scripts-preInst :: Lens Atoms (Map BinPkgName Text)-preInst = lens preInst_ (\ a b -> b {preInst_ = a})---- | Map of @debian/prerm@ scripts-preRm :: Lens Atoms (Map BinPkgName Text)-preRm = lens preRm_ (\ a b -> b {preRm_ = a})---- | The @debian/compat@ file, contains the minimum compatible version--- of the @debhelper@ package.  If not given the version number of the--- installed debhelper package is used.-compat :: Lens Atoms (Maybe Int)-compat = lens compat_ (\ a b -> b {compat_ = a})---- | The @debian\/source\/format@ file.-sourceFormat :: Lens Atoms (Maybe SourceFormat)-sourceFormat = lens sourceFormat_ (\ a b -> b {sourceFormat_ = a})---- | the @debian\/watch@ file-watch :: Lens Atoms (Maybe Text)-watch = lens watch_ (\ a b -> b {watch_ = a})---- | the @debian\/changelog@ file-changelog :: Lens Atoms (Maybe ChangeLog)-changelog = lens changelog_ (\ a b -> b {changelog_ = a})--xDescription :: Lens Atoms (Maybe Text)-xDescription = lens xDescription_ (\ a b -> b {xDescription_ = a})---- | Comment entries for the latest changelog entry (DebLogComments [[Text]])-comments :: Lens Atoms (Maybe [[Text]])-comments = lens comments_ (\ a b -> b {comments_ = a})---- | The @debian\/control@ file.  Many of the following lenses access parts of the @SourceDebDescription@.-control :: Lens Atoms S.SourceDebDescription-control = lens control_ (\ a b -> b {control_ = a})---- | Add a stanza to the binary package's logrotate script.-logrotateStanza :: Lens Atoms (Map BinPkgName (Set Text))-logrotateStanza = lens logrotateStanza_ (\ a b -> b {logrotateStanza_ = a})--#if 0--- | Add entries to a binary deb's debian/foo.links file.-link :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))-link = lens link_ (\ a b -> b {link_ = a})---- | Install files into directories by adding entries to the binary--- deb's debian/foo.install file.-install :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))-install = lens install_ (\ a b -> b {install_ = a})---- | Rename and install files.  This is done by adding rules to debian/rules.-installTo :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))-installTo = lens installTo_ (\ a b -> b {installTo_ = a})---- | Install files into the a binary deb's data directory,--- /usr/share/packagename-version.  This expands to either an install--- or an installTo.-installData :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))-installData = lens installData_ (\ a b -> b {installData_ = a})---- | Create a file in the binary deb with the given text.  This is done by--- writing the file into the cabalInstall directory and adding an entry--- to the binary deb's .install file.-file :: Lens Atoms (Map BinPkgName (Set (FilePath, Text)))-file = lens file_ (\ a b -> b {file_ = a})---- | Install a cabal executable into a binary deb.--- FIXME: change signature to BinPkgName -> Lens Atoms (Set (String, FilePath))-installCabalExec :: Lens Atoms (Map BinPkgName (Set (String, FilePath)))-installCabalExec = lens installCabalExec_ (\ a b -> b {installCabalExec_ = a})---- | Rename and install a cabal executable--- FIXME: change signature to BinPkgName -> Lens Atoms (Set (String, FilePath))-installCabalExecTo :: Lens Atoms (Map BinPkgName (Set (String, FilePath)))-installCabalExecTo = lens installCabalExecTo_ (\ a b -> b {installCabalExecTo_ = a})---- | Create directories in the package--- FIXME: change signature to BinPkgName -> Lens Atoms (Set FilePath)-installDir :: Lens Atoms (Map BinPkgName (Set FilePath))-installDir = lens installDir_ (\ a b -> b {installDir_ = a})-#else--- | Access the set of new style atoms.-atomSet :: Lens Atoms (Set Atom)-atomSet = lens atomSet_ (\ a b -> b {atomSet_ = a})---- We need (%=_)-link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()-link b from dest = atomSet %= (Set.insert $ Link b from dest) >> return ()-install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()-install b from dest = atomSet %= (Set.insert $ Install b from dest) >> return ()-installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()-installTo b from dest = atomSet %= (Set.insert $ InstallTo b from dest) >> return ()-installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()-installData b from dest = atomSet %= (Set.insert $ InstallData b from dest) >> return ()-file :: Monad m => BinPkgName -> FilePath -> Text -> StateT Atoms m ()-file b dest content = atomSet %= (Set.insert $ File b dest content) >> return ()-installCabalExec :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()-installCabalExec b name dest = atomSet %= (Set.insert $ InstallCabalExec b name dest) >> return ()-installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()-installCabalExecTo b name dest = atomSet %= (Set.insert $ InstallCabalExecTo b name dest) >> return ()-installDir :: Monad m => BinPkgName -> FilePath -> StateT Atoms m ()-installDir b dir = atomSet %= (Set.insert $ InstallDir b dir) >> return ()-#endif---- | Create an /etc/init.d file in the package--- FIXME: change signature to BinPkgName -> Lens Atoms Text-installInit :: Lens Atoms (Map BinPkgName Text)-installInit = lens installInit_ (\ a b -> b {installInit_ = a})---- | Create a file in the debianization.  This is used to implement the file lens above.--- FIXME: change signature to BinPkgName -> Lens Atoms (Set (FilePath, Text))-intermediateFiles :: Lens Atoms (Set (FilePath, Text))-intermediateFiles = lens intermediateFiles_ (\ a b -> b {intermediateFiles_ = a})--compilerFlavors :: Lens Atoms (Set CompilerFlavor)-compilerFlavors = lens compilerFlavors_ (\ a b -> b {compilerFlavors_ = a})--{--compilerFlavor :: Monad m => StateT Atoms m CompilerFlavor-compilerFlavor = do-#if MIN_VERSION_Cabal(1,20,0)-  CompilerId x _ _ <- access ghcVersion-#else-  CompilerId x _ <- access ghcVersion-#endif-  return x--}